source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/ocean_cpl_mod.F90 @ 1373

Last change on this file since 1373 was 1146, checked in by Laurent Fairhead, 16 years ago

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 12.6 KB
Line 
1!
2MODULE ocean_cpl_mod
3!
4! This module is used both for the sub-surface ocean and sea-ice for the case of a
5! coupled model configuration, ocean=couple.
6!
7
8  IMPLICIT NONE
9  PRIVATE
10
11  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
12
13!****************************************************************************************
14!
15CONTAINS
16!
17!****************************************************************************************
18!
19  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
20!
21! Allocate fields for this module and initailize the module mod_cpl
22!
23    USE dimphy,           ONLY : klon
24    USE cpl_mod
25
26! Input arguments
27!*************************************************************************************
28    REAL, INTENT(IN)                  :: dtime
29    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
30
31! Local variables
32!*************************************************************************************
33    INTEGER              :: error
34    CHARACTER (len = 80) :: abort_message
35    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
36
37! Initialize module cpl_init
38    CALL cpl_init(dtime, rlon, rlat)
39   
40  END SUBROUTINE ocean_cpl_init
41!
42!****************************************************************************************
43!
44  SUBROUTINE ocean_cpl_noice( &
45       swnet, lwnet, alb1, &
46       windsp, fder_old, &
47       itime, dtime, knon, knindex, &
48       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
49       AcoefH, AcoefQ, BcoefH, BcoefQ, &
50       AcoefU, AcoefV, BcoefU, BcoefV, &
51       ps, u1, v1, &
52       radsol, snow, agesno, &
53       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
54       tsurf_new, dflux_s, dflux_l)
55
56!
57! This subroutine treats the "open ocean", all grid points that are not entierly covered
58! by ice. The subroutine first receives fields from coupler, then some calculations at
59! surface is done and finally it sends some fields to the coupler.
60!
61    USE dimphy,           ONLY : klon
62    USE cpl_mod
63    USE calcul_fluxs_mod
64
65    INCLUDE "indicesol.h"
66    INCLUDE "YOMCST.h"
67!   
68! Input arguments 
69!****************************************************************************************
70    INTEGER, INTENT(IN)                      :: itime, knon
71    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
72    REAL, INTENT(IN)                         :: dtime
73    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
74    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
75    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
76    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
77    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
78    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
79    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
80    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
81    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
82    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
83    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
84    REAL, DIMENSION(klon), INTENT(IN)        :: ps
85    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
86
87! In/Output arguments
88!****************************************************************************************
89    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
90    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
91    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
92 
93! Output arguments
94!****************************************************************************************
95    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
96    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
97    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
98    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
99    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
100
101! Local variables
102!****************************************************************************************
103    INTEGER               :: i
104    INTEGER, DIMENSION(1) :: iloc
105    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
106    REAL, DIMENSION(klon) :: fder_new
107    REAL, DIMENSION(klon) :: tsurf_cpl
108    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
109    REAL, DIMENSION(klon) :: u1_lay, v1_lay
110    LOGICAL               :: check=.FALSE.
111
112! End definitions
113!****************************************************************************************
114
115    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
116
117!****************************************************************************************
118! Receive sea-surface temperature(tsurf_cpl) from coupler
119!
120!****************************************************************************************
121    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
122
123!****************************************************************************************
124! Calculate fluxes at surface
125!
126!****************************************************************************************
127    cal = 0.
128    beta = 1.
129    dif_grnd = 0.
130    agesno(:) = 0.
131
132    DO i = 1, knon
133       u1_lay(i) = u1(i) - u0_cpl(i)
134       v1_lay(i) = v1(i) - v0_cpl(i)
135    END DO
136
137    CALL calcul_fluxs(knon, is_oce, dtime, &
138         tsurf_cpl, p1lay, cal, beta, cdragh, ps, &
139         precip_rain, precip_snow, snow, qsurf,  &
140         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
141         AcoefH, AcoefQ, BcoefH, BcoefQ, &
142         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
143   
144! - Flux calculation at first modele level for U and V
145    CALL calcul_flux_wind(knon, dtime, &
146         u0_cpl, v0_cpl, u1, v1, cdragm, &
147         AcoefU, AcoefV, BcoefU, BcoefV, &
148         p1lay, temp_air, &
149         flux_u1, flux_v1) 
150
151!****************************************************************************************
152! Calculate fder : flux derivative (sensible and latente)
153!
154!****************************************************************************************
155    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
156   
157    iloc = MAXLOC(fder_new(1:klon))
158    IF (check .AND. fder_new(iloc(1))> 0.) THEN
159       WRITE(*,*)'**** Debug fder****'
160       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
161       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
162            dflux_s(iloc(1)), dflux_l(iloc(1))
163    ENDIF
164
165!****************************************************************************************
166! Send and cumulate fields to the coupler
167!
168!****************************************************************************************
169
170    CALL cpl_send_ocean_fields(itime, knon, knindex, &
171         swnet, lwnet, fluxlat, fluxsens, &
172         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp)
173   
174
175  END SUBROUTINE ocean_cpl_noice
176!
177!****************************************************************************************
178!
179  SUBROUTINE ocean_cpl_ice( &
180       rlon, rlat, swnet, lwnet, alb1, &
181       fder_old, &
182       itime, dtime, knon, knindex, &
183       lafin, &
184       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
185       AcoefH, AcoefQ, BcoefH, BcoefQ, &
186       AcoefU, AcoefV, BcoefU, BcoefV, &
187       ps, u1, v1, pctsrf, &
188       radsol, snow, qsurf, &
189       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
190       tsurf_new, dflux_s, dflux_l)
191!
192! This subroutine treats the ocean where there is ice. The subroutine first receives
193! fields from coupler, then some calculations at surface is done and finally sends
194! some fields to the coupler.
195!   
196    USE dimphy,           ONLY : klon
197    USE cpl_mod
198    USE calcul_fluxs_mod
199
200    INCLUDE "indicesol.h"
201    INCLUDE "YOMCST.h"
202
203! Input arguments
204!****************************************************************************************
205    INTEGER, INTENT(IN)                      :: itime, knon
206    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
207    LOGICAL, INTENT(IN)                      :: lafin
208    REAL, INTENT(IN)                         :: dtime
209    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
210    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
211    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
212    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
213    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
214    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
215    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
216    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
217    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
218    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
219    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
220    REAL, DIMENSION(klon), INTENT(IN)        :: ps
221    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
222    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
223
224! In/output arguments
225!****************************************************************************************
226    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
227    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
228
229! Output arguments
230!****************************************************************************************
231    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
232    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
233    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
234    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
235    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
236    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
237
238! Local variables
239!****************************************************************************************
240    INTEGER                 :: i
241    INTEGER, DIMENSION(1)   :: iloc
242    LOGICAL                 :: check=.FALSE.
243    REAL, PARAMETER         :: t_grnd=271.35
244    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
245    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
246    REAL, DIMENSION(klon)   :: alb_cpl
247    REAL, DIMENSION(klon)   :: u0, v0
248    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
249
250! End definitions
251!****************************************************************************************
252   
253    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
254
255!****************************************************************************************
256! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
257!
258!****************************************************************************************
259
260    CALL cpl_receive_seaice_fields(knon, knindex, &
261         tsurf_cpl, alb_cpl, u0, v0)
262
263    alb1_new(1:knon) = alb_cpl(1:knon)
264    alb2_new(1:knon) = alb_cpl(1:knon)   
265
266   
267!****************************************************************************************
268! Calculate fluxes at surface
269!
270!****************************************************************************************
271    cal = 0.
272    dif_grnd = 0.
273    beta = 1.0
274   
275    DO i = 1, knon
276       u1_lay(i) = u1(i) - u0(i)
277       v1_lay(i) = v1(i) - v0(i)
278    END DO
279
280    CALL calcul_fluxs(knon, is_sic, dtime, &
281         tsurf_cpl, p1lay, cal, beta, cdragh, ps, &
282         precip_rain, precip_snow, snow, qsurf,  &
283         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
284         AcoefH, AcoefQ, BcoefH, BcoefQ, &
285         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
286
287
288! - Flux calculation at first modele level for U and V
289    CALL calcul_flux_wind(knon, dtime, &
290         u0, v0, u1, v1, cdragm, &
291         AcoefU, AcoefV, BcoefU, BcoefV, &
292         p1lay, temp_air, &
293         flux_u1, flux_v1) 
294
295!****************************************************************************************
296! Calculate fder : flux derivative (sensible and latente)
297!
298!****************************************************************************************
299    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
300   
301    iloc = MAXLOC(fder_new(1:klon))
302    IF (check .AND. fder_new(iloc(1))> 0.) THEN
303       WRITE(*,*)'**** Debug fder ****'
304       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
305       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
306            dflux_s(iloc(1)), dflux_l(iloc(1))
307    ENDIF
308
309!****************************************************************************************
310! Send and cumulate fields to the coupler
311!
312!****************************************************************************************
313
314    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
315       pctsrf, lafin, rlon, rlat, &
316       swnet, lwnet, fluxlat, fluxsens, &
317       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1)
318 
319
320  END SUBROUTINE ocean_cpl_ice
321! 
322!****************************************************************************************
323!
324END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.