source: LMDZ6/trunk/libf/phylmd/ocean_cpl_mod.f90

Last change on this file was 5274, checked in by abarral, 33 hours ago

Replace yomcst.h by existing module
  • 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: 17.1 KB
Line 
1!
2! $Id: ocean_cpl_mod.f90 5274 2024-10-25 13:41:23Z abarral $
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, delta_sal, rhoa, &
58       delta_sst, dTer, dSer, dt_ds)
59
60!
61! This subroutine treats the "open ocean", all grid points that are not entierly covered
62! by ice. The subroutine first receives fields from coupler, then some calculations at
63! surface is done and finally it sends some fields to the coupler.
64!
65    USE dimphy,           ONLY : klon
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 yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
70          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
71          , R_ecc, R_peri, R_incl                                      &
72          , RA, RG, R1SA                                         &
73          , RSIGMA                                                     &
74          , R, RMD, RMV, RD, RV, RCPD                    &
75          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
76          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
77          , RCW, RCS                                                 &
78          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
79          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
80          , RALPD, RBETD, RGAMD
81USE cpl_mod, ONLY : gath2cpl, cpl_receive_ocean_fields, &
82         cpl_send_ocean_fields
83    use config_ocean_skin_m, only: activate_ocean_skin
84
85
86    INCLUDE "clesphys.h"
87!   
88! Input arguments 
89!****************************************************************************************
90    INTEGER, INTENT(IN)                      :: itime, knon
91    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
92    REAL, INTENT(IN)                         :: dtime
93    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
94    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
95    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
96    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
97    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
98    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
99    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
100    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
101    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
102    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
103    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
104    REAL, DIMENSION(klon), INTENT(IN)        :: ps
105    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
106    REAL, INTENT(IN) :: tsurf_in(:) ! (klon)
107
108    real, intent(in):: delta_sal(:) ! (knon)
109    ! ocean-air interface salinity minus bulk salinity, in ppt
110
111    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
112
113    REAL, intent(in):: delta_sst(:) ! (knon)
114    ! Ocean-air interface temperature minus bulk SST, in K. Defined
115    ! only if activate_ocean_skin >= 1.
116
117    REAL, intent(in):: dter(:) ! (knon)
118    ! Temperature variation in the diffusive microlayer, that is
119    ! ocean-air interface temperature minus subskin temperature. In
120    ! K.
121
122    REAL, intent(in):: dser(:) ! (knon)
123    ! Salinity variation in the diffusive microlayer, that is
124    ! ocean-air interface salinity minus subskin salinity. In ppt.
125
126    real, intent(in):: dt_ds(:) ! (knon)
127    ! (tks / tkt) * dTer, in K
128
129! In/Output arguments
130!****************************************************************************************
131    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
132    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
133    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
134 
135! Output arguments
136!****************************************************************************************
137    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
138    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
139    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
140    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
141    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
142    REAL, intent(out):: sens_prec_liq(:) ! (knon)
143
144    REAL, INTENT(OUT):: sss(:) ! (klon)
145    ! bulk salinity of the surface layer of the ocean, in ppt
146 
147
148! Local variables
149!****************************************************************************************
150    INTEGER               :: i, j
151    INTEGER, DIMENSION(1) :: iloc
152    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
153    REAL, DIMENSION(klon) :: fder_new
154    REAL, DIMENSION(klon) :: tsurf_cpl
155    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
156    REAL, DIMENSION(klon) :: u1_lay, v1_lay
157    LOGICAL               :: check=.FALSE.
158    REAL sens_prec_sol(knon) 
159    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
160
161! End definitions
162!****************************************************************************************
163
164    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
165
166!****************************************************************************************
167! Receive sea-surface temperature(tsurf_cpl) from coupler
168!
169!****************************************************************************************
170    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
171         sss)
172
173!****************************************************************************************
174! Calculate fluxes at surface
175!
176!****************************************************************************************
177    cal = 0.
178    beta = 1.
179    dif_grnd = 0.
180    agesno(:) = 0.
181    lat_prec_liq = 0.; lat_prec_sol = 0.
182   
183
184    DO i = 1, knon
185       u1_lay(i) = u1(i) - u0_cpl(i)
186       v1_lay(i) = v1(i) - v0_cpl(i)
187    END DO
188
189    CALL calcul_fluxs(knon, is_oce, dtime, &
190         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
191         beta, cdragh, cdragq, ps, &
192         precip_rain, precip_snow, snow, qsurf,  &
193         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
194         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
195         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
196         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
197
198    if (activate_ocean_skin == 2) then
199       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
200       ! the new bulk SST tsurf_cpl:
201       tsurf_new = tsurf_cpl
202    end if
203
204    ! assertion: tsurf_new == tsurf_cpl
205   
206    do j = 1, knon
207      i = knindex(j)
208      sens_prec_liq_o(i,1) = sens_prec_liq(j)
209      sens_prec_sol_o(i,1) = sens_prec_sol(j)
210      lat_prec_liq_o(i,1) = lat_prec_liq(j)
211      lat_prec_sol_o(i,1) = lat_prec_sol(j)
212    enddo
213
214
215   
216! - Flux calculation at first modele level for U and V
217    CALL calcul_flux_wind(knon, dtime, &
218         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
219         AcoefU, AcoefV, BcoefU, BcoefV, &
220         p1lay, temp_air, &
221         flux_u1, flux_v1) 
222
223!****************************************************************************************
224! Calculate fder : flux derivative (sensible and latente)
225!
226!****************************************************************************************
227    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
228   
229    iloc = MAXLOC(fder_new(1:klon))
230    IF (check .AND. fder_new(iloc(1))> 0.) THEN
231       WRITE(*,*)'**** Debug fder****'
232       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
233       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
234            dflux_s(iloc(1)), dflux_l(iloc(1))
235    ENDIF
236
237!****************************************************************************************
238! Send and cumulate fields to the coupler
239!
240!****************************************************************************************
241
242    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
243         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
244         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
245         lat_prec_sol, delta_sst, delta_sal, dTer, dSer, dt_ds)
246
247  END SUBROUTINE ocean_cpl_noice
248!
249!****************************************************************************************
250!
251  SUBROUTINE ocean_cpl_ice( &
252       rlon, rlat, swnet, lwnet, alb1, &
253       fder_old, &
254       itime, dtime, knon, knindex, &
255       lafin, &
256       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
257       AcoefH, AcoefQ, BcoefH, BcoefQ, &
258       AcoefU, AcoefV, BcoefU, BcoefV, &
259       ps, u1, v1, gustiness, pctsrf, &
260       radsol, snow, qsurf, &
261       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
262       tsurf_new, dflux_s, dflux_l, rhoa)
263!
264! This subroutine treats the ocean where there is ice. The subroutine first receives
265! fields from coupler, then some calculations at surface is done and finally sends
266! some fields to the coupler.
267!   
268    USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
269          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
270          , R_ecc, R_peri, R_incl                                      &
271          , RA, RG, R1SA                                         &
272          , RSIGMA                                                     &
273          , R, RMD, RMV, RD, RV, RCPD                    &
274          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
275          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
276          , RCW, RCS                                                 &
277          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
278          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
279          , RALPD, RBETD, RGAMD
280USE dimphy,           ONLY : klon
281    USE cpl_mod
282    USE calcul_fluxs_mod
283    USE indice_sol_mod
284    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
285
286
287    INCLUDE "clesphys.h"
288
289! Input arguments
290!****************************************************************************************
291    INTEGER, INTENT(IN)                      :: itime, knon
292    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
293    LOGICAL, INTENT(IN)                      :: lafin
294    REAL, INTENT(IN)                         :: dtime
295    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
296    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
297    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
298    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
299    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
300    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
301    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
302    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
303    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
304    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
305    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
306    REAL, DIMENSION(klon), INTENT(IN)        :: ps
307    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
308    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
309    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
310
311! In/output arguments
312!****************************************************************************************
313    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
314    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
315
316! Output arguments
317!****************************************************************************************
318    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
319    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
320    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
321    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
322    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
323    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
324 
325
326! Local variables
327!****************************************************************************************
328    INTEGER                 :: i, j
329    INTEGER, DIMENSION(1)   :: iloc
330    LOGICAL                 :: check=.FALSE.
331    REAL, PARAMETER         :: t_grnd=271.35
332    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
333    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
334    REAL, DIMENSION(klon)   :: alb_cpl
335    REAL, DIMENSION(klon)   :: u0, v0
336    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
337    REAL sens_prec_liq(knon), sens_prec_sol(knon)   
338    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
339
340! End definitions
341!****************************************************************************************
342   
343    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
344
345    lat_prec_liq = 0.; lat_prec_sol = 0.
346
347!****************************************************************************************
348! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
349!
350!****************************************************************************************
351
352    CALL cpl_receive_seaice_fields(knon, knindex, &
353         tsurf_cpl, alb_cpl, u0, v0)
354
355    alb1_new(1:knon) = alb_cpl(1:knon)
356    alb2_new(1:knon) = alb_cpl(1:knon)   
357
358   
359!****************************************************************************************
360! Calculate fluxes at surface
361!
362!****************************************************************************************
363    cal = 0.
364    dif_grnd = 0.
365    beta = 1.0
366   
367    DO i = 1, knon
368       u1_lay(i) = u1(i) - u0(i)
369       v1_lay(i) = v1(i) - v0(i)
370    END DO
371
372    CALL calcul_fluxs(knon, is_sic, dtime, &
373         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
374         precip_rain, precip_snow, snow, qsurf,  &
375         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
376         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
377         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
378         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
379    do j = 1, knon
380      i = knindex(j)
381      sens_prec_liq_o(i,2) = sens_prec_liq(j)
382      sens_prec_sol_o(i,2) = sens_prec_sol(j)
383      lat_prec_liq_o(i,2) = lat_prec_liq(j)
384      lat_prec_sol_o(i,2) = lat_prec_sol(j)
385    enddo
386
387
388! - Flux calculation at first modele level for U and V
389    CALL calcul_flux_wind(knon, dtime, &
390         u0, v0, u1, v1, gustiness, cdragm, &
391         AcoefU, AcoefV, BcoefU, BcoefV, &
392         p1lay, temp_air, &
393         flux_u1, flux_v1) 
394
395!****************************************************************************************
396! Calculate fder : flux derivative (sensible and latente)
397!
398!****************************************************************************************
399    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
400   
401    iloc = MAXLOC(fder_new(1:klon))
402    IF (check .AND. fder_new(iloc(1))> 0.) THEN
403       WRITE(*,*)'**** Debug fder ****'
404       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
405       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
406            dflux_s(iloc(1)), dflux_l(iloc(1))
407    ENDIF
408
409!****************************************************************************************
410! Send and cumulate fields to the coupler
411!
412!****************************************************************************************
413
414    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
415       pctsrf, lafin, rlon, rlat, &
416       swnet, lwnet, fluxlat, fluxsens, &
417       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
418       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
419
420 
421
422  END SUBROUTINE ocean_cpl_ice
423! 
424!****************************************************************************************
425!
426END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.