GCC Code Coverage Report


Directory: ./
File: phys/ocean_cpl_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 84 0.0%
Branches: 0 100 0.0%

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