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

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

Modify sensible heat due to rain sent to the ocean

Modify the sensible heat flux due to rain which is sent to the
ocean. Replace the computation of sens_prec_liq in procedure
calcul_fluxs by a call to sens_heat_rain. Set sens_prec_sol in
procedure calcul_fluxs to 0 because, for now, sens_heat_rain is
supposed to account for both rain and snow.

For the call to sens_heat_rain in procedure calcul_fluxs, we need
an additional dummy argument rhoa of calcul_fluxs. Add dummy
argument rhoa to ocean_cpl_noice, ocean_forced_noice,
ocean_forced_ice and ocean_cpl_ice because we need to pass it down
to calcul_fluxs.

Change the dimension of sens_prec_liq and sens_prec_sol in
procedures calcul_fluxs, ocean_cpl_noice, ocean_cpl_ice,
ocean_forced_noice, ocean_forced_ice, cpl_send_ocean_fields and
cpl_send_seaice_fields to knon.

In procedures ocean_forced_noice and ocean_cpl_noice, promote
sens_prec_liq from local variable to dummy argument because we need
it in surf_ocean. Remove useless initialization of sens_prec_liq
and sens_prec_sol in ocean_cpl_noice, ocean_cpl_ice,
ocean_forced_ice and ocean_forced_noice: they are intent out in
calcul_fluxs.

Remove variable rf of module phys_output_var_mod, we use
sens_prec_liq instead. Remove local variable yrf of procedure
pbl_surface. rf and yrf appeared in pbl_surface only to be output.
Remove variable o_rf of module phys_output_ctrlout_mod. Remove
dummy argument rf of procedure surf_ocean.

Do not call sens_heat_rain in surf_ocean since we now call it
from calcul_fluxs. Move the computation of rhoa in surf_ocean
before the calls to ocean_cpl_noice and ocean_forced_noice.

Add the computation of rhoa in surf_seaice, to pass it down to
ocean_cpl_ice and ocean_forced_ice.

If activate_ocean_skin == 1 then the results are changed because the
call to sens_heat_rain in calcul_fluxs now uses the SST from the
current time step of physics. On this point, the present revision
reverses revision [3463].
  • 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.9 KB
