LMDZ
ocean_cpl_mod.F90
Go to the documentation of this file.
1 !
2 MODULE 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 !
15 CONTAINS
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, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
49  acoefh, acoefq, bcoefh, bcoefq, &
50  acoefu, acoefv, bcoefu, bcoefv, &
51  ps, u1, v1, gustiness, &
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  USE indice_sol_mod
65 
66  include "YOMCST.h"
67  include "clesphys.h"
68 !
69 ! Input arguments
70 !****************************************************************************************
71  INTEGER, INTENT(IN) :: itime, knon
72  INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
73  REAL, INTENT(IN) :: dtime
74  REAL, DIMENSION(klon), INTENT(IN) :: swnet
75  REAL, DIMENSION(klon), INTENT(IN) :: lwnet
76  REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
77  REAL, DIMENSION(klon), INTENT(IN) :: windsp
78  REAL, DIMENSION(klon), INTENT(IN) :: fder_old
79  REAL, DIMENSION(klon), INTENT(IN) :: p1lay
80  REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragq, cdragm
81  REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
82  REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
83  REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
84  REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
85  REAL, DIMENSION(klon), INTENT(IN) :: ps
86  REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
87 
88 ! In/Output arguments
89 !****************************************************************************************
90  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
91  REAL, DIMENSION(klon), INTENT(INOUT) :: snow
92  REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
93 
94 ! Output arguments
95 !****************************************************************************************
96  REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
97  REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
98  REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
99  REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
100  REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
101 
102 ! Local variables
103 !****************************************************************************************
104  INTEGER :: i
105  INTEGER, DIMENSION(1) :: iloc
106  REAL, DIMENSION(klon) :: cal, beta, dif_grnd
107  REAL, DIMENSION(klon) :: fder_new
108  REAL, DIMENSION(klon) :: tsurf_cpl
109  REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
110  REAL, DIMENSION(klon) :: u1_lay, v1_lay
111  LOGICAL :: check=.false.
112 
113 ! End definitions
114 !****************************************************************************************
115 
116  IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
117 
118 !****************************************************************************************
119 ! Receive sea-surface temperature(tsurf_cpl) from coupler
120 !
121 !****************************************************************************************
122  CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
123 
124 !****************************************************************************************
125 ! Calculate fluxes at surface
126 !
127 !****************************************************************************************
128  cal = 0.
129  beta = 1.
130  dif_grnd = 0.
131  agesno(:) = 0.
132 
133  DO i = 1, knon
134  u1_lay(i) = u1(i) - u0_cpl(i)
135  v1_lay(i) = v1(i) - v0_cpl(i)
136  END DO
137 
138  CALL calcul_fluxs(knon, is_oce, dtime, &
139  tsurf_cpl, p1lay, cal, beta, cdragh, cdragq, ps, &
140  precip_rain, precip_snow, snow, qsurf, &
141  radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
142  f_qsat_oce,acoefh, acoefq, bcoefh, bcoefq, &
143  tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
144 
145 ! - Flux calculation at first modele level for U and V
146  CALL calcul_flux_wind(knon, dtime, &
147  u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
148  acoefu, acoefv, bcoefu, bcoefv, &
149  p1lay, temp_air, &
150  flux_u1, flux_v1)
151 
152 !****************************************************************************************
153 ! Calculate fder : flux derivative (sensible and latente)
154 !
155 !****************************************************************************************
156  fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
157 
158  iloc = maxloc(fder_new(1:klon))
159  IF (check .AND. fder_new(iloc(1))> 0.) THEN
160  WRITE(*,*)'**** Debug fder****'
161  WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
162  WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
163  dflux_s(iloc(1)), dflux_l(iloc(1))
164  ENDIF
165 
166 !****************************************************************************************
167 ! Send and cumulate fields to the coupler
168 !
169 !****************************************************************************************
170 
171  CALL cpl_send_ocean_fields(itime, knon, knindex, &
172  swnet, lwnet, fluxlat, fluxsens, &
173  precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp)
174 
175 
176  END SUBROUTINE ocean_cpl_noice
177 !
178 !****************************************************************************************
179 !
180  SUBROUTINE ocean_cpl_ice( &
181  rlon, rlat, swnet, lwnet, alb1, &
182  fder_old, &
183  itime, dtime, knon, knindex, &
184  lafin, &
185  p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
186  acoefh, acoefq, bcoefh, bcoefq, &
187  acoefu, acoefv, bcoefu, bcoefv, &
188  ps, u1, v1, gustiness, pctsrf, &
189  radsol, snow, qsurf, &
190  alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
191  tsurf_new, dflux_s, dflux_l)
192 !
193 ! This subroutine treats the ocean where there is ice. The subroutine first receives
194 ! fields from coupler, then some calculations at surface is done and finally sends
195 ! some fields to the coupler.
196 !
197  USE dimphy, ONLY : klon
198  USE cpl_mod
199  USE calcul_fluxs_mod
200  USE indice_sol_mod
201 
202  include "YOMCST.h"
203  include "clesphys.h"
204 
205 ! Input arguments
206 !****************************************************************************************
207  INTEGER, INTENT(IN) :: itime, knon
208  INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
209  LOGICAL, INTENT(IN) :: lafin
210  REAL, INTENT(IN) :: dtime
211  REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
212  REAL, DIMENSION(klon), INTENT(IN) :: swnet
213  REAL, DIMENSION(klon), INTENT(IN) :: lwnet
214  REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
215  REAL, DIMENSION(klon), INTENT(IN) :: fder_old
216  REAL, DIMENSION(klon), INTENT(IN) :: p1lay
217  REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
218  REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
219  REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
220  REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
221  REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
222  REAL, DIMENSION(klon), INTENT(IN) :: ps
223  REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
224  REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
225 
226 ! In/output arguments
227 !****************************************************************************************
228  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
229  REAL, DIMENSION(klon), INTENT(INOUT) :: snow
230 
231 ! Output arguments
232 !****************************************************************************************
233  REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
234  REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
235  REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
236  REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
237  REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
238  REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
239 
240 ! Local variables
241 !****************************************************************************************
242  INTEGER :: i
243  INTEGER, DIMENSION(1) :: iloc
244  LOGICAL :: check=.false.
245  REAL, PARAMETER :: t_grnd=271.35
246  REAL, DIMENSION(klon) :: cal, beta, dif_grnd
247  REAL, DIMENSION(klon) :: tsurf_cpl, fder_new
248  REAL, DIMENSION(klon) :: alb_cpl
249  REAL, DIMENSION(klon) :: u0, v0
250  REAL, DIMENSION(klon) :: u1_lay, v1_lay
251 
252 ! End definitions
253 !****************************************************************************************
254 
255  IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
256 
257 !****************************************************************************************
258 ! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
259 !
260 !****************************************************************************************
261 
262  CALL cpl_receive_seaice_fields(knon, knindex, &
263  tsurf_cpl, alb_cpl, u0, v0)
264 
265  alb1_new(1:knon) = alb_cpl(1:knon)
266  alb2_new(1:knon) = alb_cpl(1:knon)
267 
268 
269 !****************************************************************************************
270 ! Calculate fluxes at surface
271 !
272 !****************************************************************************************
273  cal = 0.
274  dif_grnd = 0.
275  beta = 1.0
276 
277  DO i = 1, knon
278  u1_lay(i) = u1(i) - u0(i)
279  v1_lay(i) = v1(i) - v0(i)
280  END DO
281 
282  CALL calcul_fluxs(knon, is_sic, dtime, &
283  tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
284  precip_rain, precip_snow, snow, qsurf, &
285  radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
286  f_qsat_oce,acoefh, acoefq, bcoefh, bcoefq, &
287  tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
288 
289 
290 ! - Flux calculation at first modele level for U and V
291  CALL calcul_flux_wind(knon, dtime, &
292  u0, v0, u1, v1, gustiness, cdragm, &
293  acoefu, acoefv, bcoefu, bcoefv, &
294  p1lay, temp_air, &
295  flux_u1, flux_v1)
296 
297 !****************************************************************************************
298 ! Calculate fder : flux derivative (sensible and latente)
299 !
300 !****************************************************************************************
301  fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
302 
303  iloc = maxloc(fder_new(1:klon))
304  IF (check .AND. fder_new(iloc(1))> 0.) THEN
305  WRITE(*,*)'**** Debug fder ****'
306  WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
307  WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
308  dflux_s(iloc(1)), dflux_l(iloc(1))
309  ENDIF
310 
311 !****************************************************************************************
312 ! Send and cumulate fields to the coupler
313 !
314 !****************************************************************************************
315 
316  CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
317  pctsrf, lafin, rlon, rlat, &
318  swnet, lwnet, fluxlat, fluxsens, &
319  precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1)
320 
321 
322  END SUBROUTINE ocean_cpl_ice
323 !
324 !****************************************************************************************
325 !
326 END MODULE ocean_cpl_mod
cpl_mod
Definition: cpl_mod.F90:2
ocean_cpl_mod::ocean_cpl_init
subroutine, public ocean_cpl_init(dtime, rlon, rlat)
Definition: ocean_cpl_mod.F90:20
calcul_fluxs_mod::calcul_flux_wind
subroutine calcul_flux_wind(knon, dtime, u0, v0, u1, v1, gustiness, cdrag_m, AcoefU, AcoefV, BcoefU, BcoefV, p1lay, t1lay, flux_u1, flux_v1)
Definition: calcul_fluxs_mod.F90:258
dtime
!$Header!integer nvarmx dtime
Definition: gradsdef.h:20
dimphy::klon
integer, save klon
Definition: dimphy.F90:3
ocean_cpl_mod::ocean_cpl_ice
subroutine, public ocean_cpl_ice(rlon, rlat, swnet, lwnet, alb1, fder_old, itime, dtime, knon, knindex, lafin, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, AcoefU, AcoefV, BcoefU, BcoefV, ps, u1, v1, gustiness, pctsrf, radsol, snow, qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, tsurf_new, dflux_s, dflux_l)
Definition: ocean_cpl_mod.F90:192
f_qsat_oce
!$Id ok_orolf LOGICAL ok_limitvrai LOGICAL ok_all_xml INTEGER iflag_ener_conserv REAL solaire RCFC12 RCFC12_act CFC12_ppt!IM ajout CFMIP2 CMIP5 LOGICAL ok_4xCO2atm RCFC12_per CFC12_ppt_per!OM correction du bilan d eau global!OM Correction sur precip KE REAL cvl_corr!OM Fonte calotte dans bilan eau LOGICAL ok_lic_melt!IM simulateur ISCCP INTEGER overlap!IM seuils cdrh REAL cdhmax!IM param stabilite s terres et en dehors REAL f_ri_cd_min!IM MAFo pmagic evap0!Frottement au f_cdrag_oce REAL f_qsat_oce
Definition: clesphys.h:46
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
ocean_cpl_mod
Definition: ocean_cpl_mod.F90:2
rlat
c c $Id c nbregdyn DO klon c rlat(i) c ENDIF!lon c ENDIF!lat ENDIF!pctsrf ENDDO!klon ENDDO!nbregdyn cIM 190504 ENDIF!ok_regdyn cIM somme de toutes les nhistoW BEG IF(debut) THEN DO nreg
cpl_mod::cpl_receive_seaice_fields
subroutine, public cpl_receive_seaice_fields(knon, knindex, tsurf_new, alb_new, u0_new, v0_new)
Definition: cpl_mod.F90:481
cpl_mod::cpl_send_seaice_fields
subroutine, public cpl_send_seaice_fields(itime, dtime, knon, knindex, pctsrf, lafin, rlon, rlat, swdown, lwdown, fluxlat, fluxsens, precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy)
Definition: cpl_mod.F90:725
ocean_cpl_mod::ocean_cpl_noice
subroutine, public ocean_cpl_noice(swnet, lwnet, alb1, windsp, fder_old, itime, dtime, knon, knindex, p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, AcoefU, AcoefV, BcoefU, BcoefV, ps, u1, v1, gustiness, radsol, snow, agesno, qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, tsurf_new, dflux_s, dflux_l)
Definition: ocean_cpl_mod.F90:55
calcul_fluxs_mod
Definition: calcul_fluxs_mod.F90:2
itime
!$Header!integer nvarmx s s itime
Definition: gradsdef.h:20
indice_sol_mod::is_sic
integer, parameter is_sic
Definition: indice_sol_mod.F90:3
cpl_mod::cpl_send_ocean_fields
subroutine, public cpl_send_ocean_fields(itime, knon, knindex, swdown, lwdown, fluxlat, fluxsens, precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp)
Definition: cpl_mod.F90:534
cpl_mod::cpl_receive_ocean_fields
subroutine, public cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, v0_new)
Definition: cpl_mod.F90:418
calcul_fluxs_mod::calcul_fluxs
subroutine calcul_fluxs(knon, nisurf, dtime, tsurf, p1lay, cal, beta, cdragh, cdragq, ps, precip_rain, precip_snow, snow, qsurf, radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay, gustiness, fqsat, petAcoef, peqAcoef, petBcoef, peqBcoef, tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
Definition: calcul_fluxs_mod.F90:12
dimphy
Definition: dimphy.F90:1
indice_sol_mod::is_oce
integer, parameter is_oce
Definition: indice_sol_mod.F90:3
indice_sol_mod
Definition: indice_sol_mod.F90:1
rlon
c c $Id c nbregdyn DO klon c rlon(i)
cpl_mod::cpl_init
subroutine, public cpl_init(dtime, rlon, rlat)
Definition: cpl_mod.F90:100