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

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

If the ocean skin parameterization is working (passively or actively,
activate_ocean_skin >= 1) and we are coupled to the ocean then
receive bulk salinity of the surface layer of the ocean from the ocean
and feed it to procedure bulk_flux instead of the constant
value 35. If the ocean skin parameterization is working actively
(activate_ocean_skin == 2) and we are coupled to the ocean then send
ocean-air interface temperature to the ocean. We can only send
interface temperature from the previous time-step since communication
with the ocean is before the call to bulk_flux. In module cpl_mod,
define cpl_t_int with rank 1: no dimension for cpl_index because
t_int is only defined over ocean. New dummy argument sss of
procedures cpl_receive_ocean_fields and ocean_cpl_noice. New dummy
argument t_int of cpl_send_ocean_fields. In procedure
surf_ocean, rename local variable s1 to sss and give it the size
klon, which is required by the coupling machinery.
  • 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.7 KB
Line 
1!
2! $Id: ocean_cpl_mod.F90 3627 2020-02-03 13:27:46Z 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)
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
95! In/Output arguments
96!****************************************************************************************
97    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
98    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
99    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
100 
101! Output arguments
102!****************************************************************************************
103    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
104    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
105    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
106    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
107    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
108
109    REAL, INTENT(OUT):: sss(:) ! (klon)
110    ! bulk salinity of the surface layer of the ocean, in ppt
111 
112
113! Local variables
114!****************************************************************************************
115    INTEGER               :: i, j
116    INTEGER, DIMENSION(1) :: iloc
117    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
118    REAL, DIMENSION(klon) :: fder_new
119    REAL, DIMENSION(klon) :: tsurf_cpl
120    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
121    REAL, DIMENSION(klon) :: u1_lay, v1_lay
122    LOGICAL               :: check=.FALSE.
123    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
124    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
125
126! End definitions
127!****************************************************************************************
128
129    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
130
131!****************************************************************************************
132! Receive sea-surface temperature(tsurf_cpl) from coupler
133!
134!****************************************************************************************
135    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
136         sss)
137
138!****************************************************************************************
139! Calculate fluxes at surface
140!
141!****************************************************************************************
142    cal = 0.
143    beta = 1.
144    dif_grnd = 0.
145    agesno(:) = 0.
146    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
147   
148
149    DO i = 1, knon
150       u1_lay(i) = u1(i) - u0_cpl(i)
151       v1_lay(i) = v1(i) - v0_cpl(i)
152    END DO
153
154    CALL calcul_fluxs(knon, is_oce, dtime, &
155         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
156         beta, cdragh, cdragq, ps, &
157         precip_rain, precip_snow, snow, qsurf,  &
158         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
159         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
160         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
161         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
162
163    if (activate_ocean_skin == 2) then
164       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
165       ! the new bulk SST tsurf_cpl:
166       tsurf_new = tsurf_cpl
167    end if
168
169    ! assertion: tsurf_new == tsurf_cpl
170   
171    do j = 1, knon
172      i = knindex(j)
173      sens_prec_liq_o(i,1) = sens_prec_liq(j)
174      sens_prec_sol_o(i,1) = sens_prec_sol(j)
175      lat_prec_liq_o(i,1) = lat_prec_liq(j)
176      lat_prec_sol_o(i,1) = lat_prec_sol(j)
177    enddo
178
179
180   
181! - Flux calculation at first modele level for U and V
182    CALL calcul_flux_wind(knon, dtime, &
183         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
184         AcoefU, AcoefV, BcoefU, BcoefV, &
185         p1lay, temp_air, &
186         flux_u1, flux_v1) 
187
188!****************************************************************************************
189! Calculate fder : flux derivative (sensible and latente)
190!
191!****************************************************************************************
192    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
193   
194    iloc = MAXLOC(fder_new(1:klon))
195    IF (check .AND. fder_new(iloc(1))> 0.) THEN
196       WRITE(*,*)'**** Debug fder****'
197       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
198       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
199            dflux_s(iloc(1)), dflux_l(iloc(1))
200    ENDIF
201
202!****************************************************************************************
203! Send and cumulate fields to the coupler
204!
205!****************************************************************************************
206
207    CALL cpl_send_ocean_fields(itime, knon, knindex, &
208         swnet, lwnet, fluxlat, fluxsens, &
209         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp,&
210         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, tsurf_in)
211   
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.