Line 
1!
2! $Id: ocean_cpl_mod.F90 3687 2020-05-27 14:52:16Z 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, sens_prec_liq, sss, s_int, rhoa)
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    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
96
97! In/Output arguments
98!****************************************************************************************
99    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
100    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
101    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
102 
103! Output arguments
104!****************************************************************************************
105    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
106    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
107    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
108    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
109    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
110    REAL, intent(out):: sens_prec_liq(:) ! (knon)
111
112    REAL, INTENT(OUT):: sss(:) ! (klon)
113    ! bulk salinity of the surface layer of the ocean, in ppt
114 
115
116! Local variables
117!****************************************************************************************
118    INTEGER               :: i, j
119    INTEGER, DIMENSION(1) :: iloc
120    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
121    REAL, DIMENSION(klon) :: fder_new
122    REAL, DIMENSION(klon) :: tsurf_cpl
123    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
124    REAL, DIMENSION(klon) :: u1_lay, v1_lay
125    LOGICAL               :: check=.FALSE.
126    REAL sens_prec_sol(knon) 
127    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
128
129! End definitions
130!****************************************************************************************
131
132    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
133
134!****************************************************************************************
135! Receive sea-surface temperature(tsurf_cpl) from coupler
136!
137!****************************************************************************************
138    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
139         sss)
140
141!****************************************************************************************
142! Calculate fluxes at surface
143!
144!****************************************************************************************
145    cal = 0.
146    beta = 1.
147    dif_grnd = 0.
148    agesno(:) = 0.
149    lat_prec_liq = 0.; lat_prec_sol = 0.
150   
151
152    DO i = 1, knon
153       u1_lay(i) = u1(i) - u0_cpl(i)
154       v1_lay(i) = v1(i) - v0_cpl(i)
155    END DO
156
157    CALL calcul_fluxs(knon, is_oce, dtime, &
158         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
159         beta, cdragh, cdragq, ps, &
160         precip_rain, precip_snow, snow, qsurf,  &
161         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
162         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
163         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
164         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
165
166    if (activate_ocean_skin == 2) then
167       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
168       ! the new bulk SST tsurf_cpl:
169       tsurf_new = tsurf_cpl
170    end if
171
172    ! assertion: tsurf_new == tsurf_cpl
173   
174    do j = 1, knon
175      i = knindex(j)
176      sens_prec_liq_o(i,1) = sens_prec_liq(j)
177      sens_prec_sol_o(i,1) = sens_prec_sol(j)
178      lat_prec_liq_o(i,1) = lat_prec_liq(j)
179      lat_prec_sol_o(i,1) = lat_prec_sol(j)
180    enddo
181
182
183   
184! - Flux calculation at first modele level for U and V
185    CALL calcul_flux_wind(knon, dtime, &
186         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
187         AcoefU, AcoefV, BcoefU, BcoefV, &
188         p1lay, temp_air, &
189         flux_u1, flux_v1) 
190
191!****************************************************************************************
192! Calculate fder : flux derivative (sensible and latente)
193!
194!****************************************************************************************
195    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
196   
197    iloc = MAXLOC(fder_new(1:klon))
198    IF (check .AND. fder_new(iloc(1))> 0.) THEN
199       WRITE(*,*)'**** Debug fder****'
200       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
201       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
202            dflux_s(iloc(1)), dflux_l(iloc(1))
203    ENDIF
204
205!****************************************************************************************
206! Send and cumulate fields to the coupler
207!
208!****************************************************************************************
209
210    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
211         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
212         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
213         lat_prec_sol, tsurf_in, s_int)
214
215  END SUBROUTINE ocean_cpl_noice
216!
217!****************************************************************************************
218!
219  SUBROUTINE ocean_cpl_ice( &
220       rlon, rlat, swnet, lwnet, alb1, &
221       fder_old, &
222       itime, dtime, knon, knindex, &
223       lafin, &
224       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
225       AcoefH, AcoefQ, BcoefH, BcoefQ, &
226       AcoefU, AcoefV, BcoefU, BcoefV, &
227       ps, u1, v1, gustiness, pctsrf, &
228       radsol, snow, qsurf, &
229       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
230       tsurf_new, dflux_s, dflux_l, rhoa)
231!
232! This subroutine treats the ocean where there is ice. The subroutine first receives
233! fields from coupler, then some calculations at surface is done and finally sends
234! some fields to the coupler.
235!   
236    USE dimphy,           ONLY : klon
237    USE cpl_mod
238    USE calcul_fluxs_mod
239    USE indice_sol_mod
240    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
241
242    INCLUDE "YOMCST.h"
243    INCLUDE "clesphys.h"
244
245! Input arguments
246!****************************************************************************************
247    INTEGER, INTENT(IN)                      :: itime, knon
248    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
249    LOGICAL, INTENT(IN)                      :: lafin
250    REAL, INTENT(IN)                         :: dtime
251    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
252    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
253    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
254    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
255    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
256    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
257    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
258    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
259    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
260    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
261    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
262    REAL, DIMENSION(klon), INTENT(IN)        :: ps
263    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
264    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
265    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
266
267! In/output arguments
268!****************************************************************************************
269    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
270    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
271
272! Output arguments
273!****************************************************************************************
274    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
275    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
276    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
277    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
278    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
279    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
280 
281
282! Local variables
283!****************************************************************************************
284    INTEGER                 :: i, j
285    INTEGER, DIMENSION(1)   :: iloc
286    LOGICAL                 :: check=.FALSE.
287    REAL, PARAMETER         :: t_grnd=271.35
288    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
289    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
290    REAL, DIMENSION(klon)   :: alb_cpl
291    REAL, DIMENSION(klon)   :: u0, v0
292    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
293    REAL sens_prec_liq(knon), sens_prec_sol(knon)   
294    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
295
296! End definitions
297!****************************************************************************************
298   
299    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
300
301    lat_prec_liq = 0.; lat_prec_sol = 0.
302
303!****************************************************************************************
304! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
305!
306!****************************************************************************************
307
308    CALL cpl_receive_seaice_fields(knon, knindex, &
309         tsurf_cpl, alb_cpl, u0, v0)
310
311    alb1_new(1:knon) = alb_cpl(1:knon)
312    alb2_new(1:knon) = alb_cpl(1:knon)   
313
314   
315!****************************************************************************************
316! Calculate fluxes at surface
317!
318!****************************************************************************************
319    cal = 0.
320    dif_grnd = 0.
321    beta = 1.0
322   
323    DO i = 1, knon
324       u1_lay(i) = u1(i) - u0(i)
325       v1_lay(i) = v1(i) - v0(i)
326    END DO
327
328    CALL calcul_fluxs(knon, is_sic, dtime, &
329         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
330         precip_rain, precip_snow, snow, qsurf,  &
331         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
332         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
333         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
334         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
335    do j = 1, knon
336      i = knindex(j)
337      sens_prec_liq_o(i,2) = sens_prec_liq(j)
338      sens_prec_sol_o(i,2) = sens_prec_sol(j)
339      lat_prec_liq_o(i,2) = lat_prec_liq(j)
340      lat_prec_sol_o(i,2) = lat_prec_sol(j)
341    enddo
342
343
344! - Flux calculation at first modele level for U and V
345    CALL calcul_flux_wind(knon, dtime, &
346         u0, v0, u1, v1, gustiness, cdragm, &
347         AcoefU, AcoefV, BcoefU, BcoefV, &
348         p1lay, temp_air, &
349         flux_u1, flux_v1) 
350
351!****************************************************************************************
352! Calculate fder : flux derivative (sensible and latente)
353!
354!****************************************************************************************
355    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
356   
357    iloc = MAXLOC(fder_new(1:klon))
358    IF (check .AND. fder_new(iloc(1))> 0.) THEN
359       WRITE(*,*)'**** Debug fder ****'
360       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
361       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
362            dflux_s(iloc(1)), dflux_l(iloc(1))
363    ENDIF
364
365!****************************************************************************************
366! Send and cumulate fields to the coupler
367!
368!****************************************************************************************
369
370    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
371       pctsrf, lafin, rlon, rlat, &
372       swnet, lwnet, fluxlat, fluxsens, &
373       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
374       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
375
376 
377
378  END SUBROUTINE ocean_cpl_ice
379! 
380!****************************************************************************************
381!
382END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.