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

Last change on this file since 3463 was 3463, checked in by lguez, 5 years ago

Compute surface sensible heat flux and latent heat flux using
ocean-atmosphere interface temperature instead of bulk SST, if
activate_ocean_skin == 2. So we add argument tsurf_in to
ocean_cpl_noice and ocean_forced_noice, and call calcul_fluxs with
tsurf_in. tsurf_in was already an argument of ocean_slab_noice, and
calcul_fluxs was already called with tsurf_in in ocean_slab_noice.

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