source: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90 @ 5128

Last change on this file since 5128 was 5117, checked in by abarral, 5 months ago

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