GCC Code Coverage Report


Directory: ./
File: phys/pbl_surface_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 842 1465 57.5%
Branches: 1227 1781 68.9%

Line Branch Exec Source
1 !
2 ! $Id: pbl_surface_mod.F90 3956 2021-07-06 07:16:14Z jyg $
3 !
4 MODULE pbl_surface_mod
5 !
6 ! Planetary Boundary Layer and Surface module
7 !
8 ! This module manages the calculation of turbulent diffusion in the boundary layer
9 ! and all interactions towards the differents sub-surfaces.
10 !
11 !
12 USE dimphy
13 USE mod_phys_lmdz_para, ONLY : mpi_size
14 USE mod_grid_phy_lmdz, ONLY : klon_glo
15 USE ioipsl
16 USE surface_data, ONLY : type_ocean, ok_veget
17 USE surf_land_mod, ONLY : surf_land
18 USE surf_landice_mod, ONLY : surf_landice
19 USE surf_ocean_mod, ONLY : surf_ocean
20 USE surf_seaice_mod, ONLY : surf_seaice
21 USE cpl_mod, ONLY : gath2cpl
22 USE climb_hq_mod, ONLY : climb_hq_down, climb_hq_up
23 USE climb_wind_mod, ONLY : climb_wind_down, climb_wind_up
24 USE coef_diff_turb_mod, ONLY : coef_diff_turb
25 USE ioipsl_getin_p_mod, ONLY : getin_p
26 USE cdrag_mod
27 USE stdlevvar_mod
28 USE wx_pbl_var_mod, ONLY : wx_pbl_init, wx_pbl_final, &
29 wx_pbl_prelim_0, wx_pbl_prelim_beta
30 USE wx_pbl_mod, ONLY : wx_pbl0_merge, wx_pbl_split, wx_pbl_dts_merge, &
31 wx_pbl_check, wx_pbl_dts_check, wx_evappot
32 use config_ocean_skin_m, only: activate_ocean_skin
33
34 IMPLICIT NONE
35
36 ! Declaration of variables saved in restart file
37 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: fder ! flux drift
38 !$OMP THREADPRIVATE(fder)
39 REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE :: snow ! snow at surface
40 !$OMP THREADPRIVATE(snow)
41 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: qsurf ! humidity at surface
42 !$OMP THREADPRIVATE(qsurf)
43 REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ftsoil ! soil temperature
44 !$OMP THREADPRIVATE(ftsoil)
45 REAL, ALLOCATABLE, DIMENSION(:), SAVE :: ydTs0, ydqs0
46 ! nul forced temperature and humidity differences
47 !$OMP THREADPRIVATE(ydTs0, ydqs0)
48
49 INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
50 !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
51 INTEGER, SAVE :: iflag_new_t2mq2m
52 !$OMP THREADPRIVATE(iflag_new_t2mq2m)
53
54 !FC
55 ! integer, save :: iflag_frein
56 ! !$OMP THREADPRIVATE(iflag_frein)
57
58 CONTAINS
59 !
60 !****************************************************************************************
61 !
62 16 SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
63
64 ! This routine should be called after the restart file has been read.
65 ! This routine initialize the restart variables and does some validation tests
66 ! for the index of the different surfaces and tests the choice of type of ocean.
67
68 USE indice_sol_mod
69 USE print_control_mod, ONLY: lunout
70 USE ioipsl_getin_p_mod, ONLY : getin_p
71 IMPLICIT NONE
72
73 INCLUDE "dimsoil.h"
74
75 ! Input variables
76 !****************************************************************************************
77 REAL, DIMENSION(klon), INTENT(IN) :: fder_rst
78 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: snow_rst
79 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: qsurf_rst
80 REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(IN) :: ftsoil_rst
81
82 ! Local variables
83 !****************************************************************************************
84 INTEGER :: ierr
85 CHARACTER(len=80) :: abort_message
86 CHARACTER(len = 20) :: modname = 'pbl_surface_init'
87
88 !****************************************************************************************
89 ! Allocate and initialize module variables with fields read from restart file.
90 !
91 !****************************************************************************************
92
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(fder(klon), stat=ierr)
93
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
94
95
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(snow(klon,nbsrf), stat=ierr)
96
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
97
98
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(qsurf(klon,nbsrf), stat=ierr)
99
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
100
101
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(ftsoil(klon,nsoilmx,nbsrf), stat=ierr)
102
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
103
104
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(ydTs0(klon), stat=ierr)
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
106
107
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(ydqs0(klon), stat=ierr)
108
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
109
110
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 fder(:) = fder_rst(:)
111
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 snow(:,:) = snow_rst(:,:)
112
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 qsurf(:,:) = qsurf_rst(:,:)
113
6/6
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 44 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 43736 times.
✓ Branch 5 taken 44 times.
43785 ftsoil(:,:,:) = ftsoil_rst(:,:,:)
114
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 ydTs0(:) = 0.
115
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 ydqs0(:) = 0.
116
117 !****************************************************************************************
118 ! Test for sub-surface indices
119 !
120 !****************************************************************************************
121 IF (is_ter /= 1) THEN
122 WRITE(lunout,*)" *** Warning ***"
123 WRITE(lunout,*)" is_ter n'est pas le premier surface, is_ter = ",is_ter
124 WRITE(lunout,*)"or on doit commencer par les surfaces continentales"
125 abort_message="voir ci-dessus"
126 CALL abort_physic(modname,abort_message,1)
127 ENDIF
128
129 IF ( is_oce > is_sic ) THEN
130 WRITE(lunout,*)' *** Warning ***'
131 WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
132 WRITE(lunout,*)' l''ocean doit etre traite avant la banquise'
133 WRITE(lunout,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic
134 abort_message='voir ci-dessus'
135 CALL abort_physic(modname,abort_message,1)
136 ENDIF
137
138 IF ( is_lic > is_sic ) THEN
139 WRITE(lunout,*)' *** Warning ***'
140 WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
141 WRITE(lunout,*)' la glace contineltalle doit etre traite avant la glace de mer'
142 WRITE(lunout,*)' or is_lic = ',is_lic, '> is_sic = ',is_sic
143 abort_message='voir ci-dessus'
144 CALL abort_physic(modname,abort_message,1)
145 ENDIF
146
147 !****************************************************************************************
148 ! Validation of ocean mode
149 !
150 !****************************************************************************************
151
152
2/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
1 IF (type_ocean /= 'slab ' .AND. type_ocean /= 'force ' .AND. type_ocean /= 'couple') THEN
153 WRITE(lunout,*)' *** Warning ***'
154 WRITE(lunout,*)'Option couplage pour l''ocean = ', type_ocean
155 abort_message='option pour l''ocean non valable'
156 CALL abort_physic(modname,abort_message,1)
157 ENDIF
158
159 1 iflag_pbl_surface_t2m_bug=0
160 1 CALL getin_p('iflag_pbl_surface_t2m_bug',iflag_pbl_surface_t2m_bug)
161 1 WRITE(lunout,*) 'iflag_pbl_surface_t2m_bug=',iflag_pbl_surface_t2m_bug
162 !FC
163 ! iflag_frein = 0
164 ! CALL getin_p('iflag_frein',iflag_frein)
165 !
166 !jyg<
167 !****************************************************************************************
168 ! Allocate variables for pbl splitting
169 !
170 !****************************************************************************************
171
172 1 CALL wx_pbl_init
173 !>jyg
174
175 1 END SUBROUTINE pbl_surface_init
176 !
177 !****************************************************************************************
178 !
179
180 480 SUBROUTINE pbl_surface( &
181 dtime, date0, itap, jour, &
182 debut, lafin, &
183 480 rlon, rlat, rugoro, rmu0, &
184 lwdown_m, cldt, &
185 rain_f, snow_f, solsw_m, solswfdiff_m, sollw_m, &
186 gustiness, &
187 t, q, u, v, &
188 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
189 !! t_x, q_x, t_w, q_w, &
190 wake_dlt, wake_dlq, &
191 wake_cstar, wake_s, &
192 !!!
193 480 pplay, paprs, pctsrf, &
194 480 ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
195 cdragh, cdragm, zu1, zv1, &
196 !jyg< (26/09/2019)
197 beta, &
198 !>jyg
199 480 alb_dir_m, alb_dif_m, zxsens, zxevap, &
200 alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
201 zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
202 d_t, d_q, d_u, d_v, d_t_diss, &
203 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
204 480 d_t_w, d_q_w, &
205 d_t_x, d_q_x, &
206 !! d_wake_dlt,d_wake_dlq, &
207 zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
208 !!!
209 !!! nrlmd le 13/06/2011
210 delta_tsurf,wake_dens,cdragh_x,cdragh_w, &
211 cdragm_x,cdragm_w,kh,kh_x,kh_w, &
212 !!!
213
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 zcoefh, zcoefm, slab_wfbils, &
214 qsol, zq2m, s_pblh, s_plcl, &
215 !!!
216 !!! jyg le 08/02/2012
217 s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
218 !!!
219 s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
220 s_therm, s_trmb1, s_trmb2, s_trmb3, &
221 zustar,zu10m, zv10m, fder_print, &
222 zxqsurf, delta_qsurf, &
223 rh2m, zxfluxu, zxfluxv, &
224 480 z0m, z0h, agesno, sollw, solsw, &
225 d_ts, evap, fluxlat, t2m, &
226 wfbils, wfbilo, wfevap, wfrain, wfsnow, &
227 480 flux_t, flux_u, flux_v, &
228 dflux_t, dflux_q, zxsnow, &
229 !jyg<
230 !! zxfluxt, zxfluxq, q2m, flux_q, tke, &
231 480 zxfluxt, zxfluxq, q2m, flux_q, tke_x, &
232 !>jyg
233 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
234 !! tke_x, tke_w &
235 wake_dltke, &
236 treedrg &
237 !FC
238 !!!
239 )
240 !****************************************************************************************
241 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
242 ! Objet: interface de "couche limite" (diffusion verticale)
243 !
244 !AA REM:
245 !AA-----
246 !AA Tout ce qui a trait au traceurs est dans phytrac maintenant
247 !AA pour l'instant le calcul de la couche limite pour les traceurs
248 !AA se fait avec cltrac et ne tient pas compte de la differentiation
249 !AA des sous-fraction de sol.
250 !AA REM bis :
251 !AA----------
252 !AA Pour pouvoir extraire les coefficient d'echanges et le vent
253 !AA dans la premiere couche, 3 champs supplementaires ont ete crees
254 !AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
255 !AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
256 !AA si les informations des subsurfaces doivent etre prises en compte
257 !AA il faudra sortir ces memes champs en leur ajoutant une dimension,
258 !AA c'est a dire nbsrf (nbre de subsurface).
259 !
260 ! Arguments:
261 !
262 ! dtime----input-R- interval du temps (secondes)
263 ! itap-----input-I- numero du pas de temps
264 ! date0----input-R- jour initial
265 ! t--------input-R- temperature (K)
266 ! q--------input-R- vapeur d'eau (kg/kg)
267 ! u--------input-R- vitesse u
268 ! v--------input-R- vitesse v
269 ! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
270 ! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
271 !wake_cstar-input-R- wake gust front speed (m/s)
272 ! wake_s---input-R- wake fractionnal area
273 ! ts-------input-R- temperature du sol (en Kelvin)
274 ! paprs----input-R- pression a intercouche (Pa)
275 ! pplay----input-R- pression au milieu de couche (Pa)
276 ! rlat-----input-R- latitude en degree
277 ! z0m, z0h ----input-R- longeur de rugosite (en m)
278 ! Martin
279 ! cldt-----input-R- total cloud fraction
280 ! Martin
281 !
282 ! d_t------output-R- le changement pour "t"
283 ! d_q------output-R- le changement pour "q"
284 ! d_u------output-R- le changement pour "u"
285 ! d_v------output-R- le changement pour "v"
286 ! d_ts-----output-R- le changement pour "ts"
287 ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
288 ! (orientation positive vers le bas)
289 ! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
290 ! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
291 ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
292 ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
293 ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
294 ! dflux_t--output-R- derive du flux sensible
295 ! dflux_q--output-R- derive du flux latent
296 ! zu1------output-R- le vent dans la premiere couche
297 ! zv1------output-R- le vent dans la premiere couche
298 ! trmb1----output-R- deep_cape
299 ! trmb2----output-R- inhibition
300 ! trmb3----output-R- Point Omega
301 ! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
302 ! plcl-----output-R- Niveau de condensation
303 ! pblh-----output-R- HCL
304 ! pblT-----output-R- T au nveau HCL
305 ! treedrg--output-R- tree drag (m)
306 !
307 USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm
308 USE carbon_cycle_mod, ONLY : co2_send, nbcf_out, fields_out, yfields_out, cfname_out
309 use hbtm_mod, only: hbtm
310 USE indice_sol_mod
311 USE time_phylmdz_mod, ONLY : day_ini,annee_ref,itau_phy
312 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dto2d_glo
313 USE print_control_mod, ONLY : prt_level,lunout
314 USE ioipsl_getin_p_mod, ONLY : getin_p
315 use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, zsig, zmea
316 use phys_output_var_mod, only: dter, dser, tkt, tks, taur, sss
317 use netcdf, only: missing_val => nf90_fill_real
318
319
320
321
322 IMPLICIT NONE
323
324 INCLUDE "dimsoil.h"
325 INCLUDE "YOMCST.h"
326 INCLUDE "YOETHF.h"
327 INCLUDE "FCTTRE.h"
328 INCLUDE "clesphys.h"
329 INCLUDE "compbl.h"
330 INCLUDE "flux_arp.h"
331 !FC
332 INCLUDE "dimpft.h"
333
334 !****************************************************************************************
335 REAL, INTENT(IN) :: dtime ! time interval (s)
336 REAL, INTENT(IN) :: date0 ! initial day
337 INTEGER, INTENT(IN) :: itap ! time step
338 INTEGER, INTENT(IN) :: jour ! current day of the year
339 LOGICAL, INTENT(IN) :: debut ! true if first run step
340 LOGICAL, INTENT(IN) :: lafin ! true if last run step
341 REAL, DIMENSION(klon), INTENT(IN) :: rlon ! longitudes in degrees
342 REAL, DIMENSION(klon), INTENT(IN) :: rlat ! latitudes in degrees
343 REAL, DIMENSION(klon), INTENT(IN) :: rugoro ! rugosity length
344 REAL, DIMENSION(klon), INTENT(IN) :: rmu0 ! cosine of solar zenith angle
345 REAL, DIMENSION(klon), INTENT(IN) :: rain_f ! rain fall
346 REAL, DIMENSION(klon), INTENT(IN) :: snow_f ! snow fall
347 REAL, DIMENSION(klon), INTENT(IN) :: solsw_m ! net shortwave radiation at mean surface
348 REAL, DIMENSION(klon), INTENT(IN) :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
349 REAL, DIMENSION(klon), INTENT(IN) :: sollw_m ! net longwave radiation at mean surface
350 REAL, DIMENSION(klon,klev), INTENT(IN) :: t ! temperature (K)
351 REAL, DIMENSION(klon,klev), INTENT(IN) :: q ! water vapour (kg/kg)
352 REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed
353 REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed
354 REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay ! mid-layer pression (Pa)
355 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression between layers (Pa)
356 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
357 ! Martin
358 REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downward longwave radiation at mean s
359 REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness
360
361 REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud fraction
362
363 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
364 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: t_x ! Temp\'erature hors poche froide
365 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: t_w ! Temp\'erature dans la poches froide
366 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: q_x !
367 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: q_w ! Pareil pour l'humidit\'e
368 REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlt !temperature difference between (w) and (x) (K)
369 REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlq !humidity difference between (w) and (x) (K)
370 REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides
371 REAL, DIMENSION(klon), INTENT(IN) :: wake_cstar! Vitesse d'expansion des poches froides
372 REAL, DIMENSION(klon), INTENT(IN) :: wake_dens
373 !!!
374
375 ! Input/Output variables
376 !****************************************************************************************
377 !jyg<
378 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: beta ! Aridity factor
379 !>jyg
380 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
381 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: delta_tsurf !surface temperature difference between
382 !wake and off-wake regions
383 !albedo SB >>>
384 REAL, DIMENSIOn(6),intent(in) :: SFRWL
385 REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
386 !albedo SB <<<
387 !jyg Pourquoi ustar et wstar sont-elles INOUT ?
388 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
389 REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
390 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
391 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
392 !jyg<
393 !! REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke
394 REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
395 !>jyg
396
397 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
398 REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
399 !!!
400
401 ! Output variables
402 !****************************************************************************************
403 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh ! drag coefficient for T and Q
404 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm ! drag coefficient for wind
405 REAL, DIMENSION(klon), INTENT(OUT) :: zu1 ! u wind speed in first layer
406 REAL, DIMENSION(klon), INTENT(OUT) :: zv1 ! v wind speed in first layer
407 !albedo SB >>>
408 REAL, DIMENSION(klon, nsw), INTENT(OUT) :: alb_dir_m,alb_dif_m
409 !albedo SB <<<
410 ! Martin
411 REAL, DIMENSION(klon), INTENT(OUT) :: alb3_lic
412 ! Martin
413 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens ! sensible heat flux at surface with inversed sign
414 ! (=> positive sign upwards)
415 REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards
416 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point
417 !!! jyg le ???
418 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_w ! !
419 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_w ! ! Tendances dans les poches
420 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_x ! !
421 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_x ! ! Tendances hors des poches
422 !!! jyg
423 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point
424 REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point
425 INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: zn2mout ! number of times the 2m temperature is out of the [tsol,temp]
426 REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m
427 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t ! change in temperature
428 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_diss ! change in temperature
429 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_q ! change in water vapour
430 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u ! change in u speed
431 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v ! change in v speed
432
433 REAL, INTENT(OUT):: zcoefh(:, :, :) ! (klon, klev, nbsrf + 1)
434 ! coef for turbulent diffusion of T and Q, mean for each grid point
435
436 REAL, INTENT(OUT):: zcoefm(:, :, :) ! (klon, klev, nbsrf + 1)
437 ! coef for turbulent diffusion of U and V (?), mean for each grid point
438
439 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
440 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche
441 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche
442 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche
443 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche
444 !! REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_wake_dlt
445 !! REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_wake_dlq
446
447 ! Output only for diagnostics
448 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_x
449 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_w
450 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_x
451 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_w
452 REAL, DIMENSION(klon), INTENT(OUT) :: kh
453 REAL, DIMENSION(klon), INTENT(OUT) :: kh_x
454 REAL, DIMENSION(klon), INTENT(OUT) :: kh_w
455 !!!
456 REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points
457 REAL, DIMENSION(klon), INTENT(OUT) :: qsol ! water height in the soil (mm)
458 REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point
459 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
460 !!! jyg le 08/02/2012
461 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
462 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
463 !!!
464 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level
465 !!! jyg le 08/02/2012
466 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region
467 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region
468 !!!
469 REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL
470 REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL
471 REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL ! cloud top instab. crit. of PBL
472 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT ! temperature at PBLH
473 REAL, DIMENSION(klon), INTENT(OUT) :: s_therm ! thermal virtual temperature excess
474 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 ! deep cape, mean for each grid point
475 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 ! inhibition, mean for each grid point
476 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 ! point Omega, mean for each grid point
477 REAL, DIMENSION(klon), INTENT(OUT) :: zustar ! u*
478 REAL, DIMENSION(klon), INTENT(OUT) :: zu10m ! u speed at 10m, mean for each grid point
479 REAL, DIMENSION(klon), INTENT(OUT) :: zv10m ! v speed at 10m, mean for each grid point
480 REAL, DIMENSION(klon), INTENT(OUT) :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
481 REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf ! humidity at surface, mean for each grid point
482 REAL, DIMENSION(klon), INTENT(OUT) :: delta_qsurf! humidity difference at surface, mean for each grid point
483 REAL, DIMENSION(klon), INTENT(OUT) :: rh2m ! relative humidity at 2m
484 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu ! u wind tension, mean for each grid point
485 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxv ! v wind tension, mean for each grid point
486 REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
487 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: agesno ! age of snow at surface
488 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: solsw ! net shortwave radiation at surface
489 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: sollw ! net longwave radiation at surface
490 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface
491 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
492 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux
493 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height
494 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils ! heat balance at surface
495 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbilo ! water balance at surface weighted by srf
496 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfevap ! water balance (evap) at surface weighted by srf
497 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfrain ! water balance (rain) at surface weighted by srf
498 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfsnow ! water balance (snow) at surface weighted by srf
499 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t ! sensible heat flux (CpT) J/m**2/s (W/m**2)
500 ! positve orientation downwards
501 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
502 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
503 !FC
504 REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m)
505
506
507 ! Output not needed
508 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t ! change of sensible heat flux
509 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_q ! change of water vapour flux
510 REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow ! snow at surface, mean for each grid point
511 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point
512 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point
513 REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height
514 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
515
516 ! Martin
517 ! inlandsis
518 REAL, DIMENSION(klon), INTENT(OUT) :: qsnow ! snow water content
519 REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt ! snow height
520 REAL, DIMENSION(klon), INTENT(OUT) :: to_ice ! snow passed to ice
521 REAL, DIMENSION(klon), INTENT(OUT) :: sissnow ! snow in snow model
522 REAL, DIMENSION(klon), INTENT(OUT) :: runoff ! runoff on land ice
523 ! Martin
524
525 ! Local variables with attribute SAVE
526 !****************************************************************************************
527 INTEGER, SAVE :: nhoridbg, nidbg ! variables for IOIPSL
528 !$OMP THREADPRIVATE(nhoridbg, nidbg)
529 LOGICAL, SAVE :: debugindex=.FALSE.
530 !$OMP THREADPRIVATE(debugindex)
531 LOGICAL, SAVE :: first_call=.TRUE.
532 !$OMP THREADPRIVATE(first_call)
533 CHARACTER(len=8), DIMENSION(nbsrf), SAVE :: cl_surf
534 !$OMP THREADPRIVATE(cl_surf)
535 REAL, SAVE :: beta_land ! beta for wx_dts
536 !$OMP THREADPRIVATE(beta_land)
537
538 ! Other local variables
539 !****************************************************************************************
540 ! >> PC
541 INTEGER :: ierr
542 INTEGER :: n
543 ! << PC
544 INTEGER :: iflag_split, iflag_split_ref
545 INTEGER :: i, k, nsrf
546 INTEGER :: knon, j
547 INTEGER :: idayref
548 960 INTEGER , DIMENSION(klon) :: ni
549 REAL :: yt1_new
550 REAL :: zx_alf1, zx_alf2 !valeur ambiante par extrapola
551 REAL :: amn, amx
552 REAL :: f1 ! fraction de longeurs visibles parmi tout SW intervalle
553 960 REAL, DIMENSION(klon) :: r_co2_ppm ! taux CO2 atmosphere
554 960 REAL, DIMENSION(klon) :: yts, yz0m, yz0h, ypct
555 960 REAL, DIMENSION(klon) :: yz0h_old
556 !albedo SB >>>
557 960 REAL, DIMENSION(klon) :: yalb,yalb_vis
558 !albedo SB <<<
559 960 REAL, DIMENSION(klon) :: yt1, yq1, yu1, yv1
560 960 REAL, DIMENSION(klon) :: yqa
561 960 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol
562 960 REAL, DIMENSION(klon) :: yrain_f, ysnow_f
563 960 REAL, DIMENSION(klon) :: ysolsw, ysollw
564 960 REAL, DIMENSION(klon) :: yfder
565 960 REAL, DIMENSION(klon) :: yrugoro
566 960 REAL, DIMENSION(klon) :: yfluxlat
567 960 REAL, DIMENSION(klon) :: y_d_ts
568 960 REAL, DIMENSION(klon) :: y_flux_t1, y_flux_q1
569 960 REAL, DIMENSION(klon) :: y_dflux_t, y_dflux_q
570 960 REAL, DIMENSION(klon) :: y_flux_u1, y_flux_v1
571 960 REAL, DIMENSION(klon) :: yt2m, yq2m, yu10m
572 960 INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
573 960 INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout, n2mout_x, n2mout_w
574 960 REAL, DIMENSION(klon) :: yustar
575 960 REAL, DIMENSION(klon) :: ywstar
576 960 REAL, DIMENSION(klon) :: ywindsp
577 960 REAL, DIMENSION(klon) :: yt10m, yq10m
578 960 REAL, DIMENSION(klon) :: ypblh
579 960 REAL, DIMENSION(klon) :: ylcl
580 960 REAL, DIMENSION(klon) :: ycapCL
581 960 REAL, DIMENSION(klon) :: yoliqCL
582 960 REAL, DIMENSION(klon) :: ycteiCL
583 960 REAL, DIMENSION(klon) :: ypblT
584 960 REAL, DIMENSION(klon) :: ytherm
585 960 REAL, DIMENSION(klon) :: ytrmb1
586 960 REAL, DIMENSION(klon) :: ytrmb2
587 960 REAL, DIMENSION(klon) :: ytrmb3
588 960 REAL, DIMENSION(klon) :: uzon, vmer
589 960 REAL, DIMENSION(klon) :: tair1, qair1, tairsol
590 960 REAL, DIMENSION(klon) :: psfce, patm
591 960 REAL, DIMENSION(klon) :: qairsol, zgeo1, speed, zri1, pref !speed, zri1, pref, added by Fuxing WANG, 04/03/2015
592 960 REAL, DIMENSION(klon) :: yz0h_oupas
593 960 REAL, DIMENSION(klon) :: yfluxsens
594 960 REAL, DIMENSION(klon) :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
595 960 REAL, DIMENSION(klon) :: AcoefH, AcoefQ, BcoefH, BcoefQ
596 960 REAL, DIMENSION(klon) :: AcoefU, AcoefV, BcoefU, BcoefV
597 960 REAL, DIMENSION(klon) :: ypsref
598 960 REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new
599 !albedo SB >>>
600 960 REAL, DIMENSION(klon,nsw) :: yalb_dir_new, yalb_dif_new
601 !albedo SB <<<
602 960 REAL, DIMENSION(klon) :: ztsol
603 960 REAL, DIMENSION(klon) :: meansqT ! mean square deviation of subsurface temperatures
604 960 REAL, DIMENSION(klon) :: alb_m ! mean albedo for whole SW interval
605 960 REAL, DIMENSION(klon,klev) :: y_d_t, y_d_q, y_d_t_diss
606 960 REAL, DIMENSION(klon,klev) :: y_d_u, y_d_v
607 960 REAL, DIMENSION(klon,klev) :: y_flux_t, y_flux_q
608 960 REAL, DIMENSION(klon,klev) :: y_flux_u, y_flux_v
609 960 REAL, DIMENSION(klon,klev) :: ycoefh, ycoefm,ycoefq
610 960 REAL, DIMENSION(klon) :: ycdragh, ycdragq, ycdragm
611 960 REAL, DIMENSION(klon,klev) :: yu, yv
612 960 REAL, DIMENSION(klon,klev) :: yt, yq
613 960 REAL, DIMENSION(klon,klev) :: ypplay, ydelp
614 960 REAL, DIMENSION(klon,klev) :: delp
615 960 REAL, DIMENSION(klon,klev+1) :: ypaprs
616 960 REAL, DIMENSION(klon,klev+1) :: ytke
617 960 REAL, DIMENSION(klon,nsoilmx) :: ytsoil
618 !FC
619 960 REAL, DIMENSION(klon,nvm_lmdz) :: yveget
620 960 REAL, DIMENSION(klon,nvm_lmdz) :: ylai
621 960 REAL, DIMENSION(klon,nvm_lmdz) :: yheight
622 960 REAL, DIMENSION(klon,klev) :: y_d_u_frein
623 960 REAL, DIMENSION(klon,klev) :: y_d_v_frein
624 960 REAL, DIMENSION(klon,klev) :: y_treedrg
625 !FC
626
627 CHARACTER(len=80) :: abort_message
628 CHARACTER(len=20) :: modname = 'pbl_surface'
629 LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
630 LOGICAL, PARAMETER :: check=.FALSE.
631
632 !!! nrlmd le 02/05/2011
633 !!! jyg le 07/02/2012
634 960 REAL, DIMENSION(klon) :: ywake_s, ywake_cstar, ywake_dens
635 !!!
636 960 REAL, DIMENSION(klon,klev+1) :: ytke_x, ytke_w
637 960 REAL, DIMENSION(klon,klev+1) :: ywake_dltke
638 960 REAL, DIMENSION(klon,klev) :: yu_x, yv_x, yu_w, yv_w
639 960 REAL, DIMENSION(klon,klev) :: yt_x, yq_x, yt_w, yq_w
640 960 REAL, DIMENSION(klon,klev) :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w
641 960 REAL, DIMENSION(klon,klev) :: ycoefq_x, ycoefq_w
642 960 REAL, DIMENSION(klon) :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
643 960 REAL, DIMENSION(klon) :: ycdragm_x, ycdragm_w
644 960 REAL, DIMENSION(klon) :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x
645 960 REAL, DIMENSION(klon) :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w
646 960 REAL, DIMENSION(klon) :: AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x
647 960 REAL, DIMENSION(klon) :: AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w
648 960 REAL, DIMENSION(klon) :: y_flux_t1_x, y_flux_q1_x, y_flux_t1_w, y_flux_q1_w
649 960 REAL, DIMENSION(klon) :: y_flux_u1_x, y_flux_v1_x, y_flux_u1_w, y_flux_v1_w
650 960 REAL, DIMENSION(klon,klev) :: y_flux_t_x, y_flux_q_x, y_flux_t_w, y_flux_q_w
651 960 REAL, DIMENSION(klon,klev) :: y_flux_u_x, y_flux_v_x, y_flux_u_w, y_flux_v_w
652 960 REAL, DIMENSION(klon) :: yfluxlat_x, yfluxlat_w
653 960 REAL, DIMENSION(klon,klev) :: y_d_t_x, y_d_q_x, y_d_t_w, y_d_q_w
654 960 REAL, DIMENSION(klon,klev) :: y_d_t_diss_x, y_d_t_diss_w
655 960 REAL, DIMENSION(klon,klev) :: d_t_diss_x, d_t_diss_w
656 960 REAL, DIMENSION(klon,klev) :: y_d_u_x, y_d_v_x, y_d_u_w, y_d_v_w
657 960 REAL, DIMENSION(klon, klev, nbsrf) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
658 960 REAL, DIMENSION(klon, klev, nbsrf) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
659 960 REAL, DIMENSION(klon, nbsrf) :: fluxlat_x, fluxlat_w
660 960 REAL, DIMENSION(klon, klev) :: zxfluxt_x, zxfluxq_x, zxfluxt_w, zxfluxq_w
661 960 REAL, DIMENSION(klon, klev) :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w
662 REAL :: zx_qs_surf, zcor_surf, zdelta_surf
663 !jyg<
664 960 REAL, DIMENSION(klon) :: ybeta
665 960 REAL, DIMENSION(klon) :: ybeta_prev
666 !>jyg
667 960 REAL, DIMENSION(klon, klev) :: d_u_x
668 960 REAL, DIMENSION(klon, klev) :: d_u_w
669 960 REAL, DIMENSION(klon, klev) :: d_v_x
670 960 REAL, DIMENSION(klon, klev) :: d_v_w
671
672 960 REAL, DIMENSION(klon,klev) :: CcoefH, CcoefQ, DcoefH, DcoefQ
673 960 REAL, DIMENSION(klon,klev) :: CcoefU, CcoefV, DcoefU, DcoefV
674 960 REAL, DIMENSION(klon,klev) :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x
675 960 REAL, DIMENSION(klon,klev) :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w
676 960 REAL, DIMENSION(klon,klev) :: CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x
677 960 REAL, DIMENSION(klon,klev) :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w
678 960 REAL, DIMENSION(klon,klev) :: Kcoef_hq, Kcoef_m, gama_h, gama_q
679 960 REAL, DIMENSION(klon,klev) :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x
680 960 REAL, DIMENSION(klon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
681 960 REAL, DIMENSION(klon) :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w
682 !!!
683 !!!jyg le 08/02/2012
684 960 REAL, DIMENSION(klon, nbsrf) :: windsp
685 !
686 960 REAL, DIMENSION(klon, nbsrf) :: t2m_x
687 960 REAL, DIMENSION(klon, nbsrf) :: q2m_x
688 960 REAL, DIMENSION(klon) :: rh2m_x
689 960 REAL, DIMENSION(klon) :: qsat2m_x
690 960 REAL, DIMENSION(klon, nbsrf) :: u10m_x
691 960 REAL, DIMENSION(klon, nbsrf) :: v10m_x
692 960 REAL, DIMENSION(klon, nbsrf) :: ustar_x
693 960 REAL, DIMENSION(klon, nbsrf) :: wstar_x
694 !
695 960 REAL, DIMENSION(klon, nbsrf) :: pblh_x
696 960 REAL, DIMENSION(klon, nbsrf) :: plcl_x
697 960 REAL, DIMENSION(klon, nbsrf) :: capCL_x
698 960 REAL, DIMENSION(klon, nbsrf) :: oliqCL_x
699 960 REAL, DIMENSION(klon, nbsrf) :: cteiCL_x
700 960 REAL, DIMENSION(klon, nbsrf) :: pblt_x
701 960 REAL, DIMENSION(klon, nbsrf) :: therm_x
702 960 REAL, DIMENSION(klon, nbsrf) :: trmb1_x
703 960 REAL, DIMENSION(klon, nbsrf) :: trmb2_x
704 960 REAL, DIMENSION(klon, nbsrf) :: trmb3_x
705 !
706 960 REAL, DIMENSION(klon, nbsrf) :: t2m_w
707 960 REAL, DIMENSION(klon, nbsrf) :: q2m_w
708 960 REAL, DIMENSION(klon) :: rh2m_w
709 960 REAL, DIMENSION(klon) :: qsat2m_w
710 960 REAL, DIMENSION(klon, nbsrf) :: u10m_w
711 960 REAL, DIMENSION(klon, nbsrf) :: v10m_w
712 960 REAL, DIMENSION(klon, nbsrf) :: ustar_w
713 960 REAL, DIMENSION(klon, nbsrf) :: wstar_w
714 !
715 960 REAL, DIMENSION(klon, nbsrf) :: pblh_w
716 960 REAL, DIMENSION(klon, nbsrf) :: plcl_w
717 960 REAL, DIMENSION(klon, nbsrf) :: capCL_w
718 960 REAL, DIMENSION(klon, nbsrf) :: oliqCL_w
719 960 REAL, DIMENSION(klon, nbsrf) :: cteiCL_w
720 960 REAL, DIMENSION(klon, nbsrf) :: pblt_w
721 960 REAL, DIMENSION(klon, nbsrf) :: therm_w
722 960 REAL, DIMENSION(klon, nbsrf) :: trmb1_w
723 960 REAL, DIMENSION(klon, nbsrf) :: trmb2_w
724 960 REAL, DIMENSION(klon, nbsrf) :: trmb3_w
725 !
726 960 REAL, DIMENSION(klon) :: yt2m_x
727 960 REAL, DIMENSION(klon) :: yq2m_x
728 960 REAL, DIMENSION(klon) :: yt10m_x
729 960 REAL, DIMENSION(klon) :: yq10m_x
730 960 REAL, DIMENSION(klon) :: yu10m_x
731 REAL, DIMENSION(klon) :: yv10m_x
732 960 REAL, DIMENSION(klon) :: yustar_x
733 960 REAL, DIMENSION(klon) :: ywstar_x
734 !
735 960 REAL, DIMENSION(klon) :: ypblh_x
736 960 REAL, DIMENSION(klon) :: ylcl_x
737 960 REAL, DIMENSION(klon) :: ycapCL_x
738 960 REAL, DIMENSION(klon) :: yoliqCL_x
739 960 REAL, DIMENSION(klon) :: ycteiCL_x
740 960 REAL, DIMENSION(klon) :: ypblt_x
741 960 REAL, DIMENSION(klon) :: ytherm_x
742 960 REAL, DIMENSION(klon) :: ytrmb1_x
743 960 REAL, DIMENSION(klon) :: ytrmb2_x
744 960 REAL, DIMENSION(klon) :: ytrmb3_x
745 !
746 960 REAL, DIMENSION(klon) :: yt2m_w
747 960 REAL, DIMENSION(klon) :: yq2m_w
748 960 REAL, DIMENSION(klon) :: yt10m_w
749 960 REAL, DIMENSION(klon) :: yq10m_w
750 960 REAL, DIMENSION(klon) :: yu10m_w
751 REAL, DIMENSION(klon) :: yv10m_w
752 960 REAL, DIMENSION(klon) :: yustar_w
753 960 REAL, DIMENSION(klon) :: ywstar_w
754 !
755 960 REAL, DIMENSION(klon) :: ypblh_w
756 960 REAL, DIMENSION(klon) :: ylcl_w
757 960 REAL, DIMENSION(klon) :: ycapCL_w
758 960 REAL, DIMENSION(klon) :: yoliqCL_w
759 960 REAL, DIMENSION(klon) :: ycteiCL_w
760 960 REAL, DIMENSION(klon) :: ypblt_w
761 960 REAL, DIMENSION(klon) :: ytherm_w
762 960 REAL, DIMENSION(klon) :: ytrmb1_w
763 960 REAL, DIMENSION(klon) :: ytrmb2_w
764 960 REAL, DIMENSION(klon) :: ytrmb3_w
765 !
766 960 REAL, DIMENSION(klon) :: uzon_x, vmer_x, speed_x, zri1_x, pref_x !speed_x, zri1_x, pref_x, added by Fuxing WANG, 04/03/2015
767 960 REAL, DIMENSION(klon) :: zgeo1_x, tair1_x, qair1_x, tairsol_x
768 !
769 960 REAL, DIMENSION(klon) :: uzon_w, vmer_w, speed_w, zri1_w, pref_w !speed_w, zri1_w, pref_w, added by Fuxing WANG, 04/03/2015
770 960 REAL, DIMENSION(klon) :: zgeo1_w, tair1_w, qair1_w, tairsol_w
771
772 !!! jyg le 25/03/2013
773 !! Variables intermediaires pour le raccord des deux colonnes \`a la surface
774 !jyg<
775 !! REAL :: dd_Ch
776 !! REAL :: dd_Cm
777 !! REAL :: dd_Kh
778 !! REAL :: dd_Km
779 !! REAL :: dd_u
780 !! REAL :: dd_v
781 !! REAL :: dd_t
782 !! REAL :: dd_q
783 !! REAL :: dd_AH
784 !! REAL :: dd_AQ
785 !! REAL :: dd_AU
786 !! REAL :: dd_AV
787 !! REAL :: dd_BH
788 !! REAL :: dd_BQ
789 !! REAL :: dd_BU
790 !! REAL :: dd_BV
791 !!
792 !! REAL :: dd_KHp
793 !! REAL :: dd_KQp
794 !! REAL :: dd_KUp
795 !! REAL :: dd_KVp
796 !>jyg
797
798 !!!
799 !!! nrlmd le 13/06/2011
800 960 REAL, DIMENSION(klon) :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1
801 960 REAL, DIMENSION(klon) :: y_delta_tsurf, y_delta_tsurf_new
802 960 REAL, DIMENSION(klon) :: delta_coef, tau_eq
803 960 REAL, DIMENSION(klon) :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
804 960 REAL, DIMENSION(klon) :: phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0
805 960 REAL, DIMENSION(klon) :: y_delta_qsurf
806 960 REAL, DIMENSION(klon) :: y_delta_qsats
807 960 REAL, DIMENSION(klon) :: yg_T, yg_Q
808 960 REAL, DIMENSION(klon) :: yGamma_dTs_phiT, yGamma_dQs_phiQ
809 960 REAL, DIMENSION(klon) :: ydTs_ins, ydqs_ins
810 !
811 REAL, PARAMETER :: facteur=2./sqrt(3.14)
812 REAL, PARAMETER :: inertia=2000.
813 960 REAL, DIMENSION(klon) :: ydtsurf_th
814 REAL :: zdelta_surf_x,zdelta_surf_w,zx_qs_surf_x,zx_qs_surf_w
815 REAL :: zcor_surf_x,zcor_surf_w
816 REAL :: mod_wind_x, mod_wind_w
817 REAL :: rho1
818 960 REAL, DIMENSION(klon) :: Kech_h ! Coefficient d'echange pour l'energie
819 960 REAL, DIMENSION(klon) :: Kech_h_x, Kech_h_w
820 REAL, DIMENSION(klon) :: Kech_m
821 REAL, DIMENSION(klon) :: Kech_m_x, Kech_m_w
822 960 REAL, DIMENSION(klon) :: yts_x, yts_w
823 REAL, DIMENSION(klon) :: yqsatsrf0_x, yqsatsrf0_w
824 960 REAL, DIMENSION(klon) :: yqsurf_x, yqsurf_w
825 !jyg<
826 !! REAL, DIMENSION(klon) :: Kech_Hp, Kech_H_xp, Kech_H_wp
827 !! REAL, DIMENSION(klon) :: Kech_Qp, Kech_Q_xp, Kech_Q_wp
828 !! REAL, DIMENSION(klon) :: Kech_Up, Kech_U_xp, Kech_U_wp
829 !! REAL, DIMENSION(klon) :: Kech_Vp, Kech_V_xp, Kech_V_wp
830 !>jyg
831
832 REAL :: fact_cdrag
833 REAL :: z1lay
834
835 REAL :: vent
836 !
837 ! For debugging with IOIPSL
838 960 INTEGER, DIMENSION(nbp_lon*nbp_lat) :: ndexbg
839 REAL :: zjulian
840 960 REAL, DIMENSION(klon) :: tabindx
841 960 REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat
842 960 REAL, DIMENSION(nbp_lon,nbp_lat) :: debugtab
843
844
845 960 REAL, DIMENSION(klon,nbsrf) :: pblh ! height of the planetary boundary layer
846 960 REAL, DIMENSION(klon,nbsrf) :: plcl ! condensation level
847 960 REAL, DIMENSION(klon,nbsrf) :: capCL
848 960 REAL, DIMENSION(klon,nbsrf) :: oliqCL
849 960 REAL, DIMENSION(klon,nbsrf) :: cteiCL
850 960 REAL, DIMENSION(klon,nbsrf) :: pblT
851 960 REAL, DIMENSION(klon,nbsrf) :: therm
852 960 REAL, DIMENSION(klon,nbsrf) :: trmb1 ! deep cape
853 960 REAL, DIMENSION(klon,nbsrf) :: trmb2 ! inhibition
854 960 REAL, DIMENSION(klon,nbsrf) :: trmb3 ! point Omega
855 REAL, DIMENSION(klon,nbsrf) :: zx_rh2m, zx_qsat2m
856 REAL, DIMENSION(klon,nbsrf) :: zx_t1
857 960 REAL, DIMENSION(klon, nbsrf) :: alb ! mean albedo for whole SW interval
858 960 REAL, DIMENSION(klon) :: ylwdown ! jg : temporary (ysollwdown)
859 960 REAL, DIMENSION(klon) :: ygustiness ! jg : temporary (ysollwdown)
860
861 REAL :: zx_qs1, zcor1, zdelta1
862
863 ! Martin
864 REAL, DIMENSION(klon, nbsrf) :: sollwd ! net longwave radiation at surface
865 960 REAL, DIMENSION(klon) :: ytoice
866 960 REAL, DIMENSION(klon) :: ysnowhgt, yqsnow, ysissnow, yrunoff
867 960 REAL, DIMENSION(klon) :: yzmea
868 960 REAL, DIMENSION(klon) :: yzsig
869 960 REAL, DIMENSION(klon) :: ycldt
870 960 REAL, DIMENSION(klon) :: yrmu0
871 ! Martin
872
873 960 REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, ydser, &
874 960 ytkt, ytks, ytaur, ysss
875 ! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, tkt, tks,
876 ! taur, sss on ocean points
877
878 !****************************************************************************************
879 ! End of declarations
880 !****************************************************************************************
881
882 IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap
883 !
884 !!jyg iflag_split = mod(iflag_pbl_split,2)
885 !!jyg iflag_split = mod(iflag_pbl_split,10)
886 !
887 ! Flags controlling the splitting of the turbulent boundary layer:
888 ! iflag_split_ref = 0 ==> no splitting
889 ! = 1 ==> splitting without coupling with surface temperature
890 ! = 2 ==> splitting with coupling with surface temperature over land
891 ! = 3 ==> splitting over ocean; no splitting over land
892 ! iflag_split: actual flag controlling the splitting.
893 ! iflag_split = iflag_split_ref outside the sub-surface loop
894 ! = iflag_split_ref if iflag_split_ref = 0, 1, or 2
895 ! = 0 over land if iflga_split_ref = 3
896 ! = 1 over ocean if iflga_split_ref = 3
897
898 480 iflag_split_ref = mod(iflag_pbl_split,10)
899 480 iflag_split = iflag_split_ref
900
901 !****************************************************************************************
902 ! 1) Initialisation and validation tests
903 ! Only done first time entering this subroutine
904 !
905 !****************************************************************************************
906
907 480 IF (first_call) THEN
908
909 1 iflag_new_t2mq2m=1
910 1 CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
911 1 WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
912
913 1 print*,'PBL SURFACE AVEC GUSTINESS'
914 1 first_call=.FALSE.
915
916 ! Initialize ok_flux_surf (for 1D model)
917
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (klon_glo>1) ok_flux_surf=.FALSE.
918
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (klon_glo>1) ok_forc_tsurf=.FALSE.
919
920 ! intialize beta_land
921 1 beta_land = 0.5
922 1 call getin_p('beta_land', beta_land)
923
924 ! Initilize debug IO
925
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
1 IF (debugindex .AND. mpi_size==1) THEN
926 ! initialize IOIPSL output
927 idayref = day_ini
928 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
929 CALL grid1dTo2d_glo(rlon,zx_lon)
930 DO i = 1, nbp_lon
931 zx_lon(i,1) = rlon(i+1)
932 zx_lon(i,nbp_lat) = rlon(i+1)
933 ENDDO
934 CALL grid1dTo2d_glo(rlat,zx_lat)
935 CALL histbeg("sous_index",nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:), &
936 1,nbp_lon,1,nbp_lat, &
937 itau_phy,zjulian,dtime,nhoridbg,nidbg)
938 ! no vertical axis
939 cl_surf(1)='ter'
940 cl_surf(2)='lic'
941 cl_surf(3)='oce'
942 cl_surf(4)='sic'
943 DO nsrf=1,nbsrf
944 CALL histdef(nidbg, cl_surf(nsrf),cl_surf(nsrf), "-",nbp_lon, &
945 nbp_lat,nhoridbg, 1, 1, 1, -99, 32, "inst", dtime,dtime)
946 ENDDO
947
948 CALL histend(nidbg)
949 CALL histsync(nidbg)
950
951 ENDIF
952
953 ENDIF
954
955 !****************************************************************************************
956 ! Force soil water content to qsol0 if qsol0>0 and VEGET=F (use bucket
957 ! instead of ORCHIDEE)
958 480 IF (qsol0>=0.) THEN
959 PRINT*,'WARNING : On impose qsol=',qsol0
960 qsol(:)=qsol0
961 ENDIF
962 !****************************************************************************************
963
964 !****************************************************************************************
965 ! 2) Initialization to zero
966 !****************************************************************************************
967 !
968 ! 2a) Initialization of all argument variables with INTENT(OUT)
969 !****************************************************************************************
970
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 cdragh(:)=0. ; cdragm(:)=0.
971
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 zu1(:)=0. ; zv1(:)=0.
972 !albedo SB >>>
973
10/10
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 2862720 times.
✓ Branch 3 taken 2880 times.
✓ Branch 4 taken 2880 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 2862720 times.
✓ Branch 7 taken 2880 times.
✓ Branch 8 taken 477120 times.
✓ Branch 9 taken 480 times.
6208800 alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
974 !albedo SB <<<
975
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0.
976
16/16
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
✓ Branch 12 taken 18720 times.
✓ Branch 13 taken 480 times.
✓ Branch 14 taken 18607680 times.
✓ Branch 15 taken 18720 times.
74506080 d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
977
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zxfluxlat(:)=0.
978
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
979
4/4
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 2862720 times.
✓ Branch 3 taken 2880 times.
2866080 zn2mout(:,:)=0 ;
980
20/20
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
✓ Branch 12 taken 18720 times.
✓ Branch 13 taken 480 times.
✓ Branch 14 taken 18607680 times.
✓ Branch 15 taken 18720 times.
✓ Branch 16 taken 18720 times.
✓ Branch 17 taken 480 times.
✓ Branch 18 taken 18607680 times.
✓ Branch 19 taken 18720 times.
93132480 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
981
12/12
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 93038400 times.
✓ Branch 5 taken 93600 times.
✓ Branch 6 taken 2400 times.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 93600 times.
✓ Branch 9 taken 2400 times.
✓ Branch 10 taken 93038400 times.
✓ Branch 11 taken 93600 times.
186269280 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
982
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
983
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0.
984
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0.
985
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 slab_wfbils(:)=0.
986
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0.
987
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0.
988
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 s_capCL(:)=0. ; s_oliqCL(:)=0. ; s_cteiCL(:)=0. ; s_pblT(:)=0.
989
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 s_therm(:)=0.
990
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0.
991
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zustar(:)=0.
992
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 zu10m(:)=0. ; zv10m(:)=0.
993
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 fder_print(:)=0.
994
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zxqsurf(:)=0.
995
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 delta_qsurf(:) = 0.
996
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
997
8/8
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 1920 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 1908480 times.
✓ Branch 7 taken 1920 times.
3821280 solsw(:,:)=0. ; sollw(:,:)=0.
998
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 d_ts(:,:)=0.
999
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 evap(:,:)=0.
1000
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 fluxlat(:,:)=0.
1001
8/8
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 1920 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 1908480 times.
✓ Branch 7 taken 1920 times.
3821280 wfbils(:,:)=0. ; wfbilo(:,:)=0.
1002
12/12
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 1920 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 1908480 times.
✓ Branch 7 taken 1920 times.
✓ Branch 8 taken 1920 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 1908480 times.
✓ Branch 11 taken 1920 times.
5731680 wfevap(:,:)=0. ; wfrain(:,:)=0. ; wfsnow(:,:)=0.
1003
24/24
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 74880 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 74430720 times.
✓ Branch 5 taken 74880 times.
✓ Branch 6 taken 1920 times.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 74880 times.
✓ Branch 9 taken 1920 times.
✓ Branch 10 taken 74430720 times.
✓ Branch 11 taken 74880 times.
✓ Branch 12 taken 1920 times.
✓ Branch 13 taken 480 times.
✓ Branch 14 taken 74880 times.
✓ Branch 15 taken 1920 times.
✓ Branch 16 taken 74430720 times.
✓ Branch 17 taken 74880 times.
✓ Branch 18 taken 1920 times.
✓ Branch 19 taken 480 times.
✓ Branch 20 taken 74880 times.
✓ Branch 21 taken 1920 times.
✓ Branch 22 taken 74430720 times.
✓ Branch 23 taken 74880 times.
298030560 flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0.
1004
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 dflux_t(:)=0. ; dflux_q(:)=0.
1005
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zxsnow(:)=0.
1006
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.
1007
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
1008
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 runoff(:)=0.
1009 480 IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
1010
6/6
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 93038400 times.
✓ Branch 5 taken 93600 times.
93134880 zcoefh(:,:,:) = 0.0
1011
4/4
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 2385600 times.
✓ Branch 3 taken 2400 times.
2388480 zcoefh(:,1,:) = 999999. ! zcoefh(:,k=1) should never be used
1012
6/6
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 93038400 times.
✓ Branch 5 taken 93600 times.
93134880 zcoefm(:,:,:) = 0.0
1013
4/4
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 2385600 times.
✓ Branch 3 taken 2400 times.
2388480 zcoefm(:,1,:) = 999999. !
1014 ELSE
1015 zcoefm(:,:,is_ave)=0.
1016 zcoefh(:,:,is_ave)=0.
1017 ENDIF
1018 !!
1019 ! The components "is_ave" of tke_x and wake_deltke are "OUT" variables
1020 !jyg<
1021 !! tke(:,:,is_ave)=0.
1022
4/4
✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
19104480 tke_x(:,:,is_ave)=0.
1023
1024
4/4
✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
19104480 wake_dltke(:,:,is_ave)=0.
1025 !>jyg
1026 !!! jyg le 23/02/2013
1027
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 t2m(:,:) = 999999. ! t2m and q2m are meaningfull only over sub-surfaces
1028
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 q2m(:,:) = 999999. ! actually present in the grid cell.
1029 !!!
1030
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 rh2m(:) = 0. ; qsat2m(:) = 0.
1031 !!!
1032 !!! jyg le 10/02/2012
1033
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 rh2m_x(:) = 0. ; qsat2m_x(:) = 0. ; rh2m_w(:) = 0. ; qsat2m_w(:) = 0.
1034
1035 ! 2b) Initialization of all local variables that will be compressed later
1036 !****************************************************************************************
1037 !! cdragh = 0.0 ; cdragm = 0.0 ; dflux_t = 0.0 ; dflux_q = 0.0
1038
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 ypct = 0.0 ; yts = 0.0 ; ysnow = 0.0
1039 !! zv1 = 0.0 ; yqsurf = 0.0
1040 !albedo SB >>>
1041
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 yqsurf = 0.0 ; yalb = 0.0 ; yalb_vis = 0.0
1042 !albedo SB <<<
1043
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 yrain_f = 0.0 ; ysnow_f = 0.0 ; yfder = 0.0 ; ysolsw = 0.0
1044
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 ysollw = 0.0 ; yz0m = 0.0 ; yz0h = 0.0 ; yu1 = 0.0
1045
10/10
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19200 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 19084800 times.
✓ Branch 5 taken 19200 times.
✓ Branch 6 taken 18720 times.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 18607680 times.
✓ Branch 9 taken 18720 times.
38208000 yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0
1046
16/16
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
✓ Branch 12 taken 18720 times.
✓ Branch 13 taken 480 times.
✓ Branch 14 taken 18607680 times.
✓ Branch 15 taken 18720 times.
74506080 ydelp = 0.0 ; yu = 0.0 ; yv = 0.0 ; yt = 0.0
1047
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
19581120 yq = 0.0 ; y_dflux_t = 0.0 ; y_dflux_q = 0.0
1048
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 yrugoro = 0.0 ; ywindsp = 0.0
1049 !! d_ts = 0.0 ; yfluxlat=0.0 ; flux_t = 0.0 ; flux_q = 0.0
1050
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 yfluxlat=0.0
1051 !! flux_u = 0.0 ; flux_v = 0.0 ; d_t = 0.0 ; d_q = 0.0
1052 !! d_t_diss= 0.0 ;d_u = 0.0 ; d_v = 0.0
1053
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 yqsol = 0.0
1054
1055
4/4
✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
19104480 ytke=0.
1056 !FC
1057
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 y_treedrg=0.
1058
1059 ! Martin
1060
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 477120 times.
✓ Branch 7 taken 480 times.
1908960 ysnowhgt = 0.0; yqsnow = 0.0 ; yrunoff = 0.0 ; ytoice =0.0
1061
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 yalb3_new = 0.0 ; ysissnow = 0.0
1062
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 ycldt = 0.0 ; yrmu0 = 0.0
1063 ! Martin
1064
1065 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
1066
12/12
✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
✓ Branch 4 taken 19200 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 19084800 times.
✓ Branch 7 taken 19200 times.
✓ Branch 8 taken 19200 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 19084800 times.
✓ Branch 11 taken 19200 times.
57312480 ytke_x=0. ; ytke_w=0. ; ywake_dltke=0.
1067
16/16
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
✓ Branch 12 taken 18720 times.
✓ Branch 13 taken 480 times.
✓ Branch 14 taken 18607680 times.
✓ Branch 15 taken 18720 times.
74506080 y_d_t_x=0. ; y_d_t_w=0. ; y_d_q_x=0. ; y_d_q_w=0.
1068 !! d_t_w=0. ; d_q_w=0.
1069 !! d_t_x=0. ; d_q_x=0.
1070 !! d_wake_dlt=0. ; d_wake_dlq=0.
1071
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 yfluxlat_x=0. ; yfluxlat_w=0.
1072
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 ywake_s=0. ; ywake_cstar=0. ;ywake_dens=0.
1073 !!!
1074 !!! nrlmd le 13/06/2011
1075
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 tau_eq=0. ; delta_coef=0.
1076
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 y_delta_flux_t1=0.
1077
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 ydtsurf_th=0.
1078
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 yts_x(:)=0. ; yts_w(:)=0.
1079
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 y_delta_tsurf(:)=0. ; y_delta_qsurf(:)=0.
1080
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 yqsurf_x(:)=0. ; yqsurf_w(:)=0.
1081
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 yg_T(:) = 0. ; yg_Q(:) = 0.
1082
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 yGamma_dTs_phiT(:) = 0. ; yGamma_dQs_phiQ(:) = 0.
1083
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 ydTs_ins(:) = 0. ; ydqs_ins(:) = 0.
1084
1085 !!!
1086
4/4
✓ Branch 0 taken 5280 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 5248320 times.
✓ Branch 3 taken 5280 times.
5254080 ytsoil = 999999.
1087 !FC
1088
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 y_d_u_frein(:,:)=0.
1089
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 y_d_v_frein(:,:)=0.
1090 !FC
1091
1092 ! >> PC
1093 !the yfields_out variable is defined in (klon,nbcf_out) even if it is used on
1094 !the ORCHIDEE grid and as such should be defined in yfields_out(knon,nbcf_out) but
1095 !the knon variable is not known at that level of pbl_surface_mod
1096
1097 !the yfields_in variable is defined in (klon,nbcf_in) even if it is used on the
1098 !ORCHIDEE grid and as such should be defined in yfields_in(knon,nbcf_in) but the
1099 !knon variable is not known at that level of pbl_surface_mod
1100
1101
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
480 yfields_out(:,:) = 0.
1102 ! << PC
1103
1104
1105 ! 2c) Initialization of all local variables computed within the subsurface loop and used later on
1106 !****************************************************************************************
1107
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 d_t_diss_x(:,:) = 0. ; d_t_diss_w(:,:) = 0.
1108
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 d_u_x(:,:)=0. ; d_u_w(:,:)=0.
1109
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 d_v_x(:,:)=0. ; d_v_w(:,:)=0.
1110
12/12
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 74880 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 74430720 times.
✓ Branch 5 taken 74880 times.
✓ Branch 6 taken 1920 times.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 74880 times.
✓ Branch 9 taken 1920 times.
✓ Branch 10 taken 74430720 times.
✓ Branch 11 taken 74880 times.
149015520 flux_t_x(:,:,:)=0. ; flux_t_w(:,:,:)=0.
1111
12/12
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 74880 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 74430720 times.
✓ Branch 5 taken 74880 times.
✓ Branch 6 taken 1920 times.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 74880 times.
✓ Branch 9 taken 1920 times.
✓ Branch 10 taken 74430720 times.
✓ Branch 11 taken 74880 times.
149015520 flux_q_x(:,:,:)=0. ; flux_q_w(:,:,:)=0.
1112 !
1113 !jyg<
1114
12/12
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 74880 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 74430720 times.
✓ Branch 5 taken 74880 times.
✓ Branch 6 taken 1920 times.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 74880 times.
✓ Branch 9 taken 1920 times.
✓ Branch 10 taken 74430720 times.
✓ Branch 11 taken 74880 times.
149015520 flux_u_x(:,:,:)=0. ; flux_u_w(:,:,:)=0.
1115
12/12
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 74880 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 74430720 times.
✓ Branch 5 taken 74880 times.
✓ Branch 6 taken 1920 times.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 74880 times.
✓ Branch 9 taken 1920 times.
✓ Branch 10 taken 74430720 times.
✓ Branch 11 taken 74880 times.
149015520 flux_v_x(:,:,:)=0. ; flux_v_w(:,:,:)=0.
1116
8/8
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 1920 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 1908480 times.
✓ Branch 7 taken 1920 times.
3821280 fluxlat_x(:,:)=0. ; fluxlat_w(:,:)=0.
1117 !>jyg
1118 !
1119 !jyg<
1120 ! pblh,plcl,capCL,cteiCL ... are meaningfull only over sub-surfaces
1121 ! actually present in the grid cell ==> value set to 999999.
1122 !
1123 !jyg<
1124
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 ustar(:,:) = 999999.
1125
4/4
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 2385600 times.
✓ Branch 3 taken 2400 times.
2388480 wstar(:,:) = 999999.
1126
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 windsp(:,:) = SQRT(u10m(:,:)**2 + v10m(:,:)**2 )
1127
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 u10m(:,:) = 999999.
1128
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 v10m(:,:) = 999999.
1129 !>jyg
1130 !
1131
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 pblh(:,:) = 999999. ! Hauteur de couche limite
1132
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 plcl(:,:) = 999999. ! Niveau de condensation de la CLA
1133
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 capCL(:,:) = 999999. ! CAPE de couche limite
1134
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 oliqCL(:,:) = 999999. ! eau_liqu integree de couche limite
1135
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 cteiCL(:,:) = 999999. ! cloud top instab. crit. couche limite
1136
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 pblt(:,:) = 999999. ! T a la Hauteur de couche limite
1137
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 therm(:,:) = 999999.
1138
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb1(:,:) = 999999. ! deep_cape
1139
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb2(:,:) = 999999. ! inhibition
1140
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb3(:,:) = 999999. ! Point Omega
1141 !
1142
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 t2m_x(:,:) = 999999.
1143
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 q2m_x(:,:) = 999999.
1144
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 ustar_x(:,:) = 999999.
1145
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 wstar_x(:,:) = 999999.
1146
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 u10m_x(:,:) = 999999.
1147
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 v10m_x(:,:) = 999999.
1148 !
1149
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 pblh_x(:,:) = 999999. ! Hauteur de couche limite
1150
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 plcl_x(:,:) = 999999. ! Niveau de condensation de la CLA
1151
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 capCL_x(:,:) = 999999. ! CAPE de couche limite
1152
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 oliqCL_x(:,:) = 999999. ! eau_liqu integree de couche limite
1153
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 cteiCL_x(:,:) = 999999. ! cloud top instab. crit. couche limite
1154
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 pblt_x(:,:) = 999999. ! T a la Hauteur de couche limite
1155
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 therm_x(:,:) = 999999.
1156
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb1_x(:,:) = 999999. ! deep_cape
1157
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb2_x(:,:) = 999999. ! inhibition
1158
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb3_x(:,:) = 999999. ! Point Omega
1159 !
1160
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 t2m_w(:,:) = 999999.
1161
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 q2m_w(:,:) = 999999.
1162
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 ustar_w(:,:) = 999999.
1163
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 wstar_w(:,:) = 999999.
1164
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 u10m_w(:,:) = 999999.
1165
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 v10m_w(:,:) = 999999.
1166
1167
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 pblh_w(:,:) = 999999. ! Hauteur de couche limite
1168
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 plcl_w(:,:) = 999999. ! Niveau de condensation de la CLA
1169
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 capCL_w(:,:) = 999999. ! CAPE de couche limite
1170
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 oliqCL_w(:,:) = 999999. ! eau_liqu integree de couche limite
1171
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 cteiCL_w(:,:) = 999999. ! cloud top instab. crit. couche limite
1172
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 pblt_w(:,:) = 999999. ! T a la Hauteur de couche limite
1173
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 therm_w(:,:) = 999999.
1174
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb1_w(:,:) = 999999. ! deep_cape
1175
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb2_w(:,:) = 999999. ! inhibition
1176
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 trmb3_w(:,:) = 999999. ! Point Omega
1177 !!!
1178 !
1179 !!!
1180 !****************************************************************************************
1181 ! 3) - Calculate pressure thickness of each layer
1182 ! - Calculate the wind at first layer
1183 ! - Mean calculations of albedo
1184 ! - Calculate net radiance at sub-surface
1185 !****************************************************************************************
1186
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
1187
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
1188 18626400 delp(i,k) = paprs(i,k)-paprs(i,k+1)
1189 ENDDO
1190 ENDDO
1191
1192 !****************************************************************************************
1193 ! Test for rugos........ from physiq.. A la fin plutot???
1194 !
1195 !****************************************************************************************
1196
1197
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
1198
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
1199 1908480 z0m(i,nsrf) = MAX(z0m(i,nsrf),z0min)
1200 1920 z0h(i,nsrf) = MAX(z0h(i,nsrf),z0min)
1201 ENDDO
1202 ENDDO
1203
1204 ! Mean calculations of albedo
1205 !
1206 ! * alb : mean albedo for whole SW interval
1207 !
1208 ! Mean albedo for grid point
1209 ! * alb_m : mean albedo at whole SW interval
1210
1211
4/4
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 2862720 times.
✓ Branch 3 taken 2880 times.
2866080 alb_dir_m(:,:) = 0.0
1212
4/4
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 2862720 times.
✓ Branch 3 taken 2880 times.
2866080 alb_dif_m(:,:) = 0.0
1213
2/2
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 480 times.
3360 DO k = 1, nsw
1214
2/2
✓ Branch 0 taken 11520 times.
✓ Branch 1 taken 2880 times.
14880 DO nsrf = 1, nbsrf
1215
2/2
✓ Branch 0 taken 11450880 times.
✓ Branch 1 taken 11520 times.
11465280 DO i = 1, klon
1216 11450880 alb_dir_m(i,k) = alb_dir_m(i,k) + alb_dir(i,k,nsrf) * pctsrf(i,nsrf)
1217 11462400 alb_dif_m(i,k) = alb_dif_m(i,k) + alb_dif(i,k,nsrf) * pctsrf(i,nsrf)
1218 ENDDO
1219 ENDDO
1220 ENDDO
1221
1222 ! We here suppose the fraction f1 of incoming radiance of visible radiance
1223 ! as a fraction of all shortwave radiance
1224 f1 = 0.5
1225 ! f1 = 1 ! put f1=1 to recreate old calculations
1226
1227 !f1 is already included with SFRWL values in each surf files
1228
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 alb=0.0
1229
2/2
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 480 times.
3360 DO k=1,nsw
1230
2/2
✓ Branch 0 taken 11520 times.
✓ Branch 1 taken 2880 times.
14880 DO nsrf = 1, nbsrf
1231
2/2
✓ Branch 0 taken 11450880 times.
✓ Branch 1 taken 11520 times.
11465280 DO i = 1, klon
1232 11462400 alb(i,nsrf) = alb(i,nsrf) + alb_dir(i,k,nsrf)*SFRWL(k)
1233 ENDDO
1234 ENDDO
1235 ENDDO
1236
1237
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 alb_m=0.0
1238
2/2
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 480 times.
3360 DO k = 1,nsw
1239
2/2
✓ Branch 0 taken 2862720 times.
✓ Branch 1 taken 2880 times.
2866080 DO i = 1, klon
1240 2865600 alb_m(i) = alb_m(i) + alb_dir_m(i,k)*SFRWL(k)
1241 ENDDO
1242 ENDDO
1243 !albedo SB <<<
1244
1245
1246
1247 ! Calculation of mean temperature at surface grid points
1248
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 ztsol(:) = 0.0
1249
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
1250
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
1251 1910400 ztsol(i) = ztsol(i) + ts(i,nsrf)*pctsrf(i,nsrf)
1252 ENDDO
1253 ENDDO
1254
1255 ! Linear distrubution on sub-surface of long- and shortwave net radiance
1256
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
1257
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
1258 1908480 sollw(i,nsrf) = sollw_m(i) + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ts(i,nsrf))
1259 !--OB this line is not satisfactory because alb is the direct albedo not total albedo
1260 1920 solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
1261 ENDDO
1262 ENDDO
1263 !
1264 !<al1: second order corrections
1265 !- net = dwn -up; up=sig( T4 + 4sum%T3T' + 6sum%T2T'2 +...)
1266 480 IF (iflag_order2_sollw == 1) THEN
1267 meansqT(:) = 0. ! as working buffer
1268 DO nsrf = 1, nbsrf
1269 DO i = 1, klon
1270 meansqT(i) = meansqT(i)+(ts(i,nsrf)-ztsol(i))**2 *pctsrf(i,nsrf)
1271 ENDDO
1272 ENDDO
1273 DO nsrf = 1, nbsrf
1274 DO i = 1, klon
1275 sollw(i,nsrf) = sollw(i,nsrf) &
1276 + 6.0*RSIGMA*ztsol(i)**2 *(meansqT(i)-(ztsol(i)-ts(i,nsrf))**2)
1277 ENDDO
1278 ENDDO
1279 ENDIF ! iflag_order2_sollw == 1
1280 !>al1
1281
1282 !--OB add diffuse fraction of SW down
1283
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 DO n=1,nbcf_out
1284
0/4
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
480 IF (cfname_out(n) == "swdownfdiff" ) fields_out(:,n) = solswfdiff_m(:)
1285 ENDDO
1286 ! >> PC
1287
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
480 IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
1288 r_co2_ppm(:) = co2_send(:)
1289 DO n=1,nbcf_out
1290 IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_send(:)
1291 ENDDO
1292 ENDIF
1293
2/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
480 IF ( .NOT. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
1294 r_co2_ppm(:) = co2_ppm ! Constant field
1295 DO n=1,nbcf_out
1296 IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_ppm
1297 ENDDO
1298 ENDIF
1299 ! << PC
1300
1301 !****************************************************************************************
1302 ! 4) Loop over different surfaces
1303 !
1304 ! Only points containing a fraction of the sub surface will be treated.
1305 !
1306 !****************************************************************************************
1307 !<<<<<<<<<<<<<
1308
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 loop_nbsrf: DO nsrf = 1, nbsrf !<<<<<<<<<<<<<
1309 !<<<<<<<<<<<<<
1310
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) print *,' Loop nsrf ',nsrf
1311 !
1312
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (iflag_split_ref == 3) THEN
1313 IF (nsrf == is_oce) THEN
1314 iflag_split = 1
1315 ELSE
1316 iflag_split=0
1317 ENDIF !! (nsrf == is_oce)
1318 ELSE
1319 1920 iflag_split = iflag_split_ref
1320 ENDIF !! (iflag_split_ref == 3)
1321
1322 ! Search for index(ni) and size(knon) of domaine to treat
1323
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 ni(:) = 0
1324 1920 knon = 0
1325
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 DO i = 1, klon
1326
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1120028 times.
1910400 IF (pctsrf(i,nsrf) > 0.) THEN
1327 788452 knon = knon + 1
1328 788452 ni(knon) = i
1329 ENDIF
1330 ENDDO
1331
1332 !!! jyg le 19/08/2012
1333 ! IF (knon <= 0) THEN
1334 ! IF (prt_level >= 10) print *,' no grid point for nsrf= ',nsrf
1335 ! cycle loop_nbsrf
1336 ! ENDIF
1337 !!!
1338
1339 ! write index, with IOIPSL
1340
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
1920 IF (debugindex .AND. mpi_size==1) THEN
1341 tabindx(:)=0.
1342 DO i=1,knon
1343 tabindx(i)=REAL(i)
1344 ENDDO
1345 debugtab(:,:) = 0.
1346 ndexbg(:) = 0
1347 CALL gath2cpl(tabindx,debugtab,knon,ni)
1348 CALL histwrite(nidbg,cl_surf(nsrf),itap,debugtab,nbp_lon*nbp_lat, ndexbg)
1349 ENDIF
1350
1351 !****************************************************************************************
1352 ! 5) Compress variables
1353 !
1354 !****************************************************************************************
1355
1356 !
1357 !jyg< (20190926)
1358 ! Provisional : set ybeta to standard values
1359
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 480 times.
1920 IF (nsrf .NE. is_ter) THEN
1360
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 ybeta(:) = 1.
1361 ELSE
1362
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_split .EQ. 0) THEN
1363
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 ybeta(:) = 1.
1364 ELSE
1365 DO j = 1, knon
1366 i = ni(j)
1367 ybeta(j) = beta(i,nsrf)
1368 ENDDO
1369 ENDIF ! (iflag_split .LE.1)
1370 ENDIF ! (nsrf .NE. is_ter)
1371 !>jyg
1372 !
1373
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 DO j = 1, knon
1374 788452 i = ni(j)
1375 788452 ypct(j) = pctsrf(i,nsrf)
1376 788452 yts(j) = ts(i,nsrf)
1377 788452 ysnow(j) = snow(i,nsrf)
1378 788452 yqsurf(j) = qsurf(i,nsrf)
1379 788452 yalb(j) = alb(i,nsrf)
1380 !albedo SB >>>
1381 788452 yalb_vis(j) = alb_dir(i,1,nsrf)
1382 788452 IF (nsw==6) THEN
1383 yalb_vis(j)=(alb_dir(i,1,nsrf)*SFRWL(1)+alb_dir(i,2,nsrf)*SFRWL(2) &
1384 788452 +alb_dir(i,3,nsrf)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
1385 ENDIF
1386 !albedo SB <<<
1387 788452 yrain_f(j) = rain_f(i)
1388 788452 ysnow_f(j) = snow_f(i)
1389 788452 yagesno(j) = agesno(i,nsrf)
1390 788452 yfder(j) = fder(i)
1391 788452 ylwdown(j) = lwdown_m(i)
1392 788452 ygustiness(j) = gustiness(i)
1393 788452 ysolsw(j) = solsw(i,nsrf)
1394 788452 ysollw(j) = sollw(i,nsrf)
1395 788452 yz0m(j) = z0m(i,nsrf)
1396 788452 yz0h(j) = z0h(i,nsrf)
1397 788452 yrugoro(j) = rugoro(i)
1398 788452 yu1(j) = u(i,1)
1399 788452 yv1(j) = v(i,1)
1400 788452 ypaprs(j,klev+1) = paprs(i,klev+1)
1401 !jyg<
1402 !! ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 )
1403 788452 ywindsp(j) = windsp(i,nsrf)
1404 !>jyg
1405 ! Martin and Etienne
1406 788452 yzmea(j) = zmea(i)
1407 788452 yzsig(j) = zsig(i)
1408 788452 ycldt(j) = cldt(i)
1409 788452 yrmu0(j) = rmu0(i)
1410 ! Martin
1411 !!! nrlmd le 13/06/2011
1412 790372 y_delta_tsurf(j)=delta_tsurf(i,nsrf)
1413 !!!
1414 ENDDO
1415 ! >> PC
1416 !--compressing fields_out onto ORCHIDEE grid
1417 !--these fields are shared and used directly surf_land_orchidee_mod
1418
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 DO n = 1, nbcf_out
1419
0/2
✗ Branch 0 not taken.
✗ Branch 1 not taken.
1920 DO j = 1, knon
1420 i = ni(j)
1421 yfields_out(j,n) = fields_out(i,n)
1422 ENDDO
1423 ENDDO
1424 ! << PC
1425
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
76800 DO k = 1, klev
1426
2/2
✓ Branch 0 taken 30749628 times.
✓ Branch 1 taken 74880 times.
30826428 DO j = 1, knon
1427 30749628 i = ni(j)
1428 30749628 ypaprs(j,k) = paprs(i,k)
1429 30749628 ypplay(j,k) = pplay(i,k)
1430 30824508 ydelp(j,k) = delp(i,k)
1431 ENDDO
1432 ENDDO
1433 !
1434 !!! jyg le 07/02/2012 et le 10/04/2013
1435
2/2
✓ Branch 0 taken 76800 times.
✓ Branch 1 taken 1920 times.
78720 DO k = 1, klev+1
1436
2/2
✓ Branch 0 taken 31538080 times.
✓ Branch 1 taken 76800 times.
31616800 DO j = 1, knon
1437 31538080 i = ni(j)
1438 !jyg<
1439 !! ytke(j,k) = tke(i,k,nsrf)
1440 31614880 ytke(j,k) = tke_x(i,k,nsrf)
1441 ENDDO
1442 ENDDO
1443 !>jyg
1444
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
76800 DO k = 1, klev
1445
2/2
✓ Branch 0 taken 30749628 times.
✓ Branch 1 taken 74880 times.
30826428 DO j = 1, knon
1446 30749628 i = ni(j)
1447 30749628 y_treedrg(j,k) = treedrg(i,k,nsrf)
1448 30749628 yu(j,k) = u(i,k)
1449 30749628 yv(j,k) = v(i,k)
1450 30749628 yt(j,k) = t(i,k)
1451 30824508 yq(j,k) = q(i,k)
1452 ENDDO
1453 ENDDO
1454 !
1455
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (iflag_split.GE.1) THEN
1456 !!! nrlmd le 02/05/2011
1457 DO k = 1, klev
1458 DO j = 1, knon
1459 i = ni(j)
1460 yu_x(j,k) = u(i,k)
1461 yv_x(j,k) = v(i,k)
1462 yt_x(j,k) = t(i,k)-wake_s(i)*wake_dlt(i,k)
1463 yq_x(j,k) = q(i,k)-wake_s(i)*wake_dlq(i,k)
1464 yu_w(j,k) = u(i,k)
1465 yv_w(j,k) = v(i,k)
1466 yt_w(j,k) = t(i,k)+(1.-wake_s(i))*wake_dlt(i,k)
1467 yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k)
1468 !!!
1469 ENDDO
1470 ENDDO
1471
1472 IF (prt_level .ge. 10) THEN
1473 print *,'pbl_surface, wake_s(1), wake_dlt(1,:) ', wake_s(1), wake_dlt(1,:)
1474 print *,'pbl_surface, wake_s(1), wake_dlq(1,:) ', wake_s(1), wake_dlq(1,:)
1475 ENDIF
1476
1477 !!! nrlmd le 02/05/2011
1478 DO k = 1, klev+1
1479 DO j = 1, knon
1480 i = ni(j)
1481 !jyg<
1482 !! ytke_x(j,k) = tke(i,k,nsrf)-wake_s(i)*wake_dltke(i,k,nsrf)
1483 !! ytke_w(j,k) = tke(i,k,nsrf)+(1.-wake_s(i))*wake_dltke(i,k,nsrf)
1484 !! ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
1485 !! ytke(j,k) = tke(i,k,nsrf)
1486 !
1487 ytke_x(j,k) = tke_x(i,k,nsrf)
1488 ytke(j,k) = tke_x(i,k,nsrf)+wake_s(i)*wake_dltke(i,k,nsrf)
1489 ytke_w(j,k) = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
1490 ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
1491
1492 !>jyg
1493 ENDDO
1494 ENDDO
1495 !!!
1496 !!! jyg le 07/02/2012
1497 DO j = 1, knon
1498 i = ni(j)
1499 ywake_s(j)=wake_s(i)
1500 ywake_cstar(j)=wake_cstar(i)
1501 ywake_dens(j)=wake_dens(i)
1502 ENDDO
1503 !!!
1504 !!! nrlmd le 13/06/2011
1505 DO j=1,knon
1506 yts_x(j)=yts(j)-ywake_s(j)*y_delta_tsurf(j)
1507 yts_w(j)=yts(j)+(1.-ywake_s(j))*y_delta_tsurf(j)
1508 ENDDO
1509 !!!
1510 ENDIF ! (iflag_split .ge.1)
1511 !!!
1512
2/2
✓ Branch 0 taken 21120 times.
✓ Branch 1 taken 1920 times.
23040 DO k = 1, nsoilmx
1513
2/2
✓ Branch 0 taken 8672972 times.
✓ Branch 1 taken 21120 times.
8696012 DO j = 1, knon
1514 8672972 i = ni(j)
1515 8694092 ytsoil(j,k) = ftsoil(i,k,nsrf)
1516 ENDDO
1517 ENDDO
1518
1519 ! qsol(water height in soil) only for bucket continental model
1520
3/4
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 1440 times.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
1920 IF ( nsrf .EQ. is_ter .AND. .NOT. ok_veget ) THEN
1521
2/2
✓ Branch 0 taken 247680 times.
✓ Branch 1 taken 480 times.
248160 DO j = 1, knon
1522 247680 i = ni(j)
1523 248160 yqsol(j) = qsol(i)
1524 ENDDO
1525 ENDIF
1526
1527
3/4
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 1440 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
1920 if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
1528 if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
1529 ydelta_sal(:knon) = delta_sal(ni(:knon))
1530 ydelta_sst(:knon) = delta_sst(ni(:knon))
1531 end if
1532
1533 yds_ns(:knon) = ds_ns(ni(:knon))
1534 ydt_ns(:knon) = dt_ns(ni(:knon))
1535 end if
1536
1537 !****************************************************************************************
1538 ! 6a) Calculate coefficients for turbulent diffusion at surface, cdragh et cdragm.
1539 !
1540 !****************************************************************************************
1541
1542
1543 !!! jyg le 07/02/2012
1544
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
1545 !!!
1546 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
1547 ! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
1548 ! CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
1549 ! yu(:,1), yv(:,1), yt(:,1), yq(:,1), &
1550 ! yts, yqsurf, yrugos, &
1551 ! ycdragm, ycdragh )
1552 ! Fuxing WANG, 04/03/2015, replace the clcdrag by the merged version: cdrag
1553
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 DO i = 1, knon
1554 ! print*,'PBL ',i,RD
1555 ! print*,'PBL ',yt(i,1),ypaprs(i,1),ypplay(i,1)
1556 zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
1557 788452 * (ypaprs(i,1)-ypplay(i,1))
1558 1920 speed(i) = SQRT(yu(i,1)**2+yv(i,1)**2)
1559 ENDDO
1560 CALL cdrag(knon, nsrf, &
1561 speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
1562 yts, yqsurf, yz0m, yz0h, &
1563 1920 ycdragm, ycdragh, zri1, pref )
1564
1565 ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
1566 1920 IF (ok_prescr_ust) THEN
1567 DO i = 1, knon
1568 print *,'ycdragm avant=',ycdragm(i)
1569 vent= sqrt(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1))
1570 ! ycdragm(i) = ust*ust/(1.+(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1)))
1571 ! ycdragm(i) = ust*ust/((1.+sqrt(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1))) &
1572 ! *sqrt(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1)))
1573 ycdragm(i) = ust*ust/(1.+vent)/vent
1574 ! print *,'ycdragm ust yu yv apres=',ycdragm(i),ust,yu(i,1),yv(i,1)
1575 ENDDO
1576 ENDIF
1577
1578
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
1579 ELSE !(iflag_split .eq.0)
1580
1581 ! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
1582 ! CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
1583 ! yu_x(:,1), yv_x(:,1), yt_x(:,1), yq_x(:,1), &
1584 ! yts_x, yqsurf, yrugos, &
1585 ! ycdragm_x, ycdragh_x )
1586 ! Fuxing WANG, 04/03/2015, replace the clcdrag by the merged version: cdrag
1587 DO i = 1, knon
1588 zgeo1_x(i) = RD * yt_x(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
1589 * (ypaprs(i,1)-ypplay(i,1))
1590 speed_x(i) = SQRT(yu_x(i,1)**2+yv_x(i,1)**2)
1591 ENDDO
1592
1593
1594 CALL cdrag(knon, nsrf, &
1595 speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
1596 yts_x, yqsurf_x, yz0m, yz0h, &
1597 ycdragm_x, ycdragh_x, zri1_x, pref_x )
1598
1599 ! --- special Dice. JYG+MPL 25112013
1600 IF (ok_prescr_ust) THEN
1601 DO i = 1, knon
1602 ! print *,'ycdragm_x avant=',ycdragm_x(i)
1603 vent= sqrt(yu_x(i,1)*yu_x(i,1)+yv_x(i,1)*yv_x(i,1))
1604 ycdragm_x(i) = ust*ust/(1.+vent)/vent
1605 ! print *,'ycdragm_x ust yu yv apres=',ycdragm_x(i),ust,yu_x(i,1),yv_x(i,1)
1606 ENDDO
1607 ENDIF
1608 IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x
1609 !
1610 ! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
1611 ! CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
1612 ! yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), &
1613 ! yts_w, yqsurf, yz0m, &
1614 ! ycdragm_w, ycdragh_w )
1615 ! Fuxing WANG, 04/03/2015, replace the clcdrag by the merged version: cdrag
1616 DO i = 1, knon
1617 zgeo1_w(i) = RD * yt_w(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
1618 * (ypaprs(i,1)-ypplay(i,1))
1619 speed_w(i) = SQRT(yu_w(i,1)**2+yv_w(i,1)**2)
1620 ENDDO
1621 CALL cdrag(knon, nsrf, &
1622 speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
1623 yts_w, yqsurf_w, yz0m, yz0h, &
1624 ycdragm_w, ycdragh_w, zri1_w, pref_w )
1625 !
1626 zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
1627
1628 ! --- special Dice. JYG+MPL 25112013 puis BOMEX
1629 IF (ok_prescr_ust) THEN
1630 DO i = 1, knon
1631 ! print *,'ycdragm_w avant=',ycdragm_w(i)
1632 vent= sqrt(yu_w(i,1)*yu_w(i,1)+yv_w(i,1)*yv_w(i,1))
1633 ycdragm_w(i) = ust*ust/(1.+vent)/vent
1634 ! print *,'ycdragm_w ust yu yv apres=',ycdragm_w(i),ust,yu_w(i,1),yv_w(i,1)
1635 ENDDO
1636 ENDIF
1637 IF (prt_level >=10) print *,'clcdrag -> ycdragh_w ', ycdragh_w
1638 !!!
1639 ENDIF ! (iflag_split .eq.0)
1640 !!!
1641
1642
1643 !****************************************************************************************
1644 ! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefh et ycoefm.
1645 !
1646 !****************************************************************************************
1647
1648 !!! jyg le 07/02/2012
1649
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
1650 !!!
1651 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
1652
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) THEN
1653 print *,' args coef_diff_turb: yu ', yu
1654 print *,' args coef_diff_turb: yv ', yv
1655 print *,' args coef_diff_turb: yq ', yq
1656 print *,' args coef_diff_turb: yt ', yt
1657 print *,' args coef_diff_turb: yts ', yts
1658 print *,' args coef_diff_turb: yz0m ', yz0m
1659 print *,' args coef_diff_turb: yqsurf ', yqsurf
1660 print *,' args coef_diff_turb: ycdragm ', ycdragm
1661 print *,' args coef_diff_turb: ycdragh ', ycdragh
1662 print *,' args coef_diff_turb: ytke ', ytke
1663
1664 ENDIF
1665 CALL coef_diff_turb(dtime, nsrf, knon, ni, &
1666 ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
1667 1920 ycoefm, ycoefh, ytke, y_treedrg)
1668 ! ycoefm, ycoefh, ytke)
1669 !FC y_treedrg ajoute
1670 1920 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
1671 ! In this case, coef_diff_turb is called for the Cd only
1672 DO k = 2, klev
1673 DO j = 1, knon
1674 i = ni(j)
1675 ycoefh(j,k) = zcoefh(i,k,nsrf)
1676 ycoefm(j,k) = zcoefm(i,k,nsrf)
1677 ENDDO
1678 ENDDO
1679 ENDIF
1680
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh
1681 !
1682 ELSE !(iflag_split .eq.0)
1683 IF (prt_level >=10) THEN
1684 print *,' args coef_diff_turb: yu_x ', yu_x
1685 print *,' args coef_diff_turb: yv_x ', yv_x
1686 print *,' args coef_diff_turb: yq_x ', yq_x
1687 print *,' args coef_diff_turb: yt_x ', yt_x
1688 print *,' args coef_diff_turb: yts_x ', yts_x
1689 print *,' args coef_diff_turb: yqsurf ', yqsurf
1690 print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x
1691 print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x
1692 print *,' args coef_diff_turb: ytke_x ', ytke_x
1693
1694 ENDIF
1695 CALL coef_diff_turb(dtime, nsrf, knon, ni, &
1696 ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf_x, ycdragm_x, &
1697 ycoefm_x, ycoefh_x, ytke_x,y_treedrg)
1698 ! ycoefm_x, ycoefh_x, ytke_x)
1699 !FC doit on le mettre ( on ne l utilise pas si il y a du spliting)
1700 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
1701 ! In this case, coef_diff_turb is called for the Cd only
1702 DO k = 2, klev
1703 DO j = 1, knon
1704 i = ni(j)
1705 ycoefh_x(j,k) = zcoefh(i,k,nsrf)
1706 ycoefm_x(j,k) = zcoefm(i,k,nsrf)
1707 ENDDO
1708 ENDDO
1709 ENDIF
1710 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x
1711 !
1712 IF (prt_level >=10) THEN
1713 print *,' args coef_diff_turb: yu_w ', yu_w
1714 print *,' args coef_diff_turb: yv_w ', yv_w
1715 print *,' args coef_diff_turb: yq_w ', yq_w
1716 print *,' args coef_diff_turb: yt_w ', yt_w
1717 print *,' args coef_diff_turb: yts_w ', yts_w
1718 print *,' args coef_diff_turb: yqsurf ', yqsurf
1719 print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w
1720 print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w
1721 print *,' args coef_diff_turb: ytke_w ', ytke_w
1722 ENDIF
1723 CALL coef_diff_turb(dtime, nsrf, knon, ni, &
1724 ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf_w, ycdragm_w, &
1725 ycoefm_w, ycoefh_w, ytke_w,y_treedrg)
1726 ! ycoefm_w, ycoefh_w, ytke_w)
1727 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
1728 ! In this case, coef_diff_turb is called for the Cd only
1729 DO k = 2, klev
1730 DO j = 1, knon
1731 i = ni(j)
1732 ycoefh_w(j,k) = zcoefh(i,k,nsrf)
1733 ycoefm_w(j,k) = zcoefm(i,k,nsrf)
1734 ENDDO
1735 ENDDO
1736 ENDIF
1737 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w
1738 !
1739 !!!jyg le 10/04/2013
1740 !! En attendant de traiter le transport des traceurs dans les poches froides, formule
1741 !! arbitraire pour ycoefh et ycoefm
1742 DO k = 2,klev
1743 DO j = 1,knon
1744 ycoefh(j,k) = ycoefh_x(j,k) + ywake_s(j)*(ycoefh_w(j,k) - ycoefh_x(j,k))
1745 ycoefm(j,k) = ycoefm_x(j,k) + ywake_s(j)*(ycoefm_w(j,k) - ycoefm_x(j,k))
1746 ENDDO
1747 ENDDO
1748 !!!
1749 ENDIF ! (iflag_split .eq.0)
1750 !!!
1751
1752 !****************************************************************************************
1753 !
1754 ! 8) "La descente" - "The downhill"
1755 !
1756 ! climb_hq_down and climb_wind_down calculate the coefficients
1757 ! Ccoef_X et Dcoef_X for X=[H, Q, U, V].
1758 ! Only the coefficients at surface for H and Q are returned.
1759 !
1760 !****************************************************************************************
1761
1762 ! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q
1763 !!! jyg le 07/02/2012
1764
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
1765 !!!
1766 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
1767 CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, &
1768 ydelp, yt, yq, dtime, &
1769 !!! jyg le 09/05/2011
1770 CcoefH, CcoefQ, DcoefH, DcoefQ, &
1771 Kcoef_hq, gama_q, gama_h, &
1772 !!!
1773 1920 AcoefH, AcoefQ, BcoefH, BcoefQ)
1774 ELSE !(iflag_split .eq.0)
1775 CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, &
1776 ydelp, yt_x, yq_x, dtime, &
1777 !!! nrlmd le 02/05/2011
1778 CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
1779 Kcoef_hq_x, gama_q_x, gama_h_x, &
1780 !!!
1781 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x)
1782 !!!
1783 IF (prt_level >=10) THEN
1784 PRINT *,'pbl_surface (climb_hq_down.x->) AcoefH_x ',AcoefH_x
1785 PRINT *,'pbl_surface (climb_hq_down.x->) AcoefQ_x ',AcoefQ_x
1786 PRINT *,'pbl_surface (climb_hq_down.x->) BcoefH_x ',BcoefH_x
1787 PRINT *,'pbl_surface (climb_hq_down.x->) BcoefQ_x ',BcoefQ_x
1788 ENDIF
1789 !
1790 CALL climb_hq_down(knon, ycoefh_w, ypaprs, ypplay, &
1791 ydelp, yt_w, yq_w, dtime, &
1792 !!! nrlmd le 02/05/2011
1793 CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
1794 Kcoef_hq_w, gama_q_w, gama_h_w, &
1795 !!!
1796 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w)
1797 !!!
1798 IF (prt_level >=10) THEN
1799 PRINT *,'pbl_surface (climb_hq_down.w->) AcoefH_w ',AcoefH_w
1800 PRINT *,'pbl_surface (climb_hq_down.w->) AcoefQ_w ',AcoefQ_w
1801 PRINT *,'pbl_surface (climb_hq_down.w->) BcoefH_w ',BcoefH_w
1802 PRINT *,'pbl_surface (climb_hq_down.w->) BcoefQ_w ',BcoefQ_w
1803 ENDIF
1804 !!!
1805 ENDIF ! (iflag_split .eq.0)
1806 !!!
1807
1808 ! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
1809 !!! jyg le 07/02/2012
1810
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
1811 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
1812 CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
1813 !!! jyg le 09/05/2011
1814 CcoefU, CcoefV, DcoefU, DcoefV, &
1815 Kcoef_m, alf_1, alf_2, &
1816 !!!
1817 1920 AcoefU, AcoefV, BcoefU, BcoefV)
1818 ELSE ! (iflag_split .eq.0)
1819 CALL climb_wind_down(knon, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, &
1820 !!! nrlmd le 02/05/2011
1821 CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
1822 Kcoef_m_x, alf_1_x, alf_2_x, &
1823 !!!
1824 AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x)
1825 !
1826 CALL climb_wind_down(knon, dtime, ycoefm_w, ypplay, ypaprs, yt_w, ydelp, yu_w, yv_w, &
1827 !!! nrlmd le 02/05/2011
1828 CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
1829 Kcoef_m_w, alf_1_w, alf_2_w, &
1830 !!!
1831 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w)
1832 !!!
1833 ENDIF ! (iflag_split .eq.0)
1834 !!!
1835
1836 !****************************************************************************************
1837 ! 9) Small calculations
1838 !
1839 !****************************************************************************************
1840
1841 ! - Reference pressure is given the values at surface level
1842
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 ypsref(:) = ypaprs(:,1)
1843
1844 ! - CO2 field on 2D grid to be sent to ORCHIDEE
1845 ! Transform to compressed field
1846
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (carbon_cycle_cpl) THEN
1847 DO i=1,knon
1848 r_co2_ppm(i) = co2_send(ni(i))
1849 ENDDO
1850 ELSE
1851
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 r_co2_ppm(:) = co2_ppm ! Constant field
1852 ENDIF
1853
1854 !!! nrlmd le 02/05/2011 -----------------------On raccorde les 2 colonnes dans la couche 1
1855 !----------------------------------------------------------------------------------------
1856 !!! jyg le 07/02/2012
1857 !!! jyg le 01/02/2017
1858
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq. 0) THEN
1859
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 yt1(:) = yt(:,1)
1860
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 yq1(:) = yq(:,1)
1861 ELSE IF (iflag_split .ge. 1) THEN
1862 !
1863 ! Cdragq computation
1864 ! ------------------
1865 !******************************************************************************
1866 ! Cdragq computed from cdrag
1867 ! The difference comes only from a factor (f_z0qh_oce) on z0, so that
1868 ! it can be computed inside wx_pbl0_merge
1869 ! More complicated appraches may require the propagation through
1870 ! pbl_surface of an independant cdragq variable.
1871 !******************************************************************************
1872 !
1873 IF ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce) THEN
1874 ! Si on suit les formulations par exemple de Tessel, on
1875 ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
1876 !! ycdragq_x(1:knon)=ycdragh_x(1:knon)* &
1877 !! log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
1878 !! ycdragq_w(1:knon)=ycdragh_w(1:knon)* &
1879 !! log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
1880 !
1881 DO j = 1,knon
1882 z1lay = zgeo1(j)/RG
1883 fact_cdrag = log(z1lay/yz0h(j))/log(z1lay/(f_z0qh_oce*yz0h(j)))
1884 ycdragq_x(j)=ycdragh_x(j)*fact_cdrag
1885 ycdragq_w(j)=ycdragh_w(j)*fact_cdrag
1886 !! Print *,'YYYYpbl0: fact_cdrag ', fact_cdrag
1887 ENDDO ! j = 1,knon
1888 !
1889 !! Print *,'YYYYpbl0: z1lay, yz0h, f_z0qh_oce, ycdragh_w, ycdragq_w ', &
1890 !! z1lay, yz0h(1:knon), f_z0qh_oce, ycdragh_w(1:knon), ycdragq_w(1:knon)
1891 ELSE
1892 ycdragq_x(1:knon)=ycdragh_x(1:knon)
1893 ycdragq_w(1:knon)=ycdragh_w(1:knon)
1894 ENDIF ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
1895 !
1896 CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s, &
1897 yts, y_delta_tsurf, ygustiness, &
1898 yt_x, yt_w, yq_x, yq_w, &
1899 yu_x, yu_w, yv_x, yv_w, &
1900 ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
1901 ycdragm_x, ycdragm_w, &
1902 AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
1903 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
1904 BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
1905 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
1906 Kech_h_x, Kech_h_w, Kech_h &
1907 )
1908 CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta, &
1909 BcoefQ_x, BcoefQ_w &
1910 )
1911 CALL wx_pbl0_merge(knon, ypplay, ypaprs, &
1912 ywake_s, ydTs0, ydqs0, &
1913 yt_x, yt_w, yq_x, yq_w, &
1914 yu_x, yu_w, yv_x, yv_w, &
1915 ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
1916 ycdragm_x, ycdragm_w, &
1917 AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
1918 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
1919 BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
1920 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
1921 AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
1922 BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
1923 ycdragh, ycdragq, ycdragm, &
1924 yt1, yq1, yu1, yv1 &
1925 )
1926 IF (iflag_split .eq. 2 .AND. nsrf .ne. is_oce) THEN
1927 CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
1928 ywake_s, ybeta, ywake_cstar, ywake_dens, &
1929 AcoefH_x, AcoefH_w, &
1930 BcoefH_x, BcoefH_w, &
1931 AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
1932 AcoefH, AcoefQ, BcoefH, BcoefQ, &
1933 HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
1934 phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
1935 yg_T, yg_Q, &
1936 yGamma_dTs_phiT, yGamma_dQs_phiQ, &
1937 ydTs_ins, ydqs_ins &
1938 )
1939 ELSE !
1940 AcoefH(:) = AcoefH_0(:)
1941 AcoefQ(:) = AcoefQ_0(:)
1942 BcoefH(:) = BcoefH_0(:)
1943 BcoefQ(:) = BcoefQ_0(:)
1944 yg_T(:) = 0.
1945 yg_Q(:) = 0.
1946 yGamma_dTs_phiT(:) = 0.
1947 yGamma_dQs_phiQ(:) = 0.
1948 ydTs_ins(:) = 0.
1949 ydqs_ins(:) = 0.
1950 ENDIF ! (iflag_split .eq. 2)
1951 ENDIF ! (iflag_split .eq.0)
1952 !!!
1953
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) THEN
1954 PRINT *,'pbl_surface (merge->): yt(1,:) ',yt(1,:)
1955 PRINT *,'pbl_surface (merge->): yq(1,:) ',yq(1,:)
1956 PRINT *,'pbl_surface (merge->): yu(1,:) ',yu(1,:)
1957 PRINT *,'pbl_surface (merge->): yv(1,:) ',yv(1,:)
1958 PRINT *,'pbl_surface (merge->): AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1) ', &
1959 AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1)
1960 PRINT *,'pbl_surface (merge->): BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1) ', &
1961 BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1)
1962
1963 ENDIF
1964
1965 ! Save initial value of z0h for use in evappot (z0h wiil be computed again in the surface models)
1966
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 yz0h_old(1:knon) = yz0h(1:knon)
1967 !
1968 !****************************************************************************************
1969 !
1970 ! Calulate t2m and q2m for the case of calculation at land grid points
1971 ! t2m and q2m are needed as input to ORCHIDEE
1972 !
1973 !****************************************************************************************
1974
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 1440 times.
1920 IF (nsrf == is_ter) THEN
1975
1976
2/2
✓ Branch 0 taken 247680 times.
✓ Branch 1 taken 480 times.
248160 DO i = 1, knon
1977 zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
1978 480 * (ypaprs(i,1)-ypplay(i,1))
1979 ENDDO
1980
1981 ! Calculate the temperature et relative humidity at 2m and the wind at 10m
1982
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_new_t2mq2m==1) THEN
1983 CALL stdlevvarn(klon, knon, is_ter, zxli, &
1984 yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
1985 yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
1986 yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
1987
1/2
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
480 yn2mout(:, nsrf, :))
1988 ELSE
1989 CALL stdlevvar(klon, knon, is_ter, zxli, &
1990 yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
1991 yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
1992 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
1993 ENDIF
1994
1995 ENDIF
1996
1997 !****************************************************************************************
1998 !
1999 ! 10) Switch according to current surface
2000 ! It is necessary to start with the continental surfaces because the ocean
2001 ! needs their run-off.
2002 !
2003 !****************************************************************************************
2004 480 SELECT CASE(nsrf)
2005
2006 CASE(is_ter)
2007 ! print*,"DEBUGTS",yts(knon/2),ylwdown(knon/2)
2008 CALL surf_land(itap, dtime, date0, jour, knon, ni,&
2009 rlon, rlat, yrmu0, &
2010 debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
2011 !!jyg yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
2012 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
2013 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2014 AcoefU, AcoefV, BcoefU, BcoefV, &
2015 ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
2016 ylwdown, yq2m, yt2m, &
2017 ysnow, yqsol, yagesno, ytsoil, &
2018 yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
2019 yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
2020 y_flux_u1, y_flux_v1, &
2021 480 yveget,ylai,yheight )
2022
2023 !FC quid qd yveget ylai yheight ne sont pas definit
2024 !FC yveget,ylai,yheight, &
2025 480 IF (ifl_pbltree .ge. 1) THEN
2026 CALL freinage(knon, yu, yv, yt, &
2027 ! yveget,ylai, yheight,ypaprs,ypplay,y_d_u_frein,y_d_v_frein)
2028 yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
2029 ENDIF
2030
2031
2032 ! Special DICE MPL 05082013 puis BOMEX
2033 960 IF (ok_prescr_ust) THEN
2034 DO j=1,knon
2035 ! ysnow(:)=0.
2036 ! yqsol(:)=0.
2037 ! yagesno(:)=50.
2038 ! ytsoil(:,:)=300.
2039 ! yz0_new(:)=0.001
2040 ! yevap(:)=flat/RLVTT
2041 ! yfluxlat(:)=-flat
2042 ! yfluxsens(:)=-fsens
2043 ! yqsurf(:)=0.
2044 ! ytsurf_new(:)=tg
2045 ! y_dflux_t(:)=0.
2046 ! y_dflux_q(:)=0.
2047 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
2048 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
2049 ENDDO
2050 ENDIF
2051
2052 CASE(is_lic)
2053 ! Martin
2054 CALL surf_landice(itap, dtime, knon, ni, &
2055 rlon, rlat, debut, lafin, &
2056 yrmu0, ylwdown, yalb, zgeo1, &
2057 ysolsw, ysollw, yts, ypplay(:,1), &
2058 !!jyg ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
2059 ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
2060 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2061 AcoefU, AcoefV, BcoefU, BcoefV, &
2062 ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
2063 ysnow, yqsurf, yqsol, yagesno, &
2064 ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
2065 ytsurf_new, y_dflux_t, y_dflux_q, &
2066 yzmea, yzsig, ycldt, &
2067 ysnowhgt, yqsnow, ytoice, ysissnow, &
2068 yalb3_new, yrunoff, &
2069 480 y_flux_u1, y_flux_v1)
2070
2071 !jyg<
2072 !! alb3_lic(:)=0.
2073 !>jyg
2074
2/2
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 480 times.
73440 DO j = 1, knon
2075 72960 i = ni(j)
2076 72960 alb3_lic(i) = yalb3_new(j)
2077 72960 snowhgt(i) = ysnowhgt(j)
2078 72960 qsnow(i) = yqsnow(j)
2079 72960 to_ice(i) = ytoice(j)
2080 72960 sissnow(i) = ysissnow(j)
2081 73440 runoff(i) = yrunoff(j)
2082 ENDDO
2083 ! Martin
2084 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
2085 960 IF (ok_prescr_ust) THEN
2086 DO j=1,knon
2087 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
2088 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
2089 ENDDO
2090 ENDIF
2091
2092 CASE(is_oce)
2093 CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
2094 ywindsp, rmu0, yfder, yts, &
2095 itap, dtime, jour, knon, ni, &
2096 !!jyg ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
2097 ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& ! ym missing init
2098 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2099 AcoefU, AcoefV, BcoefU, BcoefV, &
2100 ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
2101 ysnow, yqsurf, yagesno, &
2102 yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
2103 ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
2104 y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
2105 yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
2106
3/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 362977 times.
✓ Branch 3 taken 480 times.
363457 ytkt(:knon), ytks(:knon), ytaur(:knon), ysss)
2107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level >=10) THEN
2108 print *,'arg de surf_ocean: ycdragh ',ycdragh
2109 print *,'arg de surf_ocean: ycdragm ',ycdragm
2110 print *,'arg de surf_ocean: yt ', yt
2111 print *,'arg de surf_ocean: yq ', yq
2112 print *,'arg de surf_ocean: yts ', yts
2113 print *,'arg de surf_ocean: AcoefH ',AcoefH
2114 print *,'arg de surf_ocean: AcoefQ ',AcoefQ
2115 print *,'arg de surf_ocean: BcoefH ',BcoefH
2116 print *,'arg de surf_ocean: BcoefQ ',BcoefQ
2117 print *,'arg de surf_ocean: yevap ',yevap
2118 print *,'arg de surf_ocean: yfluxsens ',yfluxsens
2119 print *,'arg de surf_ocean: yfluxlat ',yfluxlat
2120 print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new
2121 ENDIF
2122 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
2123 960 IF (ok_prescr_ust) THEN
2124 DO j=1,knon
2125 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
2126 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
2127 ENDDO
2128 ENDIF
2129
2130 CASE(is_sic)
2131 CALL surf_seaice( &
2132 !albedo SB >>>
2133 rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
2134 !albedo SB <<<
2135 itap, dtime, jour, knon, ni, &
2136 lafin, &
2137 !!jyg yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
2138 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
2139 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2140 AcoefU, AcoefV, BcoefU, BcoefV, &
2141 ypsref, yu1, yv1, ygustiness, pctsrf, &
2142 ysnow, yqsurf, yqsol, yagesno, ytsoil, &
2143 !albedo SB >>>
2144 yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
2145 !albedo SB <<<
2146 ytsurf_new, y_dflux_t, y_dflux_q, &
2147 480 y_flux_u1, y_flux_v1)
2148
2149 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
2150 480 IF (ok_prescr_ust) THEN
2151 DO j=1,knon
2152 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
2153 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
2154 ENDDO
2155 ENDIF
2156
2157 CASE DEFAULT
2158 WRITE(lunout,*) 'Surface index = ', nsrf
2159 abort_message = 'Surface index not valid'
2160
4/5
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 480 times.
✓ Branch 3 taken 480 times.
✗ Branch 4 not taken.
1920 CALL abort_physic(modname,abort_message,1)
2161 END SELECT
2162
2163
2164 !****************************************************************************************
2165 ! 11) - Calcul the increment of surface temperature
2166 !
2167 !****************************************************************************************
2168
2169 1920 IF (evap0>=0.) THEN
2170 yevap(:)=evap0
2171 yevap(:)=RLVTT*evap0
2172 ENDIF
2173
2174
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 y_d_ts(1:knon) = ytsurf_new(1:knon) - yts(1:knon)
2175
2176 !****************************************************************************************
2177 !
2178 ! 12) "La remontee" - "The uphill"
2179 !
2180 ! The fluxes (y_flux_X) and tendancy (y_d_X) are calculated
2181 ! for X=H, Q, U and V, for all vertical levels.
2182 !
2183 !****************************************************************************************
2184 !!
2185 !!!
2186 !!! jyg le 10/04/2013 et EV 10/2020
2187
2188 1920 IF (ok_forc_tsurf) THEN
2189 DO j=1,knon
2190 ytsurf_new(j)=tg
2191 y_d_ts(j) = ytsurf_new(j) - yts(j)
2192 ENDDO
2193 ENDIF ! ok_forc_tsurf
2194
2195 !!!
2196 1920 IF (ok_flux_surf) THEN
2197 IF (prt_level >=10) THEN
2198 PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
2199 ENDIF
2200 y_flux_t1(:) = fsens
2201 y_flux_q1(:) = flat/RLVTT
2202 yfluxlat(:) = flat
2203 !
2204 !! Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg)
2205 !! IF (iflag_split .eq.0) THEN
2206 DO j=1,knon
2207 Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)**2+yv(j,1)**2)) * &
2208 ypplay(j,1)/(RD*yt(j,1))
2209 ENDDO
2210 !! ENDIF ! (iflag_split .eq.0)
2211
2212 DO j = 1, knon
2213 yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*y_flux_t1(j)*dtime)
2214 ytsurf_new(j)=yt1_new-y_flux_t1(j)/(Kech_h(j)*RCPD)
2215 ENDDO
2216
2217 DO j=1,knon
2218 y_d_ts(j) = ytsurf_new(j) - yts(j)
2219 ENDDO
2220
2221 ELSE ! (ok_flux_surf)
2222
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 788452 times.
790372 DO j=1,knon
2223 788452 y_flux_t1(j) = yfluxsens(j)
2224 790372 y_flux_q1(j) = -yevap(j)
2225 ENDDO
2226 ENDIF ! (ok_flux_surf)
2227 !
2228 ! ------------------------------------------------------------------------------
2229 ! 12a) Splitting
2230 ! ------------------------------------------------------------------------------
2231
2232
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (iflag_split .GE. 1) THEN
2233 !
2234 IF (nsrf .ne. is_oce) THEN
2235 !
2236 ! Compute potential evaporation and aridity factor (jyg, 20200328)
2237 ybeta_prev(:) = ybeta(:)
2238 DO j = 1, knon
2239 yqa(j) = AcoefQ(j) - BcoefQ(j)*yevap(j)*dtime
2240 ENDDO
2241 !
2242 CALL wx_evappot(knon, yqa, yTsurf_new, yevap_pot)
2243 !
2244 ybeta(1:knon) = min(yevap(1:knon)/yevap_pot(1:knon), 1.)
2245
2246 IF (prt_level >=10) THEN
2247 DO j=1,knon
2248 print*,'y_flux_t1,yfluxlat,wakes' &
2249 & , y_flux_t1(j), yfluxlat(j), ywake_s(j)
2250 print*,'beta_prev, beta, ytsurf_new', ybeta_prev(j), ybeta(j), ytsurf_new(j)
2251 print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
2252 ENDDO
2253 ENDIF ! (prt_level >=10)
2254 !
2255 ! Second call to wx_pbl0_merge and wx_pbl_dts_merge in order to take into account
2256 ! the update of the aridity coeficient beta.
2257 !
2258 CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta, &
2259 BcoefQ_x, BcoefQ_w &
2260 )
2261 CALL wx_pbl0_merge(knon, ypplay, ypaprs, &
2262 ywake_s, ydTs0, ydqs0, &
2263 yt_x, yt_w, yq_x, yq_w, &
2264 yu_x, yu_w, yv_x, yv_w, &
2265 ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
2266 ycdragm_x, ycdragm_w, &
2267 AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
2268 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
2269 BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
2270 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
2271 AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
2272 BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
2273 ycdragh, ycdragq, ycdragm, &
2274 yt1, yq1, yu1, yv1 &
2275 )
2276 IF (iflag_split .eq. 2) THEN
2277 CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
2278 ywake_s, ybeta, ywake_cstar, ywake_dens, &
2279 AcoefH_x, AcoefH_w, &
2280 BcoefH_x, BcoefH_w, &
2281 AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
2282 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2283 HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
2284 phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
2285 yg_T, yg_Q, &
2286 yGamma_dTs_phiT, yGamma_dQs_phiQ, &
2287 ydTs_ins, ydqs_ins &
2288 )
2289 ELSE !
2290 AcoefH(:) = AcoefH_0(:)
2291 AcoefQ(:) = AcoefQ_0(:)
2292 BcoefH(:) = BcoefH_0(:)
2293 BcoefQ(:) = BcoefQ_0(:)
2294 yg_T(:) = 0.
2295 yg_Q(:) = 0.
2296 yGamma_dTs_phiT(:) = 0.
2297 yGamma_dQs_phiQ(:) = 0.
2298 ydTs_ins(:) = 0.
2299 ydqs_ins(:) = 0.
2300 ENDIF ! (iflag_split .eq. 2)
2301 !
2302 ELSE ! (nsrf .ne. is_oce)
2303 ybeta(1:knon) = 1.
2304 yevap_pot(1:knon) = yevap(1:knon)
2305 AcoefH(:) = AcoefH_0(:)
2306 AcoefQ(:) = AcoefQ_0(:)
2307 BcoefH(:) = BcoefH_0(:)
2308 BcoefQ(:) = BcoefQ_0(:)
2309 yg_T(:) = 0.
2310 yg_Q(:) = 0.
2311 yGamma_dTs_phiT(:) = 0.
2312 yGamma_dQs_phiQ(:) = 0.
2313 ydTs_ins(:) = 0.
2314 ydqs_ins(:) = 0.
2315 ENDIF ! (nsrf .ne. is_oce)
2316 !
2317 CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, &
2318 yg_T, yg_Q, &
2319 yGamma_dTs_phiT, yGamma_dQs_phiQ, &
2320 ydTs_ins, ydqs_ins, &
2321 y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
2322 !!!! HTRn_b, dd_HTRn, HTphiT_b, dd_HTphiT, &
2323 phiQ0_b, phiT0_b, &
2324 y_flux_t1_x, y_flux_t1_w, &
2325 y_flux_q1_x, y_flux_q1_w, &
2326 y_flux_u1_x, y_flux_u1_w, &
2327 y_flux_v1_x, y_flux_v1_w, &
2328 yfluxlat_x, yfluxlat_w, &
2329 y_delta_qsats, &
2330 y_delta_tsurf_new, y_delta_qsurf &
2331 )
2332 !
2333 CALL wx_pbl_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
2334 yTs, y_delta_tsurf, &
2335 yqsurf, yTsurf_new, &
2336 y_delta_tsurf_new, y_delta_qsats, &
2337 AcoefH_x, AcoefH_w, &
2338 BcoefH_x, BcoefH_w, &
2339 AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
2340 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2341 y_flux_t1, y_flux_q1, &
2342 y_flux_t1_x, y_flux_t1_w, &
2343 y_flux_q1_x, y_flux_q1_w)
2344 !
2345 IF (nsrf .ne. is_oce) THEN
2346 CALL wx_pbl_dts_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
2347 yTs, y_delta_tsurf, &
2348 yqsurf, yTsurf_new, &
2349 y_delta_qsats, y_delta_tsurf_new, y_delta_qsurf, &
2350 AcoefH_x, AcoefH_w, &
2351 BcoefH_x, BcoefH_w, &
2352 AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
2353 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2354 HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
2355 phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
2356 yg_T, yg_Q, &
2357 yGamma_dTs_phiT, yGamma_dQs_phiQ, &
2358 ydTs_ins, ydqs_ins, &
2359 y_flux_t1, y_flux_q1, &
2360 y_flux_t1_x, y_flux_t1_w, &
2361 y_flux_q1_x, y_flux_q1_w )
2362 ENDIF ! (nsrf .ne. is_oce)
2363 !
2364 ELSE ! (iflag_split .ge. 1)
2365
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 ybeta(1:knon) = 1.
2366
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 yevap_pot(1:knon) = yevap(1:knon)
2367 ENDIF ! (iflag_split .ge. 1)
2368 !
2369
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >= 10) THEN
2370 print *,'pbl_surface, ybeta , yevap, yevap_pot ', &
2371 ybeta , yevap, yevap_pot
2372 ENDIF ! (prt_level >= 10)
2373 !
2374 !>jyg
2375 !
2376
2377 !!jyg!! A reprendre apres reflexion ===============================================
2378 !!jyg!!
2379 !!jyg!! DO j=1,knon
2380 !!jyg!!!!! nrlmd le 13/06/2011
2381 !!jyg!!
2382 !!jyg!!!----Diffusion dans le sol dans le cas continental seulement
2383 !!jyg!! IF (nsrf.eq.is_ter) THEN
2384 !!jyg!!!----Calcul du coefficient delta_coeff
2385 !!jyg!! tau_eq(j)=(ywake_s(j)/2.)*(1./max(wake_cstar(j),0.01))*sqrt(0.4/(3.14*max(wake_dens(j),8e-12)))
2386 !!jyg!!
2387 !!jyg!!! delta_coef(j)=dtime/(inertia*sqrt(tau_eq(j)))
2388 !!jyg!! delta_coef(j)=facteur*sqrt(tau_eq(j))/inertia
2389 !!jyg!!! delta_coef(j)=0.
2390 !!jyg!! ELSE
2391 !!jyg!! delta_coef(j)=0.
2392 !!jyg!! ENDIF
2393 !!jyg!!
2394 !!jyg!!!----Calcul de delta_tsurf
2395 !!jyg!! y_delta_tsurf(j)=delta_coef(j)*y_delta_flux_t1(j)
2396 !!jyg!!
2397 !!jyg!!!----Si il n'y a pas des poches...
2398 !!jyg!! IF (wake_cstar(j).le.0.01) THEN
2399 !!jyg!! y_delta_tsurf(j)=0.
2400 !!jyg!! y_delta_flux_t1(j)=0.
2401 !!jyg!! ENDIF
2402 !!jyg!!
2403 !!jyg!!!-----Calcul de ybeta (evap_r\'eelle/evap_potentielle)
2404 !!jyg!!!!!!! jyg le 23/02/2012
2405 !!jyg!!!!!!!
2406 !!jyg!!!! ybeta(j)=y_flux_q1(j) / &
2407 !!jyg!!!! & (Kech_h(j)*(yq(j,1)-yqsatsurf(j)))
2408 !!jyg!!!!!! ybeta(j)=-1.*yevap(j) / &
2409 !!jyg!!!!!! & (ywake_s(j)*Kech_h_w(j)*(yq_w(j,1)-yqsatsurf_w(j))+(1.-ywake_s(j))*Kech_h_x(j)*(yq_x(j,1)-yqsatsurf_x(j)))
2410 !!jyg!!!!!!! fin jyg
2411 !!jyg!!!!!
2412 !!jyg!!
2413 !!jyg!! ENDDO
2414 !!jyg!!
2415 !!jyg!!!!! fin nrlmd le 13/06/2011
2416 !!jyg!!
2417
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (iflag_split .ge. 1) THEN
2418 IF (prt_level >=10) THEN
2419 DO j = 1, knon
2420 print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j)
2421 print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j)
2422 print*,'t1x, t1w, t1, t1_ancien', &
2423 & yt_x(j,1), yt_w(j,1), yt(j,1), t(j,1)
2424 print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j)
2425 ENDDO
2426
2427 DO j=1,knon
2428 print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' &
2429 & , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)*RLVTT, y_flux_q1_w(j)*RLVTT, yfluxlat(j), ywake_s(j)
2430 print*,'beta, ytsurf_new ', ybeta(j), ytsurf_new(j)
2431 print*,'inertia, facteur, cstar', inertia, facteur,wake_cstar(j)
2432 ENDDO
2433 ENDIF ! (prt_level >=10)
2434
2435 !!! jyg le 07/02/2012
2436 ENDIF ! (iflag_split .ge.1)
2437 !!!
2438
2439 !!! jyg le 07/02/2012
2440
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
2441 !!!
2442 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
2443 CALL climb_hq_up(knon, dtime, yt, yq, &
2444 y_flux_q1, y_flux_t1, ypaprs, ypplay, &
2445 !!! jyg le 07/02/2012
2446 AcoefH, AcoefQ, BcoefH, BcoefQ, &
2447 CcoefH, CcoefQ, DcoefH, DcoefQ, &
2448 Kcoef_hq, gama_q, gama_h, &
2449 !!!
2450 1920 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:))
2451 ELSE !(iflag_split .eq.0)
2452 CALL climb_hq_up(knon, dtime, yt_x, yq_x, &
2453 y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, &
2454 !!! nrlmd le 02/05/2011
2455 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x, &
2456 CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
2457 Kcoef_hq_x, gama_q_x, gama_h_x, &
2458 !!!
2459 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:))
2460 !
2461 CALL climb_hq_up(knon, dtime, yt_w, yq_w, &
2462 y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, &
2463 !!! nrlmd le 02/05/2011
2464 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w, &
2465 CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
2466 Kcoef_hq_w, gama_q_w, gama_h_w, &
2467 !!!
2468 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:))
2469 !!!
2470 ENDIF ! (iflag_split .eq.0)
2471 !!!
2472
2473 !!! jyg le 07/02/2012
2474
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
2475 !!!
2476 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
2477 CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, &
2478 !!! jyg le 07/02/2012
2479 AcoefU, AcoefV, BcoefU, BcoefV, &
2480 CcoefU, CcoefV, DcoefU, DcoefV, &
2481 Kcoef_m, &
2482 !!!
2483 1920 y_flux_u, y_flux_v, y_d_u, y_d_v)
2484
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 y_d_t_diss(:,:)=0.
2485 1920 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
2486 CALL yamada_c(knon,dtime,ypaprs,ypplay &
2487 & ,yu,yv,yt,y_d_u,y_d_v,y_d_t,ycdragm,ytke,ycoefm,ycoefh,ycoefq,y_d_t_diss,yustar &
2488 & ,iflag_pbl)
2489 ENDIF
2490 ! print*,'yamada_c OK'
2491
2492 ELSE !(iflag_split .eq.0)
2493 CALL climb_wind_up(knon, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, &
2494 !!! nrlmd le 02/05/2011
2495 AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, &
2496 CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
2497 Kcoef_m_x, &
2498 !!!
2499 y_flux_u_x, y_flux_v_x, y_d_u_x, y_d_v_x)
2500 !
2501 y_d_t_diss_x(:,:)=0.
2502 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
2503 CALL yamada_c(knon,dtime,ypaprs,ypplay &
2504 & ,yu_x,yv_x,yt_x,y_d_u_x,y_d_v_x,y_d_t_x,ycdragm_x,ytke_x,ycoefm_x,ycoefh_x &
2505 ,ycoefq_x,y_d_t_diss_x,yustar_x &
2506 & ,iflag_pbl)
2507 ENDIF
2508 ! print*,'yamada_c OK'
2509
2510 CALL climb_wind_up(knon, dtime, yu_w, yv_w, y_flux_u1_w, y_flux_v1_w, &
2511 !!! nrlmd le 02/05/2011
2512 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w, &
2513 CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
2514 Kcoef_m_w, &
2515 !!!
2516 y_flux_u_w, y_flux_v_w, y_d_u_w, y_d_v_w)
2517 !!!
2518 y_d_t_diss_w(:,:)=0.
2519 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
2520 CALL yamada_c(knon,dtime,ypaprs,ypplay &
2521 & ,yu_w,yv_w,yt_w,y_d_u_w,y_d_v_w,y_d_t_w,ycdragm_w,ytke_w,ycoefm_w,ycoefh_w &
2522 ,ycoefq_w,y_d_t_diss_w,yustar_w &
2523 & ,iflag_pbl)
2524 ENDIF
2525 ! print*,'yamada_c OK'
2526 !
2527 IF (prt_level >=10) THEN
2528 print *, 'After climbing up, lfuxlat_x, fluxlat_w ', &
2529 yfluxlat_x, yfluxlat_w
2530 ENDIF
2531 !
2532 ENDIF ! (iflag_split .eq.0)
2533 !!!
2534 !!
2535 !! DO j = 1, knon
2536 !! y_dflux_t(j) = y_dflux_t(j) * ypct(j)
2537 !! y_dflux_q(j) = y_dflux_q(j) * ypct(j)
2538 !! ENDDO
2539 !!
2540 !****************************************************************************************
2541 ! 13) Transform variables for output format :
2542 ! - Decompress
2543 ! - Multiply with pourcentage of current surface
2544 ! - Cumulate in global variable
2545 !
2546 !****************************************************************************************
2547
2548
2549 !!! jyg le 07/02/2012
2550
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split.EQ.0) THEN
2551 !!!
2552
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
76800 DO k = 1, klev
2553
2/2
✓ Branch 0 taken 30749628 times.
✓ Branch 1 taken 74880 times.
30826428 DO j = 1, knon
2554 30749628 i = ni(j)
2555 30749628 y_d_t_diss(j,k) = y_d_t_diss(j,k) * ypct(j)
2556 30749628 y_d_t(j,k) = y_d_t(j,k) * ypct(j)
2557 30749628 y_d_q(j,k) = y_d_q(j,k) * ypct(j)
2558 30749628 y_d_u(j,k) = y_d_u(j,k) * ypct(j)
2559 30749628 y_d_v(j,k) = y_d_v(j,k) * ypct(j)
2560 !FC
2561
2/2
✓ Branch 0 taken 9659520 times.
✓ Branch 1 taken 21090108 times.
30749628 IF (nsrf .EQ. is_ter .and. ifl_pbltree .GE. 1) THEN
2562 ! if (y_d_u_frein(j,k).ne.0. ) then
2563 ! print*, nsrf,'IS_TER ++', y_d_u_frein(j,k)*ypct(j),y_d_u(j,k),j,k
2564 ! ENDIF
2565 y_d_u(j,k) =y_d_u(j,k) + y_d_u_frein(j,k)*ypct(j)
2566 y_d_v(j,k) =y_d_v(j,k) + y_d_v_frein(j,k)*ypct(j)
2567 treedrg(i,k,nsrf)=y_treedrg(j,k)
2568 ELSE
2569 30749628 treedrg(i,k,nsrf)=0.
2570 ENDIF
2571 !FC
2572 30749628 flux_t(i,k,nsrf) = y_flux_t(j,k)
2573 30749628 flux_q(i,k,nsrf) = y_flux_q(j,k)
2574 30749628 flux_u(i,k,nsrf) = y_flux_u(j,k)
2575 30824508 flux_v(i,k,nsrf) = y_flux_v(j,k)
2576 ENDDO
2577 ENDDO
2578
2579 ELSE !(iflag_split .eq.0)
2580
2581 ! Tendances hors poches
2582 DO k = 1, klev
2583 DO j = 1, knon
2584 i = ni(j)
2585 y_d_t_diss_x(j,k) = y_d_t_diss_x(j,k) * ypct(j)
2586 y_d_t_x(j,k) = y_d_t_x(j,k) * ypct(j)
2587 y_d_q_x(j,k) = y_d_q_x(j,k) * ypct(j)
2588 y_d_u_x(j,k) = y_d_u_x(j,k) * ypct(j)
2589 y_d_v_x(j,k) = y_d_v_x(j,k) * ypct(j)
2590
2591 flux_t_x(i,k,nsrf) = y_flux_t_x(j,k)
2592 flux_q_x(i,k,nsrf) = y_flux_q_x(j,k)
2593 flux_u_x(i,k,nsrf) = y_flux_u_x(j,k)
2594 flux_v_x(i,k,nsrf) = y_flux_v_x(j,k)
2595 ENDDO
2596 ENDDO
2597
2598 ! Tendances dans les poches
2599 DO k = 1, klev
2600 DO j = 1, knon
2601 i = ni(j)
2602 y_d_t_diss_w(j,k) = y_d_t_diss_w(j,k) * ypct(j)
2603 y_d_t_w(j,k) = y_d_t_w(j,k) * ypct(j)
2604 y_d_q_w(j,k) = y_d_q_w(j,k) * ypct(j)
2605 y_d_u_w(j,k) = y_d_u_w(j,k) * ypct(j)
2606 y_d_v_w(j,k) = y_d_v_w(j,k) * ypct(j)
2607
2608 flux_t_w(i,k,nsrf) = y_flux_t_w(j,k)
2609 flux_q_w(i,k,nsrf) = y_flux_q_w(j,k)
2610 flux_u_w(i,k,nsrf) = y_flux_u_w(j,k)
2611 flux_v_w(i,k,nsrf) = y_flux_v_w(j,k)
2612 ENDDO
2613 ENDDO
2614
2615 ! Flux, tendances et Tke moyenne dans la maille
2616 DO k = 1, klev
2617 DO j = 1, knon
2618 i = ni(j)
2619 flux_t(i,k,nsrf) = flux_t_x(i,k,nsrf)+ywake_s(j)*(flux_t_w(i,k,nsrf)-flux_t_x(i,k,nsrf))
2620 flux_q(i,k,nsrf) = flux_q_x(i,k,nsrf)+ywake_s(j)*(flux_q_w(i,k,nsrf)-flux_q_x(i,k,nsrf))
2621 flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf))
2622 flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf))
2623 ENDDO
2624 ENDDO
2625 DO j=1,knon
2626 yfluxlat(j)=yfluxlat_x(j)+ywake_s(j)*(yfluxlat_w(j)-yfluxlat_x(j))
2627 ENDDO
2628 IF (prt_level >=10) THEN
2629 print *,' nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) ', &
2630 nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf)
2631 ENDIF
2632
2633 DO k = 1, klev
2634 DO j = 1, knon
2635 y_d_t_diss(j,k) = y_d_t_diss_x(j,k)+ywake_s(j)*(y_d_t_diss_w(j,k) -y_d_t_diss_x(j,k))
2636 y_d_t(j,k) = y_d_t_x(j,k)+ywake_s(j)*(y_d_t_w(j,k) -y_d_t_x(j,k))
2637 y_d_q(j,k) = y_d_q_x(j,k)+ywake_s(j)*(y_d_q_w(j,k) -y_d_q_x(j,k))
2638 y_d_u(j,k) = y_d_u_x(j,k)+ywake_s(j)*(y_d_u_w(j,k) -y_d_u_x(j,k))
2639 y_d_v(j,k) = y_d_v_x(j,k)+ywake_s(j)*(y_d_v_w(j,k) -y_d_v_x(j,k))
2640 ENDDO
2641 ENDDO
2642
2643 ENDIF ! (iflag_split .eq.0)
2644 !!!
2645
2646 ! print*,'Dans pbl OK1'
2647
2648 !jyg<
2649 !! evap(:,nsrf) = - flux_q(:,1,nsrf)
2650 !>jyg
2651
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 DO j = 1, knon
2652 788452 i = ni(j)
2653 788452 evap(i,nsrf) = - flux_q(i,1,nsrf) !jyg
2654 788452 beta(i,nsrf) = ybeta(j) !jyg
2655 788452 d_ts(i,nsrf) = y_d_ts(j)
2656 !albedo SB >>>
2657
2/2
✓ Branch 0 taken 4730712 times.
✓ Branch 1 taken 788452 times.
5519164 DO k=1,nsw
2658 4730712 alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
2659 5519164 alb_dif(i,k,nsrf) = yalb_dif_new(j,k)
2660 ENDDO
2661 !albedo SB <<<
2662 788452 snow(i,nsrf) = ysnow(j)
2663 788452 qsurf(i,nsrf) = yqsurf(j)
2664 788452 z0m(i,nsrf) = yz0m(j)
2665 788452 z0h(i,nsrf) = yz0h(j)
2666 788452 fluxlat(i,nsrf) = yfluxlat(j)
2667 788452 agesno(i,nsrf) = yagesno(j)
2668 788452 cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
2669 788452 cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
2670 788452 dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
2671 790372 dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
2672 ENDDO
2673
2674 ! print*,'Dans pbl OK2'
2675
2676 !!! jyg le 07/02/2012
2677
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (iflag_split .ge.1) THEN
2678 !!!
2679 !!! nrlmd le 02/05/2011
2680 DO j = 1, knon
2681 i = ni(j)
2682 fluxlat_x(i,nsrf) = yfluxlat_x(j)
2683 fluxlat_w(i,nsrf) = yfluxlat_w(j)
2684 !!!
2685 !!! nrlmd le 13/06/2011
2686 !!jyg20170131 delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j)
2687 !!jyg20210118 delta_tsurf(i,nsrf)=y_delta_tsurf(j)
2688 delta_tsurf(i,nsrf)=y_delta_tsurf_new(j)
2689 !
2690 delta_qsurf(i) = delta_qsurf(i) + y_delta_qsurf(j)*ypct(j)
2691 !
2692 cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
2693 cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j)
2694 cdragm_x(i) = cdragm_x(i) + ycdragm_x(j)*ypct(j)
2695 cdragm_w(i) = cdragm_w(i) + ycdragm_w(j)*ypct(j)
2696 kh(i) = kh(i) + Kech_h(j)*ypct(j)
2697 kh_x(i) = kh_x(i) + Kech_h_x(j)*ypct(j)
2698 kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j)
2699 !!!
2700 ENDDO
2701 !!!
2702 ENDIF ! (iflag_split .ge.1)
2703 !!!
2704 !!! nrlmd le 02/05/2011
2705 !!jyg le 20/02/2011
2706 !! tke_x(:,:,nsrf)=0.
2707 !! tke_w(:,:,nsrf)=0.
2708 !!jyg le 20/02/2011
2709 !! DO k = 1, klev+1
2710 !! DO j = 1, knon
2711 !! i = ni(j)
2712 !! wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
2713 !! tke(i,k,nsrf) = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf)
2714 !! ENDDO
2715 !! ENDDO
2716 !!jyg le 20/02/2011
2717 !! DO k = 1, klev+1
2718 !! DO j = 1, knon
2719 !! i = ni(j)
2720 !! tke(i,k,nsrf)=(1.-ywake_s(j))*tke_x(i,k,nsrf)+ywake_s(j)*tke_w(i,k,nsrf)
2721 !! ENDDO
2722 !! ENDDO
2723 !!!
2724
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
2725
4/4
✓ Branch 0 taken 76800 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 76339200 times.
✓ Branch 3 taken 76800 times.
76417920 wake_dltke(:,:,nsrf) = 0.
2726
2/2
✓ Branch 0 taken 76800 times.
✓ Branch 1 taken 1920 times.
78720 DO k = 1, klev+1
2727
2/2
✓ Branch 0 taken 31538080 times.
✓ Branch 1 taken 76800 times.
31616800 DO j = 1, knon
2728 31538080 i = ni(j)
2729 !jyg<
2730 !! tke(i,k,nsrf) = ytke(j,k)
2731 !! tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j)
2732 31538080 tke_x(i,k,nsrf) = ytke(j,k)
2733 31614880 tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
2734
2735 !>jyg
2736 ENDDO
2737 ENDDO
2738
2739 ELSE ! (iflag_split .eq.0)
2740 DO k = 1, klev+1
2741 DO j = 1, knon
2742 i = ni(j)
2743 wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
2744 !jyg<
2745 !! tke(i,k,nsrf) = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf)
2746 !! tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j)
2747 tke_x(i,k,nsrf) = ytke_x(j,k)
2748 tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)
2749 wake_dltke(i,k,is_ave) = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
2750
2751
2752 !>jyg
2753 ENDDO
2754 ENDDO
2755 ENDIF ! (iflag_split .eq.0)
2756 !!!
2757
2/2
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 1920 times.
74880 DO k = 2, klev
2758
2/2
✓ Branch 0 taken 29961176 times.
✓ Branch 1 taken 72960 times.
30036056 DO j = 1, knon
2759 29961176 i = ni(j)
2760 29961176 zcoefh(i,k,nsrf) = ycoefh(j,k)
2761 29961176 zcoefm(i,k,nsrf) = ycoefm(j,k)
2762 29961176 zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j)
2763 30034136 zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j)
2764 ENDDO
2765 ENDDO
2766
2767 ! print*,'Dans pbl OK3'
2768
2769
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 1440 times.
1920 IF ( nsrf .EQ. is_ter ) THEN
2770
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 247680 times.
248160 DO j = 1, knon
2771 247680 i = ni(j)
2772 248160 qsol(i) = yqsol(j)
2773 ENDDO
2774 ENDIF
2775
2776 !jyg<
2777 !! ftsoil(:,:,nsrf) = 0.
2778 !>jyg
2779
2/2
✓ Branch 0 taken 21120 times.
✓ Branch 1 taken 1920 times.
23040 DO k = 1, nsoilmx
2780
2/2
✓ Branch 0 taken 8672972 times.
✓ Branch 1 taken 21120 times.
8696012 DO j = 1, knon
2781 8672972 i = ni(j)
2782 8694092 ftsoil(i, k, nsrf) = ytsoil(j,k)
2783 ENDDO
2784 ENDDO
2785
2786 !!! jyg le 07/02/2012
2787
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (iflag_split .ge.1) THEN
2788 !!!
2789 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
2790 DO k = 1, klev
2791 DO j = 1, knon
2792 i = ni(j)
2793 d_t_diss_x(i,k) = d_t_diss_x(i,k) + y_d_t_diss_x(j,k)
2794 d_t_x(i,k) = d_t_x(i,k) + y_d_t_x(j,k)
2795 d_q_x(i,k) = d_q_x(i,k) + y_d_q_x(j,k)
2796 d_u_x(i,k) = d_u_x(i,k) + y_d_u_x(j,k)
2797 d_v_x(i,k) = d_v_x(i,k) + y_d_v_x(j,k)
2798 !
2799 d_t_diss_w(i,k) = d_t_diss_w(i,k) + y_d_t_diss_w(j,k)
2800 d_t_w(i,k) = d_t_w(i,k) + y_d_t_w(j,k)
2801 d_q_w(i,k) = d_q_w(i,k) + y_d_q_w(j,k)
2802 d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k)
2803 d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k)
2804 !
2805 !! d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k)
2806 !! d_wake_dlq(i,k) = d_wake_dlq(i,k) + y_d_q_w(i,k)-y_d_q_x(i,k)
2807 ENDDO
2808 ENDDO
2809 !!!
2810 ENDIF ! (iflag_split .ge.1)
2811 !!!
2812
2813
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
76800 DO k = 1, klev
2814
2/2
✓ Branch 0 taken 30749628 times.
✓ Branch 1 taken 74880 times.
30826428 DO j = 1, knon
2815 30749628 i = ni(j)
2816 30749628 d_t_diss(i,k) = d_t_diss(i,k) + y_d_t_diss(j,k)
2817 30749628 d_t(i,k) = d_t(i,k) + y_d_t(j,k)
2818 30749628 d_q(i,k) = d_q(i,k) + y_d_q(j,k)
2819 30749628 d_u(i,k) = d_u(i,k) + y_d_u(j,k)
2820 30824508 d_v(i,k) = d_v(i,k) + y_d_v(j,k)
2821 ENDDO
2822 ENDDO
2823
2824 ! print*,'Dans pbl OK4'
2825
2826
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) THEN
2827 print *, 'pbl_surface tendencies for w: d_t_w, d_t_x, d_t ', &
2828 d_t_w(:,1), d_t_x(:,1), d_t(:,1)
2829 ENDIF
2830
2831
3/4
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 1440 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
1920 if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
2832 delta_sal = missing_val
2833 ds_ns = missing_val
2834 dt_ns = missing_val
2835 delta_sst = missing_val
2836 dter = missing_val
2837 dser = missing_val
2838 tkt = missing_val
2839 tks = missing_val
2840 taur = missing_val
2841 sss = missing_val
2842
2843 delta_sal(ni(:knon)) = ydelta_sal(:knon)
2844 ds_ns(ni(:knon)) = yds_ns(:knon)
2845 dt_ns(ni(:knon)) = ydt_ns(:knon)
2846 delta_sst(ni(:knon)) = ydelta_sst(:knon)
2847 dter(ni(:knon)) = ydter(:knon)
2848 dser(ni(:knon)) = ydser(:knon)
2849 tkt(ni(:knon)) = ytkt(:knon)
2850 tks(ni(:knon)) = ytks(:knon)
2851 taur(ni(:knon)) = ytaur(:knon)
2852 sss(ni(:knon)) = ysss(:knon)
2853 end if
2854
2855
2856 !****************************************************************************************
2857 ! 14) Calculate the temperature and relative humidity at 2m and the wind at 10m
2858 ! Call HBTM
2859 !
2860 !****************************************************************************************
2861 !!!
2862 !
2863 ! Calculations of diagnostic t,q at 2m and u, v at 10m
2864
2865 ! print*,'Dans pbl OK41'
2866 ! print*,'tair1,yt(:,1),y_d_t(:,1)'
2867 ! print*, tair1,yt(:,1),y_d_t(:,1)
2868 !!! jyg le 07/02/2012
2869
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
2870
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 788452 times.
790372 DO j=1, knon
2871 788452 uzon(j) = yu(j,1) + y_d_u(j,1)
2872 788452 vmer(j) = yv(j,1) + y_d_v(j,1)
2873 788452 tair1(j) = yt(j,1) + y_d_t(j,1) + y_d_t_diss(j,1)
2874 788452 qair1(j) = yq(j,1) + y_d_q(j,1)
2875 zgeo1(j) = RD * tair1(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
2876 788452 * (ypaprs(j,1)-ypplay(j,1))
2877 788452 tairsol(j) = yts(j) + y_d_ts(j)
2878 1920 qairsol(j) = yqsurf(j)
2879 ENDDO
2880 ELSE ! (iflag_split .eq.0)
2881 DO j=1, knon
2882 uzon_x(j) = yu_x(j,1) + y_d_u_x(j,1)
2883 vmer_x(j) = yv_x(j,1) + y_d_v_x(j,1)
2884 tair1_x(j) = yt_x(j,1) + y_d_t_x(j,1) + y_d_t_diss_x(j,1)
2885 qair1_x(j) = yq_x(j,1) + y_d_q_x(j,1)
2886 zgeo1_x(j) = RD * tair1_x(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
2887 * (ypaprs(j,1)-ypplay(j,1))
2888 tairsol(j) = yts(j) + y_d_ts(j)
2889 !! tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
2890 tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf_new(j)
2891 qairsol(j) = yqsurf(j)
2892 ENDDO
2893 DO j=1, knon
2894 uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1)
2895 vmer_w(j) = yv_w(j,1) + y_d_v_w(j,1)
2896 tair1_w(j) = yt_w(j,1) + y_d_t_w(j,1) + y_d_t_diss_w(j,1)
2897 qair1_w(j) = yq_w(j,1) + y_d_q_w(j,1)
2898 zgeo1_w(j) = RD * tair1_w(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
2899 * (ypaprs(j,1)-ypplay(j,1))
2900 tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j)
2901 qairsol(j) = yqsurf(j)
2902 ENDDO
2903 !!!
2904 ENDIF ! (iflag_split .eq.0)
2905 !!!
2906
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 DO j=1, knon
2907 ! i = ni(j)
2908 ! yz0h_oupas(j) = yz0m(j)
2909 ! IF(nsrf.EQ.is_oce) THEN
2910 ! yz0h_oupas(j) = z0m(i,nsrf)
2911 ! ENDIF
2912 788452 psfce(j)=ypaprs(j,1)
2913 790372 patm(j)=ypplay(j,1)
2914 ENDDO
2915
2916
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (iflag_pbl_surface_t2m_bug==1) THEN
2917 yz0h_oupas(1:knon)=yz0m(1:knon)
2918 ELSE
2919
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 yz0h_oupas(1:knon)=yz0h(1:knon)
2920 ENDIF
2921
2922 ! print*,'Dans pbl OK42A'
2923 ! print*,'tair1,yt(:,1),y_d_t(:,1)'
2924 ! print*, tair1,yt(:,1),y_d_t(:,1)
2925
2926 ! Calculate the temperature and relative humidity at 2m and the wind at 10m
2927 !!! jyg le 07/02/2012
2928
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
2929
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_new_t2mq2m==1) THEN
2930 CALL stdlevvarn(klon, knon, nsrf, zxli, &
2931 uzon, vmer, tair1, qair1, zgeo1, &
2932 tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
2933 yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
2934
1/2
✓ Branch 2 taken 1920 times.
✗ Branch 3 not taken.
1920 yn2mout(:, nsrf, :))
2935 ELSE
2936 CALL stdlevvar(klon, knon, nsrf, zxli, &
2937 uzon, vmer, tair1, qair1, zgeo1, &
2938 tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
2939 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
2940 ENDIF
2941 ELSE !(iflag_split .eq.0)
2942 IF (iflag_new_t2mq2m==1) THEN
2943 CALL stdlevvarn(klon, knon, nsrf, zxli, &
2944 uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
2945 tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
2946 yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, &
2947 yn2mout_x(:, nsrf, :))
2948 CALL stdlevvarn(klon, knon, nsrf, zxli, &
2949 uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
2950 tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
2951 yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, &
2952 yn2mout_w(:, nsrf, :))
2953 ELSE
2954 CALL stdlevvar(klon, knon, nsrf, zxli, &
2955 uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
2956 tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
2957 yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x)
2958 CALL stdlevvar(klon, knon, nsrf, zxli, &
2959 uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
2960 tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
2961 yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
2962 ENDIF
2963 !!!
2964 ENDIF ! (iflag_split .eq.0)
2965 !!!
2966 !!! jyg le 07/02/2012
2967
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
2968
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 DO j=1, knon
2969 788452 i = ni(j)
2970 788452 t2m(i,nsrf)=yt2m(j)
2971 788452 q2m(i,nsrf)=yq2m(j)
2972 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
2973 788452 ustar(i,nsrf)=yustar(j)
2974 788452 u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
2975 788452 v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
2976 !
2977
2/2
✓ Branch 0 taken 4730712 times.
✓ Branch 1 taken 788452 times.
5521084 DO k = 1, 6
2978 5519164 n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
2979 END DO
2980 !
2981 ENDDO
2982 ELSE !(iflag_split .eq.0)
2983 DO j=1, knon
2984 i = ni(j)
2985 t2m_x(i,nsrf)=yt2m_x(j)
2986 q2m_x(i,nsrf)=yq2m_x(j)
2987 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
2988 ustar_x(i,nsrf)=yustar_x(j)
2989 u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
2990 v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
2991 !
2992 DO k = 1, 6
2993 n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
2994 END DO
2995 !
2996 ENDDO
2997 DO j=1, knon
2998 i = ni(j)
2999 t2m_w(i,nsrf)=yt2m_w(j)
3000 q2m_w(i,nsrf)=yq2m_w(j)
3001 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
3002 ustar_w(i,nsrf)=yustar_w(j)
3003 u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2)
3004 v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2)
3005 !
3006 ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf))
3007 u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
3008 v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
3009 !
3010 DO k = 1, 6
3011 n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
3012 END DO
3013 !
3014 ENDDO
3015 !!!
3016 ENDIF ! (iflag_split .eq.0)
3017 !!!
3018
3019 ! print*,'Dans pbl OK43'
3020 !IM Calcule de l'humidite relative a 2m (rh2m) pour diagnostique
3021 !IM Ajoute dependance type surface
3022 IF (thermcep) THEN
3023 !!! jyg le 07/02/2012
3024
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
3025
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 DO j = 1, knon
3026 788452 i=ni(j)
3027 788452 zdelta1 = MAX(0.,SIGN(1., rtt-yt2m(j) ))
3028 788452 zx_qs1 = r2es * FOEEW(yt2m(j),zdelta1)/paprs(i,1)
3029 788452 zx_qs1 = MIN(0.5,zx_qs1)
3030 788452 zcor1 = 1./(1.-RETV*zx_qs1)
3031 788452 zx_qs1 = zx_qs1*zcor1
3032
3033 788452 rh2m(i) = rh2m(i) + yq2m(j)/zx_qs1 * pctsrf(i,nsrf)
3034 1920 qsat2m(i) = qsat2m(i) + zx_qs1 * pctsrf(i,nsrf)
3035 ENDDO
3036 ELSE ! (iflag_split .eq.0)
3037 DO j = 1, knon
3038 i=ni(j)
3039 zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_x(j) ))
3040 zx_qs1 = r2es * FOEEW(yt2m_x(j),zdelta1)/paprs(i,1)
3041 zx_qs1 = MIN(0.5,zx_qs1)
3042 zcor1 = 1./(1.-RETV*zx_qs1)
3043 zx_qs1 = zx_qs1*zcor1
3044
3045 rh2m_x(i) = rh2m_x(i) + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf)
3046 qsat2m_x(i) = qsat2m_x(i) + zx_qs1 * pctsrf(i,nsrf)
3047 ENDDO
3048 DO j = 1, knon
3049 i=ni(j)
3050 zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_w(j) ))
3051 zx_qs1 = r2es * FOEEW(yt2m_w(j),zdelta1)/paprs(i,1)
3052 zx_qs1 = MIN(0.5,zx_qs1)
3053 zcor1 = 1./(1.-RETV*zx_qs1)
3054 zx_qs1 = zx_qs1*zcor1
3055
3056 rh2m_w(i) = rh2m_w(i) + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf)
3057 qsat2m_w(i) = qsat2m_w(i) + zx_qs1 * pctsrf(i,nsrf)
3058 ENDDO
3059 !!!
3060 ENDIF ! (iflag_split .eq.0)
3061 !!!
3062 ENDIF
3063 !
3064
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) THEN
3065 print *, 'T2m, q2m, RH2m ', &
3066 t2m, q2m, rh2m
3067 ENDIF
3068
3069 ! print*,'OK pbl 5'
3070 !
3071 !!! jyg le 07/02/2012
3072
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
1920 IF (iflag_split .eq.0) THEN
3073 CALL hbtm(knon, ypaprs, ypplay, &
3074 yt2m,yt10m,yq2m,yq10m,yustar,ywstar, &
3075 y_flux_t,y_flux_q,yu,yv,yt,yq, &
3076 ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, &
3077 1920 ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl)
3078
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) THEN
3079 print *,' Arg. de HBTM: yt2m ',yt2m
3080 print *,' Arg. de HBTM: yt10m ',yt10m
3081 print *,' Arg. de HBTM: yq2m ',yq2m
3082 print *,' Arg. de HBTM: yq10m ',yq10m
3083 print *,' Arg. de HBTM: yustar ',yustar
3084 print *,' Arg. de HBTM: y_flux_t ',y_flux_t
3085 print *,' Arg. de HBTM: y_flux_q ',y_flux_q
3086 print *,' Arg. de HBTM: yu ',yu
3087 print *,' Arg. de HBTM: yv ',yv
3088 print *,' Arg. de HBTM: yt ',yt
3089 print *,' Arg. de HBTM: yq ',yq
3090 ENDIF
3091 ELSE ! (iflag_split .eq.0)
3092 CALL HBTM(knon, ypaprs, ypplay, &
3093 yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, &
3094 y_flux_t_x,y_flux_q_x,yu_x,yv_x,yt_x,yq_x, &
3095 ypblh_x,ycapCL_x,yoliqCL_x,ycteiCL_x,ypblT_x, &
3096 ytherm_x,ytrmb1_x,ytrmb2_x,ytrmb3_x,ylcl_x)
3097 IF (prt_level >=10) THEN
3098 print *,' Arg. de HBTM: yt2m_x ',yt2m_x
3099 print *,' Arg. de HBTM: yt10m_x ',yt10m_x
3100 print *,' Arg. de HBTM: yq2m_x ',yq2m_x
3101 print *,' Arg. de HBTM: yq10m_x ',yq10m_x
3102 print *,' Arg. de HBTM: yustar_x ',yustar_x
3103 print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x
3104 print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x
3105 print *,' Arg. de HBTM: yu_x ',yu_x
3106 print *,' Arg. de HBTM: yv_x ',yv_x
3107 print *,' Arg. de HBTM: yt_x ',yt_x
3108 print *,' Arg. de HBTM: yq_x ',yq_x
3109 ENDIF
3110 CALL HBTM(knon, ypaprs, ypplay, &
3111 yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, &
3112 y_flux_t_w,y_flux_q_w,yu_w,yv_w,yt_w,yq_w, &
3113 ypblh_w,ycapCL_w,yoliqCL_w,ycteiCL_w,ypblT_w, &
3114 ytherm_w,ytrmb1_w,ytrmb2_w,ytrmb3_w,ylcl_w)
3115 !!!
3116 ENDIF ! (iflag_split .eq.0)
3117 !!!
3118
3119 !!! jyg le 07/02/2012
3120
1/2
✓ Branch 0 taken 1920 times.
✗ Branch 1 not taken.
2400 IF (iflag_split .eq.0) THEN
3121 !!!
3122
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 DO j=1, knon
3123 788452 i = ni(j)
3124 788452 pblh(i,nsrf) = ypblh(j)
3125 788452 wstar(i,nsrf) = ywstar(j)
3126 788452 plcl(i,nsrf) = ylcl(j)
3127 788452 capCL(i,nsrf) = ycapCL(j)
3128 788452 oliqCL(i,nsrf) = yoliqCL(j)
3129 788452 cteiCL(i,nsrf) = ycteiCL(j)
3130 788452 pblT(i,nsrf) = ypblT(j)
3131 788452 therm(i,nsrf) = ytherm(j)
3132 788452 trmb1(i,nsrf) = ytrmb1(j)
3133 788452 trmb2(i,nsrf) = ytrmb2(j)
3134 790372 trmb3(i,nsrf) = ytrmb3(j)
3135 ENDDO
3136
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (prt_level >=10) THEN
3137 print *, 'After HBTM: pblh ', pblh
3138 print *, 'After HBTM: plcl ', plcl
3139 print *, 'After HBTM: cteiCL ', cteiCL
3140 ENDIF
3141 ELSE !(iflag_split .eq.0)
3142 DO j=1, knon
3143 i = ni(j)
3144 pblh_x(i,nsrf) = ypblh_x(j)
3145 wstar_x(i,nsrf) = ywstar_x(j)
3146 plcl_x(i,nsrf) = ylcl_x(j)
3147 capCL_x(i,nsrf) = ycapCL_x(j)
3148 oliqCL_x(i,nsrf) = yoliqCL_x(j)
3149 cteiCL_x(i,nsrf) = ycteiCL_x(j)
3150 pblT_x(i,nsrf) = ypblT_x(j)
3151 therm_x(i,nsrf) = ytherm_x(j)
3152 trmb1_x(i,nsrf) = ytrmb1_x(j)
3153 trmb2_x(i,nsrf) = ytrmb2_x(j)
3154 trmb3_x(i,nsrf) = ytrmb3_x(j)
3155 ENDDO
3156 IF (prt_level >=10) THEN
3157 print *, 'After HBTM: pblh_x ', pblh_x
3158 print *, 'After HBTM: plcl_x ', plcl_x
3159 print *, 'After HBTM: cteiCL_x ', cteiCL_x
3160 ENDIF
3161 DO j=1, knon
3162 i = ni(j)
3163 pblh_w(i,nsrf) = ypblh_w(j)
3164 wstar_w(i,nsrf) = ywstar_w(j)
3165 plcl_w(i,nsrf) = ylcl_w(j)
3166 capCL_w(i,nsrf) = ycapCL_w(j)
3167 oliqCL_w(i,nsrf) = yoliqCL_w(j)
3168 cteiCL_w(i,nsrf) = ycteiCL_w(j)
3169 pblT_w(i,nsrf) = ypblT_w(j)
3170 therm_w(i,nsrf) = ytherm_w(j)
3171 trmb1_w(i,nsrf) = ytrmb1_w(j)
3172 trmb2_w(i,nsrf) = ytrmb2_w(j)
3173 trmb3_w(i,nsrf) = ytrmb3_w(j)
3174 ENDDO
3175 IF (prt_level >=10) THEN
3176 print *, 'After HBTM: pblh_w ', pblh_w
3177 print *, 'After HBTM: plcl_w ', plcl_w
3178 print *, 'After HBTM: cteiCL_w ', cteiCL_w
3179 ENDIF
3180 !!!
3181 ENDIF ! (iflag_split .eq.0)
3182 !!!
3183
3184 ! print*,'OK pbl 6'
3185
3186 !****************************************************************************************
3187 ! 15) End of loop over different surfaces
3188 !
3189 !****************************************************************************************
3190 ENDDO loop_nbsrf
3191 !
3192 !----------------------------------------------------------------------------------------
3193 ! Reset iflag_split
3194 !
3195 480 iflag_split=iflag_split_ref
3196
3197 !****************************************************************************************
3198 ! 16) Calculate the mean value over all sub-surfaces for some variables
3199 !
3200 !****************************************************************************************
3201
3202
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 z0m(:,nbsrf+1) = 0.0
3203
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 z0h(:,nbsrf+1) = 0.0
3204
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
3205
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
3206 1908480 z0m(i,nbsrf+1) = z0m(i,nbsrf+1) + z0m(i,nsrf)*pctsrf(i,nsrf)
3207 1910400 z0h(i,nbsrf+1) = z0h(i,nbsrf+1) + z0h(i,nsrf)*pctsrf(i,nsrf)
3208 ENDDO
3209 ENDDO
3210
3211 ! print*,'OK pbl 7'
3212
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
3213
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0
3214
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxt_x(:,:) = 0.0 ; zxfluxq_x(:,:) = 0.0
3215
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxu_x(:,:) = 0.0 ; zxfluxv_x(:,:) = 0.0
3216
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0
3217
8/8
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
37253280 zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0
3218
3219 !!! jyg le 07/02/2012
3220
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_split .ge.1) THEN
3221 !!!
3222 !!! nrlmd & jyg les 02/05/2011, 05/02/2012
3223
3224 DO nsrf = 1, nbsrf
3225 DO k = 1, klev
3226 DO i = 1, klon
3227 zxfluxt_x(i,k) = zxfluxt_x(i,k) + flux_t_x(i,k,nsrf) * pctsrf(i,nsrf)
3228 zxfluxq_x(i,k) = zxfluxq_x(i,k) + flux_q_x(i,k,nsrf) * pctsrf(i,nsrf)
3229 zxfluxu_x(i,k) = zxfluxu_x(i,k) + flux_u_x(i,k,nsrf) * pctsrf(i,nsrf)
3230 zxfluxv_x(i,k) = zxfluxv_x(i,k) + flux_v_x(i,k,nsrf) * pctsrf(i,nsrf)
3231 !
3232 zxfluxt_w(i,k) = zxfluxt_w(i,k) + flux_t_w(i,k,nsrf) * pctsrf(i,nsrf)
3233 zxfluxq_w(i,k) = zxfluxq_w(i,k) + flux_q_w(i,k,nsrf) * pctsrf(i,nsrf)
3234 zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
3235 zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
3236 ENDDO
3237 ENDDO
3238 ENDDO
3239
3240 DO i = 1, klon
3241 zxsens_x(i) = - zxfluxt_x(i,1)
3242 zxsens_w(i) = - zxfluxt_w(i,1)
3243 ENDDO
3244 !!!
3245 ENDIF ! (iflag_split .ge.1)
3246 !!!
3247
3248
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
3249
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
77280 DO k = 1, klev
3250
2/2
✓ Branch 0 taken 74430720 times.
✓ Branch 1 taken 74880 times.
74507520 DO i = 1, klon
3251 74430720 zxfluxt(i,k) = zxfluxt(i,k) + flux_t(i,k,nsrf) * pctsrf(i,nsrf)
3252 74430720 zxfluxq(i,k) = zxfluxq(i,k) + flux_q(i,k,nsrf) * pctsrf(i,nsrf)
3253 74430720 zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
3254 74505600 zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
3255 ENDDO
3256 ENDDO
3257 ENDDO
3258
3259
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
3260 477120 zxsens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
3261 477120 zxevap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
3262 477600 fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i)
3263 ENDDO
3264 !!!
3265
3266 !
3267 ! Incrementer la temperature du sol
3268 !
3269
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 zxtsol(:) = 0.0 ; zxfluxlat(:) = 0.0
3270
8/8
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 2880 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 2862720 times.
✓ Branch 7 taken 2880 times.
3820320 zt2m(:) = 0.0 ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
3271
6/6
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 477120 times.
✓ Branch 5 taken 480 times.
1431840 zustar(:)=0.0 ; zu10m(:) = 0.0 ; zv10m(:) = 0.0
3272
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 s_pblh(:) = 0.0 ; s_plcl(:) = 0.0
3273 !!! jyg le 07/02/2012
3274
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 s_pblh_x(:) = 0.0 ; s_plcl_x(:) = 0.0
3275
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 s_pblh_w(:) = 0.0 ; s_plcl_w(:) = 0.0
3276 !!!
3277
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0
3278
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 s_cteiCL(:) = 0.0; s_pblT(:) = 0.0
3279
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 s_therm(:) = 0.0 ; s_trmb1(:) = 0.0
3280
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 s_trmb2(:) = 0.0 ; s_trmb3(:) = 0.0
3281
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 wstar(:,is_ave)=0.
3282
3283 ! print*,'OK pbl 9'
3284
3285 !!! nrlmd le 02/05/2011
3286
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
954720 zxfluxlat_x(:) = 0.0 ; zxfluxlat_w(:) = 0.0
3287 !!!
3288
3289
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
3290
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
3291 1908480 ts(i,nsrf) = ts(i,nsrf) + d_ts(i,nsrf)
3292
3293 wfbils(i,nsrf) = ( solsw(i,nsrf) + sollw(i,nsrf) &
3294 1908480 + flux_t(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
3295 1908480 wfbilo(i,nsrf) = (evap(i,nsrf)-(rain_f(i)+snow_f(i)))*pctsrf(i,nsrf)
3296 1908480 wfevap(i,nsrf) = evap(i,nsrf)*pctsrf(i,nsrf)
3297 1908480 wfrain(i,nsrf) = rain_f(i)*pctsrf(i,nsrf)
3298 1908480 wfsnow(i,nsrf) = snow_f(i)*pctsrf(i,nsrf)
3299
3300 1908480 zxtsol(i) = zxtsol(i) + ts(i,nsrf) * pctsrf(i,nsrf)
3301 1910400 zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf)
3302 ENDDO
3303 ENDDO
3304 !
3305 !<al1 order 2 correction to zxtsol, for radiation computations (main atm effect of Ts)
3306 480 IF (iflag_order2_sollw == 1) THEN
3307 meansqT(:) = 0. ! as working buffer
3308 DO nsrf = 1, nbsrf
3309 DO i = 1, klon
3310 meansqT(i) = meansqT(i)+(ts(i,nsrf)-zxtsol(i))**2 *pctsrf(i,nsrf)
3311 ENDDO
3312 ENDDO
3313 zxtsol(:) = zxtsol(:)+1.5*meansqT(:)/zxtsol(:)
3314 ENDIF ! iflag_order2_sollw == 1
3315 !>al1
3316
3317 !!! jyg le 07/02/2012
3318
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_split .eq.0) THEN
3319
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 1920 times.
2400 DO nsrf = 1, nbsrf
3320
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
3321 1908480 zt2m(i) = zt2m(i) + t2m(i,nsrf) * pctsrf(i,nsrf)
3322 1908480 zq2m(i) = zq2m(i) + q2m(i,nsrf) * pctsrf(i,nsrf)
3323 !
3324
2/2
✓ Branch 0 taken 11450880 times.
✓ Branch 1 taken 1908480 times.
13359360 DO k = 1, 6
3325 13359360 zn2mout(i,k) = zn2mout(i,k) + n2mout(i,nsrf,k) * pctsrf(i,nsrf)
3326 ENDDO
3327 !
3328 1908480 zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
3329 1908480 wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
3330 1908480 zu10m(i) = zu10m(i) + u10m(i,nsrf) * pctsrf(i,nsrf)
3331 1908480 zv10m(i) = zv10m(i) + v10m(i,nsrf) * pctsrf(i,nsrf)
3332
3333 1908480 s_pblh(i) = s_pblh(i) + pblh(i,nsrf) * pctsrf(i,nsrf)
3334 1908480 s_plcl(i) = s_plcl(i) + plcl(i,nsrf) * pctsrf(i,nsrf)
3335 1908480 s_capCL(i) = s_capCL(i) + capCL(i,nsrf) * pctsrf(i,nsrf)
3336 1908480 s_oliqCL(i) = s_oliqCL(i) + oliqCL(i,nsrf)* pctsrf(i,nsrf)
3337 1908480 s_cteiCL(i) = s_cteiCL(i) + cteiCL(i,nsrf)* pctsrf(i,nsrf)
3338 1908480 s_pblT(i) = s_pblT(i) + pblT(i,nsrf) * pctsrf(i,nsrf)
3339 1908480 s_therm(i) = s_therm(i) + therm(i,nsrf) * pctsrf(i,nsrf)
3340 1908480 s_trmb1(i) = s_trmb1(i) + trmb1(i,nsrf) * pctsrf(i,nsrf)
3341 1908480 s_trmb2(i) = s_trmb2(i) + trmb2(i,nsrf) * pctsrf(i,nsrf)
3342 1910400 s_trmb3(i) = s_trmb3(i) + trmb3(i,nsrf) * pctsrf(i,nsrf)
3343 ENDDO
3344 ENDDO
3345 ELSE !(iflag_split .eq.0)
3346 DO nsrf = 1, nbsrf
3347 DO i = 1, klon
3348 !!! nrlmd le 02/05/2011
3349 zxfluxlat_x(i) = zxfluxlat_x(i) + fluxlat_x(i,nsrf) * pctsrf(i,nsrf)
3350 zxfluxlat_w(i) = zxfluxlat_w(i) + fluxlat_w(i,nsrf) * pctsrf(i,nsrf)
3351 !!!
3352 !!! jyg le 08/02/2012
3353 !! Pour le moment, on sort les valeurs dans (x) et (w) de pblh et de plcl ;
3354 !! pour zt2m, on fait la moyenne surfacique sur les sous-surfaces ;
3355 !! pour qsat2m, on fait la moyenne surfacique sur (x) et (w) ;
3356 !! pour les autres variables, on sort les valeurs de la region (x).
3357 zt2m(i) = zt2m(i) + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
3358 zq2m(i) = zq2m(i) + q2m_x(i,nsrf) * pctsrf(i,nsrf)
3359 !
3360 DO k = 1, 6
3361 zn2mout(i,k) = zn2mout(i,k) + n2mout_x(i,nsrf,k) * pctsrf(i,nsrf)
3362 ENDDO
3363 !
3364 zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
3365 wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
3366 zu10m(i) = zu10m(i) + u10m_x(i,nsrf) * pctsrf(i,nsrf)
3367 zv10m(i) = zv10m(i) + v10m_x(i,nsrf) * pctsrf(i,nsrf)
3368 !
3369 s_pblh(i) = s_pblh(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf)
3370 s_pblh_x(i) = s_pblh_x(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf)
3371 s_pblh_w(i) = s_pblh_w(i) + pblh_w(i,nsrf) * pctsrf(i,nsrf)
3372 !
3373 s_plcl(i) = s_plcl(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf)
3374 s_plcl_x(i) = s_plcl_x(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf)
3375 s_plcl_w(i) = s_plcl_w(i) + plcl_w(i,nsrf) * pctsrf(i,nsrf)
3376 !
3377 s_capCL(i) = s_capCL(i) + capCL_x(i,nsrf) * pctsrf(i,nsrf)
3378 s_oliqCL(i) = s_oliqCL(i) + oliqCL_x(i,nsrf)* pctsrf(i,nsrf)
3379 s_cteiCL(i) = s_cteiCL(i) + cteiCL_x(i,nsrf)* pctsrf(i,nsrf)
3380 s_pblT(i) = s_pblT(i) + pblT_x(i,nsrf) * pctsrf(i,nsrf)
3381 s_therm(i) = s_therm(i) + therm_x(i,nsrf) * pctsrf(i,nsrf)
3382 s_trmb1(i) = s_trmb1(i) + trmb1_x(i,nsrf) * pctsrf(i,nsrf)
3383 s_trmb2(i) = s_trmb2(i) + trmb2_x(i,nsrf) * pctsrf(i,nsrf)
3384 s_trmb3(i) = s_trmb3(i) + trmb3_x(i,nsrf) * pctsrf(i,nsrf)
3385 ENDDO
3386 ENDDO
3387 DO i = 1, klon
3388 qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i))
3389 ENDDO
3390 !!!
3391 ENDIF ! (iflag_split .eq.0)
3392 !!!
3393
3394 IF (check) THEN
3395 amn=MIN(ts(1,is_ter),1000.)
3396 amx=MAX(ts(1,is_ter),-1000.)
3397 DO i=2, klon
3398 amn=MIN(ts(i,is_ter),amn)
3399 amx=MAX(ts(i,is_ter),amx)
3400 ENDDO
3401 PRINT*,' debut apres d_ts min max ftsol(ts)',itap,amn,amx
3402 ENDIF
3403
3404 !jg ?
3405 !!$!
3406 !!$! If a sub-surface does not exsist for a grid point, the mean value for all
3407 !!$! sub-surfaces is distributed.
3408 !!$!
3409 !!$ DO nsrf = 1, nbsrf
3410 !!$ DO i = 1, klon
3411 !!$ IF ((pctsrf_new(i,nsrf) .LT. epsfra) .OR. (t2m(i,nsrf).EQ.0.)) THEN
3412 !!$ ts(i,nsrf) = zxtsol(i)
3413 !!$ t2m(i,nsrf) = zt2m(i)
3414 !!$ q2m(i,nsrf) = zq2m(i)
3415 !!$ u10m(i,nsrf) = zu10m(i)
3416 !!$ v10m(i,nsrf) = zv10m(i)
3417 !!$
3418 !!$! Les variables qui suivent sont plus utilise, donc peut-etre pas la peine a les mettre ajour
3419 !!$ pblh(i,nsrf) = s_pblh(i)
3420 !!$ plcl(i,nsrf) = s_plcl(i)
3421 !!$ capCL(i,nsrf) = s_capCL(i)
3422 !!$ oliqCL(i,nsrf) = s_oliqCL(i)
3423 !!$ cteiCL(i,nsrf) = s_cteiCL(i)
3424 !!$ pblT(i,nsrf) = s_pblT(i)
3425 !!$ therm(i,nsrf) = s_therm(i)
3426 !!$ trmb1(i,nsrf) = s_trmb1(i)
3427 !!$ trmb2(i,nsrf) = s_trmb2(i)
3428 !!$ trmb3(i,nsrf) = s_trmb3(i)
3429 !!$ ENDIF
3430 !!$ ENDDO
3431 !!$ ENDDO
3432
3433
3434
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
3435 480 fder(i) = - 4.0*RSIGMA*zxtsol(i)**3
3436 ENDDO
3437
3438
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zxqsurf(:) = 0.0
3439
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zxsnow(:) = 0.0
3440
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
3441
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
3442 1908480 zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
3443 1910400 zxsnow(i) = zxsnow(i) + snow(i,nsrf) * pctsrf(i,nsrf)
3444 ENDDO
3445 ENDDO
3446
3447 ! Premier niveau de vent sortie dans physiq.F
3448
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zu1(:) = u(:,1)
3449
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zv1(:) = v(:,1)
3450
3451 480 END SUBROUTINE pbl_surface
3452 !
3453 !****************************************************************************************
3454 !
3455 1 SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
3456
3457
21/54
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 1 times.
✓ Branch 5 taken 479 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 480 times.
✓ Branch 8 taken 480 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 480 times.
✓ Branch 12 taken 788452 times.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✓ Branch 15 taken 1920 times.
✗ Branch 16 not taken.
✗ Branch 17 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1920 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✗ Branch 25 not taken.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
✗ Branch 28 not taken.
✓ Branch 29 taken 480 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 480 times.
✗ Branch 32 not taken.
✓ Branch 33 taken 480 times.
✗ Branch 34 not taken.
✓ Branch 35 taken 480 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 480 times.
✗ Branch 38 not taken.
✓ Branch 39 taken 1920 times.
✗ Branch 40 not taken.
✓ Branch 41 taken 1920 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 1920 times.
✗ Branch 46 not taken.
✓ Branch 47 taken 1920 times.
✗ Branch 48 not taken.
✗ Branch 49 not taken.
✗ Branch 50 not taken.
✗ Branch 51 not taken.
✗ Branch 52 not taken.
✓ Branch 53 taken 9659520 times.
✗ Branch 54 not taken.
✓ Branch 55 taken 480 times.
17367089 USE indice_sol_mod
3458
3459 INCLUDE "dimsoil.h"
3460
3461 ! Ouput variables
3462 !****************************************************************************************
3463 REAL, DIMENSION(klon), INTENT(OUT) :: fder_rst
3464 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: snow_rst
3465 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: qsurf_rst
3466 REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
3467
3468
3469 !****************************************************************************************
3470 ! Return module variables for writing to restart file
3471 !
3472 !****************************************************************************************
3473
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 fder_rst(:) = fder(:)
3474
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 snow_rst(:,:) = snow(:,:)
3475
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 qsurf_rst(:,:) = qsurf(:,:)
3476
6/6
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 44 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 43736 times.
✓ Branch 5 taken 44 times.
43785 ftsoil_rst(:,:,:) = ftsoil(:,:,:)
3477
3478 !****************************************************************************************
3479 ! Deallocate module variables
3480 !
3481 !****************************************************************************************
3482 ! DEALLOCATE(qsol, fder, snow, qsurf, evap, rugos, agesno, ftsoil)
3483
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(fder)) DEALLOCATE(fder)
3484
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(snow)) DEALLOCATE(snow)
3485
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
3486
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
3487
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0)
3488
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0)
3489
3490 !jyg<
3491 !****************************************************************************************
3492 ! Deallocate variables for pbl splitting
3493 !
3494 !****************************************************************************************
3495
3496 1 CALL wx_pbl_final
3497 !>jyg
3498
3499 1 END SUBROUTINE pbl_surface_final
3500 !
3501 !****************************************************************************************
3502 !
3503
3504 !albedo SB >>>
3505 10 SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
3506 evap, z0m, z0h, agesno, &
3507 10 tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke)
3508 !albedo SB <<<
3509 ! Give default values where new fraction has appread
3510
3511 USE indice_sol_mod
3512 use phys_state_var_mod, only: delta_sal, ds_ns, dt_ns, delta_sst
3513 use config_ocean_skin_m, only: activate_ocean_skin
3514
3515 INCLUDE "dimsoil.h"
3516 INCLUDE "clesphys.h"
3517 INCLUDE "compbl.h"
3518
3519 ! Input variables
3520 !****************************************************************************************
3521 INTEGER, INTENT(IN) :: itime
3522 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf_new, pctsrf_old
3523
3524 ! InOutput variables
3525 !****************************************************************************************
3526 REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf
3527 !albedo SB >>>
3528 REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir, alb_dif
3529 INTEGER :: k
3530 !albedo SB <<<
3531 REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar,u10m, v10m
3532 REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: evap, agesno
3533 REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT) :: z0m,z0h
3534 REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
3535
3536 ! Local variables
3537 !****************************************************************************************
3538 INTEGER :: nsrf, nsrf_comp1, nsrf_comp2, nsrf_comp3, i
3539 CHARACTER(len=80) :: abort_message
3540 CHARACTER(len=20) :: modname = 'pbl_surface_newfrac'
3541 INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0
3542 !
3543 ! All at once !!
3544 !****************************************************************************************
3545
3546
2/2
✓ Branch 0 taken 40 times.
✓ Branch 1 taken 10 times.
50 DO nsrf = 1, nbsrf
3547 ! First decide complement sub-surfaces
3548 SELECT CASE (nsrf)
3549 CASE(is_oce)
3550 nsrf_comp1=is_sic
3551 nsrf_comp2=is_ter
3552 nsrf_comp3=is_lic
3553 CASE(is_sic)
3554 nsrf_comp1=is_oce
3555 nsrf_comp2=is_ter
3556 nsrf_comp3=is_lic
3557 CASE(is_ter)
3558 nsrf_comp1=is_lic
3559 nsrf_comp2=is_oce
3560 nsrf_comp3=is_sic
3561 CASE(is_lic)
3562 nsrf_comp1=is_ter
3563 nsrf_comp2=is_oce
3564
2/2
✓ Branch 0 taken 10 times.
✓ Branch 1 taken 30 times.
40 nsrf_comp3=is_sic
3565 END SELECT
3566
3567 ! Initialize all new fractions
3568
2/2
✓ Branch 0 taken 39760 times.
✓ Branch 1 taken 40 times.
39810 DO i=1, klon
3569
4/4
✓ Branch 0 taken 16430 times.
✓ Branch 1 taken 23330 times.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 16425 times.
39800 IF (pctsrf_new(i,nsrf) > 0. .AND. pctsrf_old(i,nsrf) == 0.) THEN
3570
3571
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
5 IF (pctsrf_old(i,nsrf_comp1) > 0.) THEN
3572 ! Use the complement sub-surface, keeping the continents unchanged
3573 5 qsurf(i,nsrf) = qsurf(i,nsrf_comp1)
3574 5 evap(i,nsrf) = evap(i,nsrf_comp1)
3575 5 z0m(i,nsrf) = z0m(i,nsrf_comp1)
3576 5 z0h(i,nsrf) = z0h(i,nsrf_comp1)
3577 5 tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
3578 !albedo SB >>>
3579
2/2
✓ Branch 0 taken 30 times.
✓ Branch 1 taken 5 times.
35 DO k=1,nsw
3580 30 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp1)
3581 35 alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp1)
3582 ENDDO
3583 !albedo SB <<<
3584 5 ustar(i,nsrf) = ustar(i,nsrf_comp1)
3585 5 u10m(i,nsrf) = u10m(i,nsrf_comp1)
3586 5 v10m(i,nsrf) = v10m(i,nsrf_comp1)
3587
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
5 IF (iflag_pbl > 1) THEN
3588
2/2
✓ Branch 0 taken 200 times.
✓ Branch 1 taken 5 times.
205 tke(i,:,nsrf) = tke(i,:,nsrf_comp1)
3589 ENDIF
3590 5 mfois(nsrf) = mfois(nsrf) + 1
3591 ! F. Codron sensible default values for ocean and sea ice
3592
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
5 IF (nsrf.EQ.is_oce) THEN
3593 1 tsurf(i,nsrf) = 271.35
3594 ! (temperature of sea water under sea ice, so that
3595 ! is also the temperature of appearing sea water)
3596
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 1 times.
7 DO k=1,nsw
3597 6 alb_dir(i,k,nsrf) = 0.06 ! typical Ocean albedo
3598 7 alb_dif(i,k,nsrf) = 0.06
3599 ENDDO
3600
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if (activate_ocean_skin >= 1) then
3601 if (activate_ocean_skin == 2 &
3602 .and. type_ocean == "couple") then
3603 delta_sal(i) = 0.
3604 delta_sst(i) = 0.
3605 end if
3606
3607 ds_ns(i) = 0.
3608 dt_ns(i) = 0.
3609 end if
3610
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
4 ELSE IF (nsrf.EQ.is_sic) THEN
3611 4 tsurf(i,nsrf) = 271.35
3612 ! (Temperature at base of sea ice. Surface
3613 ! temperature could be higher, up to 0 Celsius
3614 ! degrees. We set it to -1.8 Celsius degrees for
3615 ! consistency with the ocean slab model.)
3616
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 24 times.
28 DO k=1,nsw
3617 24 alb_dir(i,k,nsrf) = 0.3 ! thin ice
3618 28 alb_dif(i,k,nsrf) = 0.3
3619 ENDDO
3620 ENDIF
3621 ELSE
3622 ! The continents have changed. The new fraction receives the mean sum of the existent fractions
3623 qsurf(i,nsrf) = qsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + qsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
3624 evap(i,nsrf) = evap(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + evap(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
3625 z0m(i,nsrf) = z0m(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0m(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
3626 z0h(i,nsrf) = z0h(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0h(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
3627 tsurf(i,nsrf) = tsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
3628 !albedo SB >>>
3629 DO k=1,nsw
3630 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
3631 alb_dir(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
3632 alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
3633 alb_dif(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
3634 ENDDO
3635 !albedo SB <<<
3636 ustar(i,nsrf) = ustar(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + ustar(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
3637 u10m(i,nsrf) = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
3638 v10m(i,nsrf) = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
3639 IF (iflag_pbl > 1) THEN
3640 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
3641 ENDIF
3642
3643 ! Security abort. This option has never been tested. To test, comment the following line.
3644 ! abort_message='The fraction of the continents have changed!'
3645 ! CALL abort_physic(modname,abort_message,1)
3646 nfois(nsrf) = nfois(nsrf) + 1
3647 ENDIF
3648 5 snow(i,nsrf) = 0.
3649 5 agesno(i,nsrf) = 0.
3650
2/2
✓ Branch 0 taken 55 times.
✓ Branch 1 taken 5 times.
60 ftsoil(i,:,nsrf) = tsurf(i,nsrf)
3651 ELSE
3652 39755 pfois(nsrf) = pfois(nsrf)+ 1
3653 ENDIF
3654 ENDDO
3655
3656 ENDDO
3657
3658 10 END SUBROUTINE pbl_surface_newfrac
3659 !
3660 !****************************************************************************************
3661 !
3662 END MODULE pbl_surface_mod
3663