GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/ocean_cpl_mod.F90 Lines: 0 84 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 106 0.0 %

Line Branch Exec Source
1
!
2
! $Id: ocean_cpl_mod.F90 4370 2022-12-06 15:23:49Z lguez $
3
!
4
MODULE 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
!
18
CONTAINS
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 cpl_mod, ONLY : gath2cpl, cpl_receive_ocean_fields, &
70
         cpl_send_ocean_fields
71
    use config_ocean_skin_m, only: activate_ocean_skin
72
73
    INCLUDE "YOMCST.h"
74
    INCLUDE "clesphys.h"
75
!
76
! Input arguments
77
!****************************************************************************************
78
    INTEGER, INTENT(IN)                      :: itime, knon
79
    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
80
    REAL, INTENT(IN)                         :: dtime
81
    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
82
    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
83
    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
84
    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
85
    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
86
    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
87
    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
88
    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
89
    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
90
    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
91
    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
92
    REAL, DIMENSION(klon), INTENT(IN)        :: ps
93
    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
94
    REAL, INTENT(IN) :: tsurf_in(:) ! (klon)
95
96
    real, intent(in):: delta_sal(:) ! (knon)
97
    ! ocean-air interface salinity minus bulk salinity, in ppt
98
99
    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
100
101
    REAL, intent(in):: delta_sst(:) ! (knon)
102
    ! Ocean-air interface temperature minus bulk SST, in K. Defined
103
    ! only if activate_ocean_skin >= 1.
104
105
    REAL, intent(in):: dter(:) ! (knon)
106
    ! Temperature variation in the diffusive microlayer, that is
107
    ! ocean-air interface temperature minus subskin temperature. In
108
    ! K.
109
110
    REAL, intent(in):: dser(:) ! (knon)
111
    ! Salinity variation in the diffusive microlayer, that is
112
    ! ocean-air interface salinity minus subskin salinity. In ppt.
113
114
    real, intent(in):: dt_ds(:) ! (knon)
115
    ! (tks / tkt) * dTer, in K
116
117
! In/Output arguments
118
!****************************************************************************************
119
    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
120
    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
121
    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
122
123
! Output arguments
124
!****************************************************************************************
125
    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
126
    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
127
    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
128
    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
129
    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
130
    REAL, intent(out):: sens_prec_liq(:) ! (knon)
131
132
    REAL, INTENT(OUT):: sss(:) ! (klon)
133
    ! bulk salinity of the surface layer of the ocean, in ppt
134
135
136
! Local variables
137
!****************************************************************************************
138
    INTEGER               :: i, j
139
    INTEGER, DIMENSION(1) :: iloc
140
    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
141
    REAL, DIMENSION(klon) :: fder_new
142
    REAL, DIMENSION(klon) :: tsurf_cpl
143
    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
144
    REAL, DIMENSION(klon) :: u1_lay, v1_lay
145
    LOGICAL               :: check=.FALSE.
146
    REAL sens_prec_sol(knon)
147
    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
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
    CALL calcul_fluxs(knon, is_oce, dtime, &
178
         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
179
         beta, cdragh, cdragq, ps, &
180
         precip_rain, precip_snow, snow, qsurf,  &
181
         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
182
         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
183
         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
184
         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
185
186
    if (activate_ocean_skin == 2) then
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
    end if
191
192
    ! assertion: tsurf_new == tsurf_cpl
193
194
    do j = 1, knon
195
      i = knindex(j)
196
      sens_prec_liq_o(i,1) = sens_prec_liq(j)
197
      sens_prec_sol_o(i,1) = sens_prec_sol(j)
198
      lat_prec_liq_o(i,1) = lat_prec_liq(j)
199
      lat_prec_sol_o(i,1) = lat_prec_sol(j)
200
    enddo
201
202
203
204
! - Flux calculation at first modele level for U and V
205
    CALL calcul_flux_wind(knon, dtime, &
206
         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
207
         AcoefU, AcoefV, BcoefU, BcoefV, &
208
         p1lay, temp_air, &
209
         flux_u1, flux_v1)
210
211
!****************************************************************************************
212
! Calculate fder : flux derivative (sensible and latente)
213
!
214
!****************************************************************************************
215
    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
216
217
    iloc = MAXLOC(fder_new(1:klon))
218
    IF (check .AND. fder_new(iloc(1))> 0.) THEN
219
       WRITE(*,*)'**** Debug fder****'
220
       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
221
       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
222
            dflux_s(iloc(1)), dflux_l(iloc(1))
223
    ENDIF
224
225
!****************************************************************************************
226
! Send and cumulate fields to the coupler
227
!
228
!****************************************************************************************
229
230
    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
231
         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
232
         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
233
         lat_prec_sol, delta_sst, delta_sal, dTer, dSer, dt_ds)
234
235
  END SUBROUTINE ocean_cpl_noice
