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

Last change on this file since 5407 was 5285, checked in by abarral, 7 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules
  • 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: 15.5 KB
Line 
1!
2! $Id: ocean_cpl_mod.f90 5285 2024-10-28 13:33:29Z 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  USE clesphys_mod_h
11    IMPLICIT NONE
12  PRIVATE
13
14  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
15
16
17!****************************************************************************************
18!
19CONTAINS
20!
21!****************************************************************************************
22!
23  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
24!
25! Allocate fields for this module and initailize the module mod_cpl
26!
27    USE dimphy,           ONLY : klon
28    USE cpl_mod
29
30! Input arguments
31!*************************************************************************************
32    REAL, INTENT(IN)                  :: dtime
33    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
34
35! Local variables
36!*************************************************************************************
37    INTEGER              :: error
38    CHARACTER (len = 80) :: abort_message
39    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
40
41! Initialize module cpl_init
42    CALL cpl_init(dtime, rlon, rlat)
43
44  END SUBROUTINE ocean_cpl_init
45!
46!****************************************************************************************
47!
48  SUBROUTINE ocean_cpl_noice( &
49       swnet, lwnet, alb1, &
50       windsp, fder_old, &
51       itime, dtime, knon, knindex, &
52       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
53       AcoefH, AcoefQ, BcoefH, BcoefQ, &
54       AcoefU, AcoefV, BcoefU, BcoefV, &
55       ps, u1, v1, gustiness, tsurf_in, &
56       radsol, snow, agesno, &
57       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
58       tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
59       delta_sst, dTer, dSer, dt_ds)
60
61!
62! This subroutine treats the "open ocean", all grid points that are not entierly covered
63! by ice. The subroutine first receives fields from coupler, then some calculations at
64! surface is done and finally it sends some fields to the coupler.
65!
66    USE dimphy,           ONLY : klon
67    USE calcul_fluxs_mod
68    USE indice_sol_mod
69    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
70    USE yomcst_mod_h
71USE cpl_mod, ONLY : gath2cpl, cpl_receive_ocean_fields, &
72         cpl_send_ocean_fields
73    use config_ocean_skin_m, only: activate_ocean_skin
74    USE clesphys_mod_h
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, INTENT(IN) :: tsurf_in(:) ! (klon)
94
95    real, intent(in):: delta_sal(:) ! (knon)
96    ! ocean-air interface salinity minus bulk salinity, in ppt
97
98    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
99
100    REAL, intent(in):: delta_sst(:) ! (knon)
101    ! Ocean-air interface temperature minus bulk SST, in K. Defined
102    ! only if activate_ocean_skin >= 1.
103
104    REAL, intent(in):: dter(:) ! (knon)
105    ! Temperature variation in the diffusive microlayer, that is
106    ! ocean-air interface temperature minus subskin temperature. In
107    ! K.
108
109    REAL, intent(in):: dser(:) ! (knon)
110    ! Salinity variation in the diffusive microlayer, that is
111    ! ocean-air interface salinity minus subskin salinity. In ppt.
112
113    real, intent(in):: dt_ds(:) ! (knon)
114    ! (tks / tkt) * dTer, in K
115
116! In/Output arguments
117!****************************************************************************************
118    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
119    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
120    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
121
122! Output arguments
123!****************************************************************************************
124    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
125    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
126    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
127    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
128    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
129    REAL, intent(out):: sens_prec_liq(:) ! (knon)
130
131    REAL, INTENT(OUT):: sss(:) ! (klon)
132    ! bulk salinity of the surface layer of the ocean, in ppt
133
134
135! Local variables
136!****************************************************************************************
137    INTEGER               :: i, j
138    INTEGER, DIMENSION(1) :: iloc
139    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
140    REAL, DIMENSION(klon) :: fder_new
141    REAL, DIMENSION(klon) :: tsurf_cpl
142    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
143    REAL, DIMENSION(klon) :: u1_lay, v1_lay
144    LOGICAL               :: check=.FALSE.
145    REAL sens_prec_sol(knon)
146    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
147
148! End definitions
149!****************************************************************************************
150
151    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
152
153!****************************************************************************************
154! Receive sea-surface temperature(tsurf_cpl) from coupler
155!
156!****************************************************************************************
157    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
158         sss)
159
160!****************************************************************************************
161! Calculate fluxes at surface
162!
163!****************************************************************************************
164    cal = 0.
165    beta = 1.
166    dif_grnd = 0.
167    agesno(:) = 0.
168    lat_prec_liq = 0.; lat_prec_sol = 0.
169
170
171    DO i = 1, knon
172       u1_lay(i) = u1(i) - u0_cpl(i)
173       v1_lay(i) = v1(i) - v0_cpl(i)
174    END DO
175
176    CALL calcul_fluxs(knon, is_oce, dtime, &
177         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
178         beta, cdragh, cdragq, ps, &
179         precip_rain, precip_snow, snow, qsurf,  &
180         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
181         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
182         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
183         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
184
185    if (activate_ocean_skin == 2) then
186       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
187       ! the new bulk SST tsurf_cpl:
188       tsurf_new = tsurf_cpl
189    end if
190
191    ! assertion: tsurf_new == tsurf_cpl
192
193    do j = 1, knon
194      i = knindex(j)
195      sens_prec_liq_o(i,1) = sens_prec_liq(j)
196      sens_prec_sol_o(i,1) = sens_prec_sol(j)
197      lat_prec_liq_o(i,1) = lat_prec_liq(j)
198      lat_prec_sol_o(i,1) = lat_prec_sol(j)
199    enddo
200
201
202
203! - Flux calculation at first modele level for U and V
204    CALL calcul_flux_wind(knon, dtime, &
205         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
206         AcoefU, AcoefV, BcoefU, BcoefV, &
207         p1lay, temp_air, &
208         flux_u1, flux_v1)
209
210!****************************************************************************************
211! Calculate fder : flux derivative (sensible and latente)
212!
213!****************************************************************************************
214    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
215
216    iloc = MAXLOC(fder_new(1:klon))
217    IF (check .AND. fder_new(iloc(1))> 0.) THEN
218       WRITE(*,*)'**** Debug fder****'
219       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
220       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
221            dflux_s(iloc(1)), dflux_l(iloc(1))
222    ENDIF
223
224!****************************************************************************************
225! Send and cumulate fields to the coupler
226!
227!****************************************************************************************
228
229    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
230         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
231         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
232         lat_prec_sol, delta_sst, delta_sal, dTer, dSer, dt_ds)
233
234  END SUBROUTINE ocean_cpl_noice
235!
236!****************************************************************************************
237!
238  SUBROUTINE ocean_cpl_ice( &
239       rlon, rlat, swnet, lwnet, alb1, &
240       fder_old, &
241       itime, dtime, knon, knindex, &
242       lafin, &
243       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
244       AcoefH, AcoefQ, BcoefH, BcoefQ, &
245       AcoefU, AcoefV, BcoefU, BcoefV, &
246       ps, u1, v1, gustiness, pctsrf, &
247       radsol, snow, qsurf, &
248       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
249       tsurf_new, dflux_s, dflux_l, rhoa)
250!
251! This subroutine treats the ocean where there is ice. The subroutine first receives
252! fields from coupler, then some calculations at surface is done and finally sends
253! some fields to the coupler.
254!
255    USE yomcst_mod_h
256USE dimphy,           ONLY : klon
257    USE cpl_mod
258    USE calcul_fluxs_mod
259    USE indice_sol_mod
260    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
261
262
263
264! Input arguments
265!****************************************************************************************
266    INTEGER, INTENT(IN)                      :: itime, knon
267    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
268    LOGICAL, INTENT(IN)                      :: lafin
269    REAL, INTENT(IN)                         :: dtime
270    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
271    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
272    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
273    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
274    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
275    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
276    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
277    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
278    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
279    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
280    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
281    REAL, DIMENSION(klon), INTENT(IN)        :: ps
282    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
283    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
284    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
285
286! In/output arguments
287!****************************************************************************************
288    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
289    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
290
291! Output arguments
292!****************************************************************************************
293    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
294    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
295    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
296    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
297    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
298    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
299 
300
301! Local variables
302!****************************************************************************************
303    INTEGER                 :: i, j
304    INTEGER, DIMENSION(1)   :: iloc
305    LOGICAL                 :: check=.FALSE.
306    REAL, PARAMETER         :: t_grnd=271.35
307    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
308    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
309    REAL, DIMENSION(klon)   :: alb_cpl
310    REAL, DIMENSION(klon)   :: u0, v0
311    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
312    REAL sens_prec_liq(knon), sens_prec_sol(knon)   
313    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
314
315! End definitions
316!****************************************************************************************
317   
318    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
319
320    lat_prec_liq = 0.; lat_prec_sol = 0.
321
322!****************************************************************************************
323! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
324!
325!****************************************************************************************
326
327    CALL cpl_receive_seaice_fields(knon, knindex, &
328         tsurf_cpl, alb_cpl, u0, v0)
329
330    alb1_new(1:knon) = alb_cpl(1:knon)
331    alb2_new(1:knon) = alb_cpl(1:knon)   
332
333   
334!****************************************************************************************
335! Calculate fluxes at surface
336!
337!****************************************************************************************
338    cal = 0.
339    dif_grnd = 0.
340    beta = 1.0
341   
342    DO i = 1, knon
343       u1_lay(i) = u1(i) - u0(i)
344       v1_lay(i) = v1(i) - v0(i)
345    END DO
346
347    CALL calcul_fluxs(knon, is_sic, dtime, &
348         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
349         precip_rain, precip_snow, snow, qsurf,  &
350         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
351         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
352         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
353         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
354    do j = 1, knon
355      i = knindex(j)
356      sens_prec_liq_o(i,2) = sens_prec_liq(j)
357      sens_prec_sol_o(i,2) = sens_prec_sol(j)
358      lat_prec_liq_o(i,2) = lat_prec_liq(j)
359      lat_prec_sol_o(i,2) = lat_prec_sol(j)
360    enddo
361
362
363! - Flux calculation at first modele level for U and V
364    CALL calcul_flux_wind(knon, dtime, &
365         u0, v0, u1, v1, gustiness, cdragm, &
366         AcoefU, AcoefV, BcoefU, BcoefV, &
367         p1lay, temp_air, &
368         flux_u1, flux_v1) 
369
370!****************************************************************************************
371! Calculate fder : flux derivative (sensible and latente)
372!
373!****************************************************************************************
374    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
375   
376    iloc = MAXLOC(fder_new(1:klon))
377    IF (check .AND. fder_new(iloc(1))> 0.) THEN
378       WRITE(*,*)'**** Debug fder ****'
379       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
380       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
381            dflux_s(iloc(1)), dflux_l(iloc(1))
382    ENDIF
383
384!****************************************************************************************
385! Send and cumulate fields to the coupler
386!
387!****************************************************************************************
388
389    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
390       pctsrf, lafin, rlon, rlat, &
391       swnet, lwnet, fluxlat, fluxsens, &
392       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
393       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
394
395 
396
397  END SUBROUTINE ocean_cpl_ice
398! 
399!****************************************************************************************
400!
401END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.