source: LMDZ6/branches/Ocean_skin/libf/phylmd/ocean_cpl_mod.F90 @ 3628

Last change on this file since 3628 was 3628, checked in by lguez, 4 years ago

If the ocean skin parameterization is working actively
(activate_ocean_skin == 2) and we are coupled to the ocean then send
ocean-air interface salinity to the ocean. New dummy argument s_int
of procedures ocean_cpl_noice and cpl_send_ocean_fields. We can
only send interface salinity from the previous time-step since
communication with the ocean is before the call to bulk_flux. So make
s_int a state variable: move s_int from phys_output_var_mod to
phys_state_var_mod. Still, we only read s_int from startphy,
define it before the call to surf_ocean and write it to restartphy
if activate_ocean_skin == 2 and type_ocean == 'couple'. In
procedure pbl_surface, for clarity, move the definition of output
variables t_int, dter, dser, tkt, tks, rf, taur to missing_val to
after the call to surf_ocean, with the definition of s_int,
ds_ns, dt_ns to missing_val. This does not change anything for
t_int, dter, dser, tkt, tks, rf, taur. In pbl_surface_newfrac, we
choose to set s_int to 35 for an appearing ocean point, this is
questionable. In surf_ocean, change the intent of s_int from out
to inout.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 14.8 KB
Line 
1!
2! $Id: ocean_cpl_mod.F90 3628 2020-02-04 21:36:32Z lguez $
3!
4MODULE ocean_cpl_mod
5!
6! This module is used both for the sub-surface ocean and sea-ice for the case of a
7! coupled model configuration, ocean=couple.
8!
9
10  IMPLICIT NONE
11  PRIVATE
12
13  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
14
15
16!****************************************************************************************
17!
18CONTAINS
19!
20!****************************************************************************************
21!
22  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
23!
24! Allocate fields for this module and initailize the module mod_cpl
25!
26    USE dimphy,           ONLY : klon
27    USE cpl_mod
28
29! Input arguments
30!*************************************************************************************
31    REAL, INTENT(IN)                  :: dtime
32    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
33
34! Local variables
35!*************************************************************************************
36    INTEGER              :: error
37    CHARACTER (len = 80) :: abort_message
38    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
39
40! Initialize module cpl_init
41    CALL cpl_init(dtime, rlon, rlat)
42   
43  END SUBROUTINE ocean_cpl_init
44!
45!****************************************************************************************
46!
47  SUBROUTINE ocean_cpl_noice( &
48       swnet, lwnet, alb1, &
49       windsp, fder_old, &
50       itime, dtime, knon, knindex, &
51       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
52       AcoefH, AcoefQ, BcoefH, BcoefQ, &
53       AcoefU, AcoefV, BcoefU, BcoefV, &
54       ps, u1, v1, gustiness, tsurf_in, &
55       radsol, snow, agesno, &
56       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
57       tsurf_new, dflux_s, dflux_l, sss, s_int)
58
59!
60! This subroutine treats the "open ocean", all grid points that are not entierly covered
61! by ice. The subroutine first receives fields from coupler, then some calculations at
62! surface is done and finally it sends some fields to the coupler.
63!
64    USE dimphy,           ONLY : klon
65    USE calcul_fluxs_mod
66    USE indice_sol_mod
67    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
68    USE cpl_mod, ONLY : gath2cpl, cpl_receive_ocean_fields, &
69         cpl_send_ocean_fields
70    use config_ocean_skin_m, only: activate_ocean_skin
71
72    INCLUDE "YOMCST.h"
73    INCLUDE "clesphys.h"
74!   
75! Input arguments 
76!****************************************************************************************
77    INTEGER, INTENT(IN)                      :: itime, knon
78    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
79    REAL, INTENT(IN)                         :: dtime
80    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
81    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
82    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
83    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
84    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
85    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
86    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
87    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
88    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
89    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
90    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
91    REAL, DIMENSION(klon), INTENT(IN)        :: ps
92    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
93    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
94    real, intent(in):: s_int(:) ! (knon) ocean-air interface salinity, in ppt
95
96! In/Output arguments
97!****************************************************************************************
98    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
99    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
100    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
101 
102! Output arguments
103!****************************************************************************************
104    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
105    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
106    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
107    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
108    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
109
110    REAL, INTENT(OUT):: sss(:) ! (klon)
111    ! bulk salinity of the surface layer of the ocean, in ppt
112 
113
114! Local variables
115!****************************************************************************************
116    INTEGER               :: i, j
117    INTEGER, DIMENSION(1) :: iloc
118    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
119    REAL, DIMENSION(klon) :: fder_new
120    REAL, DIMENSION(klon) :: tsurf_cpl
121    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
122    REAL, DIMENSION(klon) :: u1_lay, v1_lay
123    LOGICAL               :: check=.FALSE.
124    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
125    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
126
127! End definitions
128!****************************************************************************************
129
130    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
131
132!****************************************************************************************
133! Receive sea-surface temperature(tsurf_cpl) from coupler
134!
135!****************************************************************************************
136    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
137         sss)
138
139!****************************************************************************************
140! Calculate fluxes at surface
141!
142!****************************************************************************************
143    cal = 0.
144    beta = 1.
145    dif_grnd = 0.
146    agesno(:) = 0.
147    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
148   
149
150    DO i = 1, knon
151       u1_lay(i) = u1(i) - u0_cpl(i)
152       v1_lay(i) = v1(i) - v0_cpl(i)
153    END DO
154
155    CALL calcul_fluxs(knon, is_oce, dtime, &
156         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
157         beta, cdragh, cdragq, ps, &
158         precip_rain, precip_snow, snow, qsurf,  &
159         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
160         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
161         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
162         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
163
164    if (activate_ocean_skin == 2) then
165       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
166       ! the new bulk SST tsurf_cpl:
167       tsurf_new = tsurf_cpl
168    end if
169
170    ! assertion: tsurf_new == tsurf_cpl
171   
172    do j = 1, knon
173      i = knindex(j)
174      sens_prec_liq_o(i,1) = sens_prec_liq(j)
175      sens_prec_sol_o(i,1) = sens_prec_sol(j)
176      lat_prec_liq_o(i,1) = lat_prec_liq(j)
177      lat_prec_sol_o(i,1) = lat_prec_sol(j)
178    enddo
179
180
181   
182! - Flux calculation at first modele level for U and V
183    CALL calcul_flux_wind(knon, dtime, &
184         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
185         AcoefU, AcoefV, BcoefU, BcoefV, &
186         p1lay, temp_air, &
187         flux_u1, flux_v1) 
188
189!****************************************************************************************
190! Calculate fder : flux derivative (sensible and latente)
191!
192!****************************************************************************************
193    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
194   
195    iloc = MAXLOC(fder_new(1:klon))
196    IF (check .AND. fder_new(iloc(1))> 0.) THEN
197       WRITE(*,*)'**** Debug fder****'
198       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
199       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
200            dflux_s(iloc(1)), dflux_l(iloc(1))
201    ENDIF
202
203!****************************************************************************************
204! Send and cumulate fields to the coupler
205!
206!****************************************************************************************
207
208    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
209         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
210         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
211         lat_prec_sol, tsurf_in, s_int)
212
213  END SUBROUTINE ocean_cpl_noice
214!
215!****************************************************************************************
216!
217  SUBROUTINE ocean_cpl_ice( &
218       rlon, rlat, swnet, lwnet, alb1, &
219       fder_old, &
220       itime, dtime, knon, knindex, &
221       lafin, &
222       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
223       AcoefH, AcoefQ, BcoefH, BcoefQ, &
224       AcoefU, AcoefV, BcoefU, BcoefV, &
225       ps, u1, v1, gustiness, pctsrf, &
226       radsol, snow, qsurf, &
227       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
228       tsurf_new, dflux_s, dflux_l)
229!
230! This subroutine treats the ocean where there is ice. The subroutine first receives
231! fields from coupler, then some calculations at surface is done and finally sends
232! some fields to the coupler.
233!   
234    USE dimphy,           ONLY : klon
235    USE cpl_mod
236    USE calcul_fluxs_mod
237    USE indice_sol_mod
238    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
239
240    INCLUDE "YOMCST.h"
241    INCLUDE "clesphys.h"
242
243! Input arguments
244!****************************************************************************************
245    INTEGER, INTENT(IN)                      :: itime, knon
246    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
247    LOGICAL, INTENT(IN)                      :: lafin
248    REAL, INTENT(IN)                         :: dtime
249    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
250    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
251    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
252    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
253    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
254    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
255    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
256    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
257    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
258    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
259    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
260    REAL, DIMENSION(klon), INTENT(IN)        :: ps
261    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
262    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
263
264! In/output arguments
265!****************************************************************************************
266    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
267    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
268
269! Output arguments
270!****************************************************************************************
271    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
272    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
273    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
274    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
275    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
276    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
277 
278
279! Local variables
280!****************************************************************************************
281    INTEGER                 :: i, j
282    INTEGER, DIMENSION(1)   :: iloc
283    LOGICAL                 :: check=.FALSE.
284    REAL, PARAMETER         :: t_grnd=271.35
285    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
286    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
287    REAL, DIMENSION(klon)   :: alb_cpl
288    REAL, DIMENSION(klon)   :: u0, v0
289    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
290    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
291    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
292
293! End definitions
294!****************************************************************************************
295   
296    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
297
298    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
299
300!****************************************************************************************
301! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
302!
303!****************************************************************************************
304
305    CALL cpl_receive_seaice_fields(knon, knindex, &
306         tsurf_cpl, alb_cpl, u0, v0)
307
308    alb1_new(1:knon) = alb_cpl(1:knon)
309    alb2_new(1:knon) = alb_cpl(1:knon)   
310
311   
312!****************************************************************************************
313! Calculate fluxes at surface
314!
315!****************************************************************************************
316    cal = 0.
317    dif_grnd = 0.
318    beta = 1.0
319   
320    DO i = 1, knon
321       u1_lay(i) = u1(i) - u0(i)
322       v1_lay(i) = v1(i) - v0(i)
323    END DO
324
325    CALL calcul_fluxs(knon, is_sic, dtime, &
326         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
327         precip_rain, precip_snow, snow, qsurf,  &
328         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
329         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
330         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
331         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
332    do j = 1, knon
333      i = knindex(j)
334      sens_prec_liq_o(i,2) = sens_prec_liq(j)
335      sens_prec_sol_o(i,2) = sens_prec_sol(j)
336      lat_prec_liq_o(i,2) = lat_prec_liq(j)
337      lat_prec_sol_o(i,2) = lat_prec_sol(j)
338    enddo
339
340
341! - Flux calculation at first modele level for U and V
342    CALL calcul_flux_wind(knon, dtime, &
343         u0, v0, u1, v1, gustiness, cdragm, &
344         AcoefU, AcoefV, BcoefU, BcoefV, &
345         p1lay, temp_air, &
346         flux_u1, flux_v1) 
347
348!****************************************************************************************
349! Calculate fder : flux derivative (sensible and latente)
350!
351!****************************************************************************************
352    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
353   
354    iloc = MAXLOC(fder_new(1:klon))
355    IF (check .AND. fder_new(iloc(1))> 0.) THEN
356       WRITE(*,*)'**** Debug fder ****'
357       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
358       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
359            dflux_s(iloc(1)), dflux_l(iloc(1))
360    ENDIF
361
362!****************************************************************************************
363! Send and cumulate fields to the coupler
364!
365!****************************************************************************************
366
367    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
368       pctsrf, lafin, rlon, rlat, &
369       swnet, lwnet, fluxlat, fluxsens, &
370       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
371       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
372
373 
374
375  END SUBROUTINE ocean_cpl_ice
376! 
377!****************************************************************************************
378!
379END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.