236
!
237
!****************************************************************************************
238
!
239
  SUBROUTINE ocean_cpl_ice( &
240
       rlon, rlat, swnet, lwnet, alb1, &
241
       fder_old, &
242
       itime, dtime, knon, knindex, &
243
       lafin, &
244
       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
245
       AcoefH, AcoefQ, BcoefH, BcoefQ, &
246
       AcoefU, AcoefV, BcoefU, BcoefV, &
247
       ps, u1, v1, gustiness, pctsrf, &
248
       radsol, snow, qsurf, &
249
       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
250
       tsurf_new, dflux_s, dflux_l, rhoa)
251
!
252
! This subroutine treats the ocean where there is ice. The subroutine first receives
253
! fields from coupler, then some calculations at surface is done and finally sends
254
! some fields to the coupler.
255
!
256
    USE 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
    INCLUDE "YOMCST.h"
263
    INCLUDE "clesphys.h"
264
265
! Input arguments
266
!****************************************************************************************
267
    INTEGER, INTENT(IN)                      :: itime, knon
268
    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
269
    LOGICAL, INTENT(IN)                      :: lafin
270
    REAL, INTENT(IN)                         :: dtime
271
    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
272
    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
273
    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
274
    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
275
    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
276
    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
277
    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
278
    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
279
    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
280
    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
281
    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
282
    REAL, DIMENSION(klon), INTENT(IN)        :: ps
283
    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
284
    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
285
    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
286
287
! In/output arguments
288
!****************************************************************************************
289
    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
290
    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
291
292
! Output arguments
293
!****************************************************************************************
294
    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
295
    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
296
    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
297
    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
298
    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
299
    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
300
301
302
! Local variables
303
!****************************************************************************************
304
    INTEGER                 :: i, j
305
    INTEGER, DIMENSION(1)   :: iloc
306
    LOGICAL                 :: check=.FALSE.
307
    REAL, PARAMETER         :: t_grnd=271.35
308
    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
309
    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
310
    REAL, DIMENSION(klon)   :: alb_cpl
311
    REAL, DIMENSION(klon)   :: u0, v0
312
    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
313
    REAL sens_prec_liq(knon), sens_prec_sol(knon)
314
    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
315
316
! End definitions
317
!****************************************************************************************
318
319
    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
320
321
    lat_prec_liq = 0.; lat_prec_sol = 0.
322
323
!****************************************************************************************
324
! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
325
!
326
!****************************************************************************************
327
328
    CALL cpl_receive_seaice_fields(knon, knindex, &
329
         tsurf_cpl, alb_cpl, u0, v0)
330
331
    alb1_new(1:knon) = alb_cpl(1:knon)
332
    alb2_new(1:knon) = alb_cpl(1:knon)
333
334
335
!****************************************************************************************
336
! Calculate fluxes at surface
337
!
338
!****************************************************************************************
339
    cal = 0.
340
    dif_grnd = 0.
341
    beta = 1.0
342
343
    DO i = 1, knon
344
       u1_lay(i) = u1(i) - u0(i)
345
       v1_lay(i) = v1(i) - v0(i)
346
    END DO
347
348
    CALL calcul_fluxs(knon, is_sic, dtime, &
349
         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
350
         precip_rain, precip_snow, snow, qsurf,  &
351
         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
352
         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
353
         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
354
         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
355
    do j = 1, knon
356
      i = knindex(j)
357
      sens_prec_liq_o(i,2) = sens_prec_liq(j)
358
      sens_prec_sol_o(i,2) = sens_prec_sol(j)
359
      lat_prec_liq_o(i,2) = lat_prec_liq(j)
360
      lat_prec_sol_o(i,2) = lat_prec_sol(j)
361
    enddo
362
363
364
! - Flux calculation at first modele level for U and V
365
    CALL calcul_flux_wind(knon, dtime, &
366
         u0, v0, u1, v1, gustiness, cdragm, &
367
         AcoefU, AcoefV, BcoefU, BcoefV, &
368
         p1lay, temp_air, &
369
         flux_u1, flux_v1)
370
371
!****************************************************************************************
372
! Calculate fder : flux derivative (sensible and latente)
373
!
374
!****************************************************************************************
375
    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
376
377
    iloc = MAXLOC(fder_new(1:klon))
378
    IF (check .AND. fder_new(iloc(1))> 0.) THEN
379
       WRITE(*,*)'**** Debug fder ****'
380
       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
381
       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
382
            dflux_s(iloc(1)), dflux_l(iloc(1))
383
    ENDIF
384
385
!****************************************************************************************
386
! Send and cumulate fields to the coupler
387
!
388
!****************************************************************************************
389
390
    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
391
       pctsrf, lafin, rlon, rlat, &
392
       swnet, lwnet, fluxlat, fluxsens, &
393
       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
394
       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
395
396
397
398
  END SUBROUTINE ocean_cpl_ice
399
!
400
!****************************************************************************************
401
!
402
END MODULE ocean_cpl_mod