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

Last change on this file was 5158, checked in by abarral, 3 months ago

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables
  • 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.4 KB
Line 
1! $Id: ocean_cpl_mod.F90 5158 2024-08-02 12:12:03Z fairhead $
2
3MODULE ocean_cpl_mod
4
5  ! This module is used both for the sub-surface ocean and sea-ice for the case of a
6  ! coupled model configuration, ocean=couple.
7
8  IMPLICIT NONE
9  PRIVATE
10
11  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
12
13
14  !****************************************************************************************
15
16CONTAINS
17
18  !****************************************************************************************
19
20  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
21
22    ! Allocate fields for this module and initailize the module mod_cpl
23
24    USE dimphy, ONLY: klon
25    USE cpl_mod
26
27    ! Input arguments
28    !*************************************************************************************
29    REAL, INTENT(IN) :: dtime
30    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
31
32    ! Local variables
33    !*************************************************************************************
34    INTEGER :: error
35    CHARACTER (len = 80) :: abort_message
36    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
37
38    ! Initialize module cpl_init
39    CALL cpl_init(dtime, rlon, rlat)
40
41  END SUBROUTINE ocean_cpl_init
42
43  !****************************************************************************************
44
45  SUBROUTINE ocean_cpl_noice(&
46          swnet, lwnet, alb1, &
47          windsp, fder_old, &
48          itime, dtime, knon, knindex, &
49          p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
50          AcoefH, AcoefQ, BcoefH, BcoefQ, &
51          AcoefU, AcoefV, BcoefU, BcoefV, &
52          ps, u1, v1, gustiness, tsurf_in, &
53          radsol, snow, agesno, &
54          qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
55          tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
56          delta_sst, dTer, dSer, dt_ds)
57
58    ! This SUBROUTINE treats the "open ocean", all grid points that are not entierly covered
59    ! by ice. The SUBROUTINE first receives fields from coupler, then some calculations at
60    ! surface is done and finally it sends some fields to the coupler.
61
62    USE dimphy, ONLY: klon
63    USE calcul_fluxs_mod
64    USE indice_sol_mod
65    USE phys_output_var_mod, ONLY: sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
66    USE cpl_mod, ONLY: gath2cpl, cpl_receive_ocean_fields, &
67            cpl_send_ocean_fields
68    USE config_ocean_skin_m, ONLY: activate_ocean_skin
69    USE lmdz_clesphys
70    USE lmdz_yomcst
71
72    IMPLICIT NONE
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    DO i = 1, knon
170      u1_lay(i) = u1(i) - u0_cpl(i)
171      v1_lay(i) = v1(i) - v0_cpl(i)
172    END DO
173
174    CALL calcul_fluxs(knon, is_oce, dtime, &
175            merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
176            beta, cdragh, cdragq, ps, &
177            precip_rain, precip_snow, snow, qsurf, &
178            radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
179            f_qsat_oce, AcoefH, AcoefQ, BcoefH, BcoefQ, &
180            tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
181            sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
182
183    IF (activate_ocean_skin == 2) THEN
184      ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
185      ! the new bulk SST tsurf_cpl:
186      tsurf_new = tsurf_cpl
187    end if
188
189    ! assertion: tsurf_new == tsurf_cpl
190
191    DO j = 1, knon
192      i = knindex(j)
193      sens_prec_liq_o(i, 1) = sens_prec_liq(j)
194      sens_prec_sol_o(i, 1) = sens_prec_sol(j)
195      lat_prec_liq_o(i, 1) = lat_prec_liq(j)
196      lat_prec_sol_o(i, 1) = lat_prec_sol(j)
197    enddo
198
199
200
201    ! - Flux calculation at first modele level for U and V
202    CALL calcul_flux_wind(knon, dtime, &
203            u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
204            AcoefU, AcoefV, BcoefU, BcoefV, &
205            p1lay, temp_air, &
206            flux_u1, flux_v1)
207
208    !****************************************************************************************
209    ! Calculate fder : flux derivative (sensible and latente)
210
211    !****************************************************************************************
212    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
213
214    iloc = MAXLOC(fder_new(1:klon))
215    IF (check .AND. fder_new(iloc(1))> 0.) THEN
216      WRITE(*, *)'**** Debug fder****'
217      WRITE(*, *)'max fder(', iloc(1), ') = ', fder_new(iloc(1))
218      WRITE(*, *)'fder_old, dflux_s, dflux_l', fder_old(iloc(1)), &
219              dflux_s(iloc(1)), dflux_l(iloc(1))
220    ENDIF
221
222    !****************************************************************************************
223    ! Send and cumulate fields to the coupler
224
225    !****************************************************************************************
226
227    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
228            fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
229            flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
230            lat_prec_sol, delta_sst, delta_sal, dTer, dSer, dt_ds)
231
232  END SUBROUTINE ocean_cpl_noice
233
234  !****************************************************************************************
235
236  SUBROUTINE ocean_cpl_ice(&
237          rlon, rlat, swnet, lwnet, alb1, &
238          fder_old, &
239          itime, dtime, knon, knindex, &
240          lafin, &
241          p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
242          AcoefH, AcoefQ, BcoefH, BcoefQ, &
243          AcoefU, AcoefV, BcoefU, BcoefV, &
244          ps, u1, v1, gustiness, pctsrf, &
245          radsol, snow, qsurf, &
246          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
247          tsurf_new, dflux_s, dflux_l, rhoa)
248
249    ! This SUBROUTINE treats the ocean where there is ice. The SUBROUTINE first receives
250    ! fields from coupler, then some calculations at surface is done and finally sends
251    ! some fields to the coupler.
252
253    USE dimphy, ONLY: klon
254    USE cpl_mod
255    USE calcul_fluxs_mod
256    USE indice_sol_mod
257    USE phys_output_var_mod, ONLY: sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
258    USE lmdz_clesphys
259    USE lmdz_yomcst
260
261    IMPLICIT NONE
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  END SUBROUTINE ocean_cpl_ice
395
396  !****************************************************************************************
397
398END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.