source: LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/ocean_cpl_mod.f90 @ 6058

Last change on this file since 6058 was 5868, checked in by yann meurdesoif, 3 months ago

Separate pbl_surface into 3 subroutines for GPU port

  • pbl_surface_uncompress_pre : prepare computation for sub subsurface before compressing
  • pbl_surface_subsrf : each sub-surface is called one after other (horizontal = knon)
  • pbl_surface_uncompress_post : sub-surface are uncompressed, computation is done on whole domain (horizontal = klon)

pbl_surface_main becomes the driver, calling pbl_surface_uncompress_pre, and then looping under sub-surface (and calling pbl_surface_subsrf) and then calling pbl_surface_uncompress_post.

YM
  • 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: 16.0 KB
Line 
1!
2! $Id: ocean_cpl_mod.f90 5868 2025-11-17 14:50:06Z fhourdin $
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(knon), INTENT(IN)     :: knindex
79    REAL, INTENT(IN)                         :: dtime
80    REAL, DIMENSION(knon), INTENT(IN)        :: swnet
81    REAL, DIMENSION(knon), INTENT(IN)        :: lwnet
82    REAL, DIMENSION(knon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
83    REAL, DIMENSION(knon), INTENT(IN)        :: windsp
84    REAL, DIMENSION(knon), INTENT(IN)        :: fder_old
85    REAL, DIMENSION(knon), INTENT(IN)        :: p1lay
86    REAL, DIMENSION(knon), INTENT(IN)        :: cdragh, cdragq, cdragm
87    REAL, DIMENSION(knon), INTENT(IN)        :: precip_rain, precip_snow
88    REAL, DIMENSION(knon), INTENT(IN)        :: temp_air, spechum
89    REAL, DIMENSION(knon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
90    REAL, DIMENSION(knon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
91    REAL, DIMENSION(knon), INTENT(IN)        :: ps
92    REAL, DIMENSION(knon), INTENT(IN)        :: u1, v1, gustiness
93    REAL, INTENT(IN) :: tsurf_in(knon) ! (knon)
94
95    real, intent(in):: delta_sal(knon) ! (knon)
96    ! ocean-air interface salinity minus bulk salinity, in ppt
97
98    real, intent(in):: rhoa(knon) ! (knon) density of moist air  (kg / m3)
99
100    REAL, intent(in):: delta_sst(knon) ! (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) ! (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) ! (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) ! (knon)
114    ! (tks / tkt) * dTer, in K
115
116! In/Output arguments
117!****************************************************************************************
118    REAL, DIMENSION(knon), INTENT(INOUT)     :: radsol
119    REAL, DIMENSION(knon), INTENT(INOUT)     :: snow
120    REAL, DIMENSION(knon), INTENT(INOUT)     :: agesno
121
122! Output arguments
123!****************************************************************************************
124    REAL, DIMENSION(knon), INTENT(OUT)       :: qsurf
125    REAL, DIMENSION(knon), INTENT(OUT)       :: evap, fluxsens, fluxlat
126    REAL, DIMENSION(knon), INTENT(OUT)       :: flux_u1, flux_v1
127    REAL, DIMENSION(knon), INTENT(OUT)       :: tsurf_new
128    REAL, DIMENSION(knon), INTENT(OUT)       :: dflux_s, dflux_l
129    REAL, intent(out):: sens_prec_liq(knon) ! (knon)
130
131    REAL, INTENT(OUT):: sss(knon) ! (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(knon) :: cal, beta, dif_grnd
140    REAL, DIMENSION(knon) :: fder_new
141    REAL, DIMENSION(knon) :: tsurf_cpl
142    REAL, DIMENSION(knon) :: u0_cpl, v0_cpl
143    REAL, DIMENSION(knon) :: u1_lay, v1_lay
144    LOGICAL               :: check=.FALSE.
145    REAL sens_prec_sol(knon)
146    REAL, DIMENSION(knon) :: lat_prec_liq, lat_prec_sol
147    REAL, DIMENSION(knon) :: tsurf_flux
148
149! End definitions
150!****************************************************************************************
151
152    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
153
154!****************************************************************************************
155! Receive sea-surface temperature(tsurf_cpl) from coupler
156!
157!****************************************************************************************
158    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
159         sss)
160
161!****************************************************************************************
162! Calculate fluxes at surface
163!
164!****************************************************************************************
165    cal = 0.
166    beta = 1.
167    dif_grnd = 0.
168    agesno(:) = 0.
169    lat_prec_liq = 0.; lat_prec_sol = 0.
170
171
172    DO i = 1, knon
173       u1_lay(i) = u1(i) - u0_cpl(i)
174       v1_lay(i) = v1(i) - v0_cpl(i)
175    END DO
176   
177    IF (activate_ocean_skin == 2) THEN
178
179      CALL calcul_fluxs(knon, is_oce, dtime, &
180         tsurf_in, p1lay, cal, &
181         beta, cdragh, cdragq, ps, &
182         precip_rain, precip_snow, snow, qsurf,  &
183         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
184         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
185         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
186         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
187       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
188       ! the new bulk SST tsurf_cpl:
189       tsurf_new = tsurf_cpl
190    ELSE
191      CALL calcul_fluxs(knon, is_oce, dtime, &
192         tsurf_cpl, p1lay, cal, &
193         beta, cdragh, cdragq, ps, &
194         precip_rain, precip_snow, snow, qsurf,  &
195         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
196         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
197         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
198         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
199    ENDIF     
200
201    ! assertion: tsurf_new == tsurf_cpl
202
203    do j = 1, knon
204      i = knindex(j)
205      sens_prec_liq_o(i,1) = sens_prec_liq(j)
206      sens_prec_sol_o(i,1) = sens_prec_sol(j)
207      lat_prec_liq_o(i,1) = lat_prec_liq(j)
208      lat_prec_sol_o(i,1) = lat_prec_sol(j)
209    enddo
210
211
212
213! - Flux calculation at first modele level for U and V
214    CALL calcul_flux_wind(knon, dtime, &
215         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
216         AcoefU, AcoefV, BcoefU, BcoefV, &
217         p1lay, temp_air, &
218         flux_u1, flux_v1)
219
220!****************************************************************************************
221! Calculate fder : flux derivative (sensible and latente)
222!
223!****************************************************************************************
224    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
225
226    IF (check) THEN
227      iloc = MAXLOC(fder_new(1:klon))
228      IF (fder_new(iloc(1))> 0.) THEN
229        WRITE(*,*)'**** Debug fder****'
230        WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
231        WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
232             dflux_s(iloc(1)), dflux_l(iloc(1))
233      ENDIF
234    ENDIF
235
236!****************************************************************************************
237! Send and cumulate fields to the coupler
238!
239!****************************************************************************************
240
241    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
242         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
243         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
244         lat_prec_sol, delta_sst, delta_sal, dTer, dSer, dt_ds)
245
246  END SUBROUTINE ocean_cpl_noice
247!
248!****************************************************************************************
249!
250  SUBROUTINE ocean_cpl_ice( &
251       rlon, rlat, swnet, lwnet, alb1, &
252       fder_old, &
253       itime, dtime, knon, knindex, &
254       lafin, &
255       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
256       AcoefH, AcoefQ, BcoefH, BcoefQ, &
257       AcoefU, AcoefV, BcoefU, BcoefV, &
258       ps, u1, v1, gustiness, pctsrf, &
259       radsol, snow, qsurf, &
260       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
261       tsurf_new, dflux_s, dflux_l, rhoa)
262!
263! This subroutine treats the ocean where there is ice. The subroutine first receives
264! fields from coupler, then some calculations at surface is done and finally sends
265! some fields to the coupler.
266!
267    USE yomcst_mod_h
268USE dimphy,           ONLY : klon
269    USE cpl_mod
270    USE calcul_fluxs_mod
271    USE indice_sol_mod
272    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
273
274
275
276! Input arguments
277!****************************************************************************************
278    INTEGER, INTENT(IN)                      :: itime, knon
279    INTEGER, DIMENSION(knon), INTENT(IN)     :: knindex
280    LOGICAL, INTENT(IN)                      :: lafin
281    REAL, INTENT(IN)                         :: dtime
282    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
283    REAL, DIMENSION(knon), INTENT(IN)        :: swnet
284    REAL, DIMENSION(knon), INTENT(IN)        :: lwnet
285    REAL, DIMENSION(knon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
286    REAL, DIMENSION(knon), INTENT(IN)        :: fder_old
287    REAL, DIMENSION(knon), INTENT(IN)        :: p1lay
288    REAL, DIMENSION(knon), INTENT(IN)        :: cdragh, cdragm
289    REAL, DIMENSION(knon), INTENT(IN)        :: precip_rain, precip_snow
290    REAL, DIMENSION(knon), INTENT(IN)        :: temp_air, spechum
291    REAL, DIMENSION(knon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
292    REAL, DIMENSION(knon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
293    REAL, DIMENSION(knon), INTENT(IN)        :: ps
294    REAL, DIMENSION(knon), INTENT(IN)        :: u1, v1, gustiness
295    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
296    real, intent(in):: rhoa(knon) ! (knon) density of moist air  (kg / m3)
297
298! In/output arguments
299!****************************************************************************************
300    REAL, DIMENSION(knon), INTENT(INOUT)     :: radsol
301    REAL, DIMENSION(knon), INTENT(INOUT)     :: snow
302
303! Output arguments
304!****************************************************************************************
305    REAL, DIMENSION(knon), INTENT(OUT)       :: qsurf
306    REAL, DIMENSION(knon), INTENT(OUT)       :: alb1_new, alb2_new
307    REAL, DIMENSION(knon), INTENT(OUT)       :: evap, fluxsens, fluxlat
308    REAL, DIMENSION(knon), INTENT(OUT)       :: flux_u1, flux_v1
309    REAL, DIMENSION(knon), INTENT(OUT)       :: tsurf_new
310    REAL, DIMENSION(knon), INTENT(OUT)       :: dflux_s, dflux_l     
311 
312
313! Local variables
314!****************************************************************************************
315    INTEGER                 :: i, j
316    INTEGER, DIMENSION(1)   :: iloc
317    LOGICAL                 :: check=.FALSE.
318    REAL, PARAMETER         :: t_grnd=271.35
319    REAL, DIMENSION(knon)   :: cal, beta, dif_grnd
320    REAL, DIMENSION(knon)   :: tsurf_cpl, fder_new
321    REAL, DIMENSION(knon)   :: alb_cpl
322    REAL, DIMENSION(knon)   :: u0, v0
323    REAL, DIMENSION(knon)   :: u1_lay, v1_lay
324    REAL sens_prec_liq(knon), sens_prec_sol(knon)   
325    REAL, DIMENSION(knon) :: lat_prec_liq, lat_prec_sol   
326
327! End definitions
328!****************************************************************************************
329   
330    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
331
332    lat_prec_liq = 0.; lat_prec_sol = 0.
333
334!****************************************************************************************
335! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
336!
337!****************************************************************************************
338
339    CALL cpl_receive_seaice_fields(knon, knindex, &
340         tsurf_cpl, alb_cpl, u0, v0)
341
342    alb1_new(1:knon) = alb_cpl(1:knon)
343    alb2_new(1:knon) = alb_cpl(1:knon)   
344
345   
346!****************************************************************************************
347! Calculate fluxes at surface
348!
349!****************************************************************************************
350    cal = 0.
351    dif_grnd = 0.
352    beta = 1.0
353   
354    DO i = 1, knon
355       u1_lay(i) = u1(i) - u0(i)
356       v1_lay(i) = v1(i) - v0(i)
357    END DO
358
359    CALL calcul_fluxs(knon, is_sic, dtime, &
360         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
361         precip_rain, precip_snow, snow, qsurf,  &
362         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
363         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
364         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
365         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
366    do j = 1, knon
367      i = knindex(j)
368      sens_prec_liq_o(i,2) = sens_prec_liq(j)
369      sens_prec_sol_o(i,2) = sens_prec_sol(j)
370      lat_prec_liq_o(i,2) = lat_prec_liq(j)
371      lat_prec_sol_o(i,2) = lat_prec_sol(j)
372    enddo
373
374
375! - Flux calculation at first modele level for U and V
376    CALL calcul_flux_wind(knon, dtime, &
377         u0, v0, u1, v1, gustiness, cdragm, &
378         AcoefU, AcoefV, BcoefU, BcoefV, &
379         p1lay, temp_air, &
380         flux_u1, flux_v1) 
381
382!****************************************************************************************
383! Calculate fder : flux derivative (sensible and latente)
384!
385!****************************************************************************************
386    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
387   
388 
389    IF (check) THEN
390      IF (fder_new(iloc(1))> 0.) THEN
391       iloc = MAXLOC(fder_new(1:klon))
392       WRITE(*,*)'**** Debug fder ****'
393       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
394       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
395            dflux_s(iloc(1)), dflux_l(iloc(1))
396      ENDIF
397    ENDIF
398
399!****************************************************************************************
400! Send and cumulate fields to the coupler
401!
402!****************************************************************************************
403
404    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
405       pctsrf, lafin, rlon, rlat, &
406       swnet, lwnet, fluxlat, fluxsens, &
407       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
408       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
409
410 
411
412  END SUBROUTINE ocean_cpl_ice
413! 
414!****************************************************************************************
415!
416END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.