GCC Code Coverage Report


Directory: ./
File: phys/physiq_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 1170 1638 71.4%
Branches: 1528 2632 58.1%

Line Branch Exec Source
1 !
2 ! $Id: physiq_mod.F90 3989 2021-10-10 07:18:17Z oboucher $
3 !
4 !#define IO_DEBUG
5 MODULE physiq_mod
6
7 IMPLICIT NONE
8
9 CONTAINS
10
11 131226172 SUBROUTINE physiq (nlon,nlev, &
12 debut,lafin,pdtphys_, &
13 480 paprs,pplay,pphi,pphis,presnivs, &
14 480 u,v,rot,t,qx, &
15 flxmass_w, &
16 d_u, d_v, d_t, d_qx, d_ps)
17
18 ! For clarity, the "USE" section is now arranged in alphabetical order,
19 ! with a separate section for CPP keys
20 ! PLEASE try to follow this rule
21
22 USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
23 USE aero_mod
24 USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
25 & fl_ebil, fl_cor_ebil
26 USE assert_m, only: assert
27 USE change_srf_frac_mod
28 USE conf_phys_m, only: conf_phys
29 USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
30 USE CFMIP_point_locations ! IM stations CFMIP
31 USE cmp_seri_mod
32 USE dimphy
33 USE etat0_limit_unstruct_mod
34 USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
35 USE fonte_neige_mod, ONLY : fonte_neige_get_vars
36 USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
37 USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
38 histwrite, ju2ymds, ymds2ju, getin
39 USE ioipsl_getin_p_mod, ONLY : getin_p
40 USE indice_sol_mod
41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac, nqCO2
42 USE iophy
43 USE limit_read_mod, ONLY : init_limit_read
44 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
45 USE mod_phys_lmdz_mpi_data, only: is_mpi_root
46 USE mod_phys_lmdz_para
47 USE netcdf95, only: nf95_close
48 USE netcdf, only: nf90_fill_real ! IM for NMC files
49 USE open_climoz_m, only: open_climoz ! ozone climatology from a file
50 USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
51 USE pbl_surface_mod, ONLY : pbl_surface
52 USE phyaqua_mod, only: zenang_an
53 USE phystokenc_mod, ONLY: offline, phystokenc
54 USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
55 year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour
56 !! USE phys_local_var_mod, ONLY : a long list of variables
57 !! ==> see below, after "CPP Keys" section
58 USE phys_state_var_mod ! Variables sauvegardees de la physique
59 USE phys_output_mod
60 USE phys_output_ctrlout_mod
61 USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level, &
62 alert_first_call, call_alert, prt_alerte
63 USE readaerosol_mod, ONLY : init_aero_fromfile
64 USE readaerosolstrato_m, ONLY : init_readaerosolstrato
65 USE radlwsw_m, only: radlwsw
66 USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
67 USE regr_pr_time_av_m, only: regr_pr_time_av
68 USE surface_data, ONLY : type_ocean, ok_veget, landice_opt
69 USE time_phylmdz_mod, only: annee_ref, current_time, day_ini, day_ref, &
70 day_step_phy, itau_phy, pdtphys, raz_date, start_time, update_time
71 USE tracinca_mod, ONLY: config_inca
72 USE tropopause_m, ONLY: dyn_tropopause
73 USE vampir
74 USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
75 USE write_field_phy
76
77 !USE cmp_seri_mod
78 ! USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
79 ! & fl_ebil, fl_cor_ebil
80
81 !!!!!!!!!!!!!!!!!! "USE" section for CPP keys !!!!!!!!!!!!!!!!!!!!!!!!
82 !
83 !
84 USE phytrac_mod, ONLY : phytrac_init, phytrac
85 USE phys_output_write_mod
86
87
88
89
90 USE YOERAD, ONLY : NRADLP
91 USE YOESW, ONLY : RSUN
92
93
94
95
96 USE paramLMDZ_phy_mod
97 !
98 !
99 !!!!!!!!!!!!!!!!!! END "USE" for CPP keys !!!!!!!!!!!!!!!!!!!!!!
100
101 USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
102 ! [Variables internes non sauvegardees de la physique]
103 ! Variables locales pour effectuer les appels en serie
104 t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,tr_seri, &
105 ! Dynamic tendencies (diagnostics)
106 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn, &
107 d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, &
108 ! Physic tendencies
109 d_t_con,d_q_con,d_u_con,d_v_con, &
110 d_tr, & !! to be removed?? (jyg)
111 d_t_wake,d_q_wake, &
112 d_t_lwr,d_t_lw0,d_t_swr,d_t_sw0, &
113 d_t_ajsb,d_q_ajsb, &
114 d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, &
115 d_t_ajs_w,d_q_ajs_w, &
116 d_t_ajs_x,d_q_ajs_x, &
117 !
118 d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
119 d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, &
120 d_t_lscst,d_q_lscst, &
121 d_t_lscth,d_q_lscth, &
122 plul_st,plul_th, &
123 !
124 d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_t_diss, &
125 d_ts, &
126 !
127 d_t_oli,d_u_oli,d_v_oli, &
128 d_t_oro,d_u_oro,d_v_oro, &
129 d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, &
130 d_t_lif,d_u_lif,d_v_lif, &
131 d_t_ec, &
132 !
133 du_gwd_hines,dv_gwd_hines,d_t_hin, &
134 dv_gwd_rando,dv_gwd_front, &
135 east_gwstress,west_gwstress, &
136 d_q_ch4, &
137 ! Special RRTM
138 ZLWFT0_i,ZSWFT0_i,ZFLDN0, &
139 ZFLUP0,ZFSDN0,ZFSUP0, &
140 !
141 topswad_aero,solswad_aero, &
142 topswai_aero,solswai_aero, &
143 topswad0_aero,solswad0_aero, &
144 !LW additional
145 toplwad_aero,sollwad_aero, &
146 toplwai_aero,sollwai_aero, &
147 toplwad0_aero,sollwad0_aero, &
148 !
149 topsw_aero,solsw_aero, &
150 topsw0_aero,solsw0_aero, &
151 topswcf_aero,solswcf_aero, &
152 tausum_aero,tau3d_aero, &
153 drytausum_aero, &
154 !
155 !variables CFMIP2/CMIP5
156 topswad_aerop, solswad_aerop, &
157 topswai_aerop, solswai_aerop, &
158 topswad0_aerop, solswad0_aerop, &
159 topsw_aerop, topsw0_aerop, &
160 solsw_aerop, solsw0_aerop, &
161 topswcf_aerop, solswcf_aerop, &
162 !LW diagnostics
163 toplwad_aerop, sollwad_aerop, &
164 toplwai_aerop, sollwai_aerop, &
165 toplwad0_aerop, sollwad0_aerop, &
166 !
167 ptstar, pt0, slp, &
168 !
169 bils, &
170 !
171 cldh, cldl,cldm, cldq, cldt, &
172 JrNt, &
173 dthmin, evap, fder, plcl, plfc, &
174 prw, prlw, prsw, &
175 s_lcl, s_pblh, s_pblt, s_therm, &
176 cdragm, cdragh, &
177 zustar, zu10m, zv10m, rh2m, qsat2m, &
178 zq2m, zt2m, zn2mout, weak_inversion, &
179 zt2m_min_mon, zt2m_max_mon, & ! pour calcul_divers.h
180 t2m_min_mon, t2m_max_mon, & ! pour calcul_divers.h
181 !
182 s_pblh_x, s_pblh_w, &
183 s_lcl_x, s_lcl_w, &
184 !
185 slab_wfbils, tpot, tpote, &
186 ue, uq, ve, vq, zxffonte, &
187 uwat, vwat, &
188 zxfqcalving, zxfluxlat, &
189 zxrunofflic, &
190 zxtsol, snow_lsc, zxfqfonte, zxqsurf, &
191 delta_qsurf, &
192 rain_lsc, rain_num, &
193 !
194 sens_x, sens_w, &
195 zxfluxlat_x, zxfluxlat_w, &
196 !
197 d_t_vdf_x, d_t_vdf_w, &
198 d_q_vdf_x, d_q_vdf_w, &
199 pbl_tke_input, &
200 t_therm, q_therm, u_therm, v_therm, &
201 cdragh_x, cdragh_w, &
202 cdragm_x, cdragm_w, &
203 kh, kh_x, kh_w, &
204 !
205 wake_k, &
206 alp_wake, &
207 wake_h, wake_omg, &
208 ! tendencies of delta T and delta q:
209 d_deltat_wk, d_deltaq_wk, & ! due to wakes
210 d_deltat_wk_gw, d_deltaq_wk_gw, & ! due to wake induced gravity waves
211 d_deltat_vdf, d_deltaq_vdf, & ! due to vertical diffusion
212 d_deltat_the, d_deltaq_the, & ! due to thermals
213 d_deltat_ajs_cv, d_deltaq_ajs_cv, & ! due to dry adjustment of (w) before convection
214 ! tendencies of wake fractional area and wake number per unit area:
215 d_s_wk, d_dens_a_wk, d_dens_wk, & ! due to wakes
216 !!! d_s_vdf, d_dens_a_vdf, d_dens_vdf, & ! due to vertical diffusion
217 !!! d_s_the, d_dens_a_the, d_dens_the, & ! due to thermals
218 !
219 ptconv, ratqsc, &
220 wbeff, convoccur, zmax_th, &
221 sens, flwp, fiwp, &
222 alp_bl_conv,alp_bl_det, &
223 alp_bl_fluct_m,alp_bl_fluct_tke, &
224 alp_bl_stat, n2, s2, &
225 proba_notrig, random_notrig, &
226 !! cv_gen, & !moved to phys_state_var_mod
227 !
228 dnwd0, &
229 omega, &
230 epmax_diag, &
231 ! Deep convective variables used in phytrac
232 pmflxr, pmflxs, &
233 wdtrainA, wdtrainS, wdtrainM, &
234 upwd, dnwd, &
235 ep, &
236 da, mp, &
237 phi, &
238 wght_cvfd, &
239 phi2, &
240 d1a, dam, &
241 ev, &
242 elij, &
243 qtaa, &
244 clw, &
245 epmlmMm, eplaMm, &
246 sij, &
247 !
248 cldemi, &
249 cldfra, cldtau, fiwc, &
250 fl, re, flwc, &
251 ref_liq, ref_ice, theta, &
252 ref_liq_pi, ref_ice_pi, &
253 zphi, zx_rh, zx_rhl, zx_rhi, &
254 pmfd, pmfu, &
255 !
256 t2m, fluxlat, &
257 fsollw, evap_pot, &
258 fsolsw, wfbils, wfbilo, &
259 wfevap, wfrain, wfsnow, &
260 prfl, psfl, fraca, Vprecip, &
261 zw2, &
262 !
263 fluxu, fluxv, &
264 fluxt, &
265 !
266 uwriteSTD, vwriteSTD, & !pour calcul_STDlev.h
267 wwriteSTD, phiwriteSTD, & !pour calcul_STDlev.h
268 qwriteSTD, twriteSTD, rhwriteSTD, & !pour calcul_STDlev.h
269 !
270 beta_prec, &
271 rneb, &
272 zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic
273 !
274
275
276 IMPLICIT NONE
277 !>======================================================================
278 !!
279 !! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
280 !!
281 !! Objet: Moniteur general de la physique du modele
282 !!AA Modifications quant aux traceurs :
283 !!AA - uniformisation des parametrisations ds phytrac
284 !!AA - stockage des moyennes des champs necessaires
285 !!AA en mode traceur off-line
286 !!======================================================================
287 !! CLEFS CPP POUR LES IO
288 !! =====================
289 !!======================================================================
290 !! modif ( P. Le Van , 12/10/98 )
291 !!
292 !! Arguments:
293 !!
294 !! nlon----input-I-nombre de points horizontaux
295 !! nlev----input-I-nombre de couches verticales, doit etre egale a klev
296 !! debut---input-L-variable logique indiquant le premier passage
297 !! lafin---input-L-variable logique indiquant le dernier passage
298 !! jD_cur -R-jour courant a l'appel de la physique (jour julien)
299 !! jH_cur -R-heure courante a l'appel de la physique (jour julien)
300 !! pdtphys-input-R-pas d'integration pour la physique (seconde)
301 !! paprs---input-R-pression pour chaque inter-couche (en Pa)
302 !! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
303 !! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
304 !! pphis---input-R-geopotentiel du sol
305 !! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
306 !! u-------input-R-vitesse dans la direction X (de O a E) en m/s
307 !! v-------input-R-vitesse Y (de S a N) en m/s
308 !! t-------input-R-temperature (K)
309 !! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
310 !! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
311 !! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
312 !! d_ql_dyn-input-R-tendance dynamique pour "ql" (kg/kg/s)
313 !! d_qs_dyn-input-R-tendance dynamique pour "qs" (kg/kg/s)
314 !! flxmass_w -input-R- flux de masse verticale
315 !! d_u-----output-R-tendance physique de "u" (m/s/s)
316 !! d_v-----output-R-tendance physique de "v" (m/s/s)
317 !! d_t-----output-R-tendance physique de "t" (K/s)
318 !! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
319 !! d_ps----output-R-tendance physique de la pression au sol
320 !!======================================================================
321 integer jjmp1
322 ! parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
323 ! integer iip1
324 ! parameter (iip1=iim+1)
325
326 include "regdim.h"
327 include "dimsoil.h"
328 include "clesphys.h"
329 include "thermcell.h"
330 include "dimpft.h"
331 !======================================================================
332 LOGICAL, SAVE :: ok_volcan ! pour activer les diagnostics volcaniques
333 !$OMP THREADPRIVATE(ok_volcan)
334 INTEGER, SAVE :: flag_volc_surfstrat ! pour imposer le cool/heat rate à la surf ou dans la strato
335 !$OMP THREADPRIVATE(flag_volc_surfstrat)
336 LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
337 PARAMETER (ok_cvl=.TRUE.)
338 LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
339 PARAMETER (ok_gust=.FALSE.)
340 INTEGER, SAVE :: iflag_radia ! active ou non le rayonnement (MPL)
341 !$OMP THREADPRIVATE(iflag_radia)
342 !======================================================================
343 LOGICAL check ! Verifier la conservation du modele en eau
344 PARAMETER (check=.FALSE.)
345 LOGICAL ok_stratus ! Ajouter artificiellement les stratus
346 PARAMETER (ok_stratus=.FALSE.)
347 !======================================================================
348 REAL amn, amx
349 INTEGER igout
350 !======================================================================
351 ! Clef iflag_cycle_diurne controlant l'activation du cycle diurne:
352 ! en attente du codage des cles par Fred
353 ! iflag_cycle_diurne est initialise par conf_phys et se trouve
354 ! dans clesphys.h (IM)
355 !======================================================================
356 ! Modele thermique du sol, a activer pour le cycle diurne:
357 !cc LOGICAL soil_model
358 !cc PARAMETER (soil_model=.FALSE.)
359 !======================================================================
360 ! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
361 ! le calcul du rayonnement est celle apres la precipitation des nuages.
362 ! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
363 ! la condensation et la precipitation. Cette cle augmente les impacts
364 ! radiatifs des nuages.
365 !cc LOGICAL new_oliq
366 !cc PARAMETER (new_oliq=.FALSE.)
367 !======================================================================
368 ! Clefs controlant deux parametrisations de l'orographie:
369 !c LOGICAL ok_orodr
370 !cc PARAMETER (ok_orodr=.FALSE.)
371 !cc LOGICAL ok_orolf
372 !cc PARAMETER (ok_orolf=.FALSE.)
373 !======================================================================
374 LOGICAL ok_journe ! sortir le fichier journalier
375 SAVE ok_journe
376 !$OMP THREADPRIVATE(ok_journe)
377 !
378 LOGICAL ok_mensuel ! sortir le fichier mensuel
379 SAVE ok_mensuel
380 !$OMP THREADPRIVATE(ok_mensuel)
381 !
382 LOGICAL ok_instan ! sortir le fichier instantane
383 SAVE ok_instan
384 !$OMP THREADPRIVATE(ok_instan)
385 !
386 LOGICAL ok_LES ! sortir le fichier LES
387 SAVE ok_LES
388 !$OMP THREADPRIVATE(ok_LES)
389 !
390 LOGICAL callstats ! sortir le fichier stats
391 SAVE callstats
392 !$OMP THREADPRIVATE(callstats)
393 !
394 LOGICAL ok_region ! sortir le fichier regional
395 PARAMETER (ok_region=.FALSE.)
396 !======================================================================
397 REAL seuil_inversion
398 SAVE seuil_inversion
399 !$OMP THREADPRIVATE(seuil_inversion)
400 INTEGER iflag_ratqs
401 SAVE iflag_ratqs
402 !$OMP THREADPRIVATE(iflag_ratqs)
403 real facteur
404
405 960 REAL wmax_th(klon)
406 960 REAL tau_overturning_th(klon)
407
408 960 INTEGER lmax_th(klon)
409 960 INTEGER limbas(klon)
410 960 REAL ratqscth(klon,klev)
411 960 REAL ratqsdiff(klon,klev)
412 960 REAL zqsatth(klon,klev)
413
414 !======================================================================
415 !
416 INTEGER ivap ! indice de traceurs pour vapeur d'eau
417 PARAMETER (ivap=1)
418 INTEGER iliq ! indice de traceurs pour eau liquide
419 PARAMETER (iliq=2)
420 !CR: on ajoute la phase glace
421 INTEGER isol ! indice de traceurs pour eau glace
422 PARAMETER (isol=3)
423 !
424 !
425 ! Variables argument:
426 !
427 INTEGER nlon
428 INTEGER nlev
429 REAL,INTENT(IN) :: pdtphys_
430 ! NB: pdtphys to be used in physics is in time_phylmdz_mod
431 LOGICAL debut, lafin
432 REAL paprs(klon,klev+1)
433 REAL pplay(klon,klev)
434 REAL pphi(klon,klev)
435 REAL pphis(klon)
436 REAL presnivs(klev)
437 !JLD REAL znivsig(klev)
438 !JLD real pir
439
440 REAL u(klon,klev)
441 REAL v(klon,klev)
442
443 REAL, intent(in):: rot(klon, klev)
444 ! relative vorticity, in s-1, needed for frontal waves
445
446 960 REAL t(klon,klev),thetal(klon,klev)
447 ! thetal: ligne suivante a decommenter si vous avez les fichiers
448 ! MPL 20130625
449 ! fth_fonctions.F90 et parkind1.F90
450 ! sinon thetal=theta
451 ! REAL fth_thetae,fth_thetav,fth_thetal
452 REAL qx(klon,klev,nqtot)
453 REAL flxmass_w(klon,klev)
454 REAL d_u(klon,klev)
455 REAL d_v(klon,klev)
456 REAL d_t(klon,klev)
457 REAL d_qx(klon,klev,nqtot)
458 REAL d_ps(klon)
459 ! variables pour tend_to_tke
460 960 REAL duadd(klon,klev)
461 960 REAL dvadd(klon,klev)
462 960 REAL dtadd(klon,klev)
463
464 REAL, SAVE :: missing_val=nf90_fill_real
465 !! Variables moved to phys_local_var_mod
466 !! ! Variables pour le transport convectif
467 !! real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
468 !! real wght_cvfd(klon,klev)
469 !! ! Variables pour le lessivage convectif
470 !! ! RomP >>>
471 !! real phi2(klon,klev,klev)
472 !! real d1a(klon,klev),dam(klon,klev)
473 !! real ev(klon,klev)
474 !! real clw(klon,klev),elij(klon,klev,klev)
475 !! real epmlmMm(klon,klev,klev),eplaMm(klon,klev)
476 !! ! RomP <<<
477 !IM definition dynamique o_trac dans phys_output_open
478 ! type(ctrl_out) :: o_trac(nqtot)
479
480 ! variables a une pression donnee
481 !
482
483 !IM for NMC files
484 ! real twriteSTD(klon,nlevSTD,nfiles)
485 ! real qwriteSTD(klon,nlevSTD,nfiles)
486 ! real rhwriteSTD(klon,nlevSTD,nfiles)
487 ! real phiwriteSTD(klon,nlevSTD,nfiles)
488 ! real uwriteSTD(klon,nlevSTD,nfiles)
489 ! real vwriteSTD(klon,nlevSTD,nfiles)
490 ! real wwriteSTD(klon,nlevSTD,nfiles)
491
492 960 real twriteSTD3(klon,nlevSTD3)
493 960 real qwriteSTD3(klon,nlevSTD3)
494 960 real rhwriteSTD3(klon,nlevSTD3)
495 960 real phiwriteSTD3(klon,nlevSTD3)
496 960 real uwriteSTD3(klon,nlevSTD3)
497 960 real vwriteSTD3(klon,nlevSTD3)
498 960 real wwriteSTD3(klon,nlevSTD3)
499
500 960 real tnondefSTD8(klon,nlevSTD8)
501 960 real twriteSTD8(klon,nlevSTD8)
502 960 real qwriteSTD8(klon,nlevSTD8)
503 960 real rhwriteSTD8(klon,nlevSTD8)
504 960 real phiwriteSTD8(klon,nlevSTD8)
505 960 real uwriteSTD8(klon,nlevSTD8)
506 960 real vwriteSTD8(klon,nlevSTD8)
507 960 real wwriteSTD8(klon,nlevSTD8)
508
509 real, save :: rlevSTD(nlevSTD)
510 DATA rlevSTD/100000., 92500., 85000., 70000., &
511 60000., 50000., 40000., 30000., 25000., 20000., &
512 15000., 10000., 7000., 5000., 3000., 2000., 1000./
513 !$OMP THREADPRIVATE(rlevstd)
514
515 CHARACTER*4, SAVE :: clevSTD(nlevSTD)
516 DATA clevSTD/'1000','925 ','850 ','700 ','600 ', &
517 '500 ','400 ','300 ','250 ','200 ','150 ','100 ', &
518 '70 ','50 ','30 ','20 ','10 '/
519 !$OMP THREADPRIVATE(clevSTD)
520
521 real, save :: rlevSTD3(nlevSTD3)
522 DATA rlevSTD3/85000., 50000., 25000./
523 !$OMP THREADPRIVATE(rlevSTD3)
524
525 real, save :: rlevSTD8(nlevSTD8)
526 DATA rlevSTD8/100000., 85000., 70000., 50000., 25000., 10000., &
527 5000., 1000./
528 !$OMP THREADPRIVATE(rlevSTD8)
529 !
530 960 REAL geo500(klon)
531
532 ! nout : niveau de output des variables a une pression donnee
533 logical oknondef(klon,nlevSTD,nout)
534 !
535 ! les produits uvSTD, vqSTD, .., T2STD sont calcules
536 ! a partir des valeurs instantannees toutes les 6 h
537 ! qui sont moyennees sur le mois
538
539 REAL zx_tmp_fiNC(klon,nlevSTD)
540
541 ! REAL missing_val
542 REAL, SAVE :: freq_moyNMC(nout)
543 !$OMP THREADPRIVATE(freq_moyNMC)
544 !
545 !
546 include "radopt.h"
547 !
548 !
549 INTEGER debug
550 INTEGER n
551 !ym INTEGER npoints
552 !ym PARAMETER(npoints=klon)
553 !
554 INTEGER nregISCtot
555 PARAMETER(nregISCtot=1)
556 !
557 ! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties
558 ! sur 1 region rectangulaire y compris pour 1 point
559 ! imin_debut : indice minimum de i; nbpti : nombre de points en
560 ! direction i (longitude)
561 ! jmin_debut : indice minimum de j; nbptj : nombre de points en
562 ! direction j (latitude)
563 !JLD INTEGER imin_debut, nbpti
564 !JLD INTEGER jmin_debut, nbptj
565 !IM: region='3d' <==> sorties en global
566 CHARACTER*3 region
567 PARAMETER(region='3d')
568 LOGICAL ok_hf
569 !
570 SAVE ok_hf
571 !$OMP THREADPRIVATE(ok_hf)
572
573 INTEGER, PARAMETER :: longcles=20
574 REAL, SAVE :: clesphy0(longcles)
575 !$OMP THREADPRIVATE(clesphy0)
576 !
577 ! Variables propres a la physique
578 INTEGER, SAVE :: itap ! compteur pour la physique
579 !$OMP THREADPRIVATE(itap)
580
581 INTEGER, SAVE :: abortphy=0 ! Reprere si on doit arreter en fin de phys
582 !$OMP THREADPRIVATE(abortphy)
583 !
584 REAL,SAVE :: solarlong0
585 !$OMP THREADPRIVATE(solarlong0)
586
587 !
588 ! Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
589 !
590 !IM 141004 REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
591 960 REAL zulow(klon),zvlow(klon)
592 !
593 960 INTEGER igwd,idx(klon),itest(klon)
594 !
595 ! REAL,allocatable,save :: run_off_lic_0(:)
596 ! !$OMP THREADPRIVATE(run_off_lic_0)
597 !ym SAVE run_off_lic_0
598 !KE43
599 ! Variables liees a la convection de K. Emanuel (sb):
600 !
601 REAL, SAVE :: bas, top ! cloud base and top levels
602 !$OMP THREADPRIVATE(bas, top)
603 !------------------------------------------------------------------
604 ! Upmost level reached by deep convection and related variable (jyg)
605 !
606 INTEGER izero
607 INTEGER k_upper_cv
608 !------------------------------------------------------------------
609 ! Compteur de l'occurence de cvpas=1
610 INTEGER Ncvpaseq1
611 SAVE Ncvpaseq1
612 !$OMP THREADPRIVATE(Ncvpaseq1)
613 !
614 !==========================================================================
615 !CR04.12.07: on ajoute les nouvelles variables du nouveau schema
616 !de convection avec poches froides
617 ! Variables li\'ees \`a la poche froide (jyg)
618
619 !! REAL mipsh(klon,klev) ! mass flux shed by the adiab ascent at each level
620 !! Moved to phys_state_var_mod
621 !
622 REAL wape_prescr, fip_prescr
623 INTEGER it_wape_prescr
624 SAVE wape_prescr, fip_prescr, it_wape_prescr
625 !$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)
626 !
627 ! variables supplementaires de concvl
628 960 REAL Tconv(klon,klev)
629 !! variable moved to phys_local_var_mod
630 !! REAL sij(klon,klev,klev)
631 !! !
632 !! ! variables pour tester la conservation de l'energie dans concvl
633 !! REAL, DIMENSION(klon,klev) :: d_t_con_sat
634 !! REAL, DIMENSION(klon,klev) :: d_q_con_sat
635 !! REAL, DIMENSION(klon,klev) :: dql_sat
636
637 REAL, SAVE :: alp_bl_prescr=0.
638 REAL, SAVE :: ale_bl_prescr=0.
639 REAL, SAVE :: wake_s_min_lsp=0.1
640 !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
641 !$OMP THREADPRIVATE(wake_s_min_lsp)
642
643 960 REAL ok_wk_lsp(klon)
644
645 !RC
646 ! Variables li\'ees \`a la poche froide (jyg et rr)
647
648 INTEGER, SAVE :: iflag_wake_tend ! wake: if =0, then wake state variables are
649 ! updated within calwake
650 !$OMP THREADPRIVATE(iflag_wake_tend)
651 INTEGER, SAVE :: iflag_alp_wk_cond=0 ! wake: if =0, then Alp_wk is the average lifting
652 ! power provided by the wakes; else, Alp_wk is the
653 ! lifting power conditionned on the presence of a
654 ! gust-front in the grid cell.
655 !$OMP THREADPRIVATE(iflag_alp_wk_cond)
656
657 960 REAL t_w(klon,klev),q_w(klon,klev) ! temperature and moisture profiles in the wake region
658 960 REAL t_x(klon,klev),q_x(klon,klev) ! temperature and moisture profiles in the off-wake region
659
660 960 REAL wake_dth(klon,klev) ! wake : temp pot difference
661
662 960 REAL wake_omgbdth(klon,klev) ! Wake : flux of Delta_Theta
663 ! transported by LS omega
664 960 REAL wake_dp_omgb(klon,klev) ! Wake : vertical gradient of
665 ! large scale omega
666 960 REAL wake_dtKE(klon,klev) ! Wake : differential heating
667 ! (wake - unpertubed) CONV
668 960 REAL wake_dqKE(klon,klev) ! Wake : differential moistening
669 ! (wake - unpertubed) CONV
670 960 REAL wake_dp_deltomg(klon,klev) ! Wake : gradient vertical de wake_omg
671 960 REAL wake_spread(klon,klev) ! spreading term in wake_delt
672 !
673 !pourquoi y'a pas de save??
674 !
675 !!! INTEGER, SAVE, DIMENSION(klon) :: wake_k
676 !!! !$OMP THREADPRIVATE(wake_k)
677 !
678 !jyg<
679 !cc REAL wake_pe(klon) ! Wake potential energy - WAPE
680 !>jyg
681
682 960 REAL wake_fip_0(klon) ! Average Front Incoming Power (unconditionned)
683 960 REAL wake_gfl(klon) ! Gust Front Length
684 !!! REAL wake_dens(klon) ! moved to phys_state_var_mod
685 !
686 !
687 960 REAL dt_dwn(klon,klev)
688 960 REAL dq_dwn(klon,klev)
689 960 REAL M_dwn(klon,klev)
690 960 REAL M_up(klon,klev)
691 960 REAL dt_a(klon,klev)
692 960 REAL dq_a(klon,klev)
693 960 REAL d_t_adjwk(klon,klev) !jyg
694 960 REAL d_q_adjwk(klon,klev) !jyg
695 LOGICAL,SAVE :: ok_adjwk=.FALSE.
696 !$OMP THREADPRIVATE(ok_adjwk)
697 INTEGER,SAVE :: iflag_adjwk=0 !jyg
698 !$OMP THREADPRIVATE(iflag_adjwk) !jyg
699 REAL,SAVE :: oliqmax=999.,oicemax=999.
700 !$OMP THREADPRIVATE(oliqmax,oicemax)
701 REAL, SAVE :: alp_offset
702 !$OMP THREADPRIVATE(alp_offset)
703 REAL, SAVE :: dtcon_multistep_max=1.e6
704 !$OMP THREADPRIVATE(dtcon_multistep_max)
705 REAL, SAVE :: dqcon_multistep_max=1.e6
706 !$OMP THREADPRIVATE(dqcon_multistep_max)
707
708
709 !
710 !RR:fin declarations poches froides
711 !==========================================================================
712
713 960 REAL ztv(klon,klev),ztva(klon,klev)
714 960 REAL zpspsk(klon,klev)
715 960 REAL ztla(klon,klev),zqla(klon,klev)
716 960 REAL zthl(klon,klev)
717
718 !cc nrlmd le 10/04/2012
719
720 !--------Stochastic Boundary Layer Triggering: ALE_BL--------
721 !---Propri\'et\'es du thermiques au LCL
722 960 real zlcl_th(klon) ! Altitude du LCL calcul\'e
723 ! continument (pcon dans
724 ! thermcell_main.F90)
725 960 real fraca0(klon) ! Fraction des thermiques au LCL
726 960 real w0(klon) ! Vitesse des thermiques au LCL
727 960 real w_conv(klon) ! Vitesse verticale de grande \'echelle au LCL
728 960 real tke0(klon,klev+1) ! TKE au d\'ebut du pas de temps
729 960 real therm_tke_max0(klon) ! TKE dans les thermiques au LCL
730 960 real env_tke_max0(klon) ! TKE dans l'environnement au LCL
731
732 !JLD !---D\'eclenchement stochastique
733 !JLD integer :: tau_trig(klon)
734
735 REAL,SAVE :: random_notrig_max=1.
736 !$OMP THREADPRIVATE(random_notrig_max)
737
738 !--------Statistical Boundary Layer Closure: ALP_BL--------
739 !---Profils de TKE dans et hors du thermique
740 960 real therm_tke_max(klon,klev) ! Profil de TKE dans les thermiques
741 960 real env_tke_max(klon,klev) ! Profil de TKE dans l'environnement
742
743 !-------Activer les tendances de TKE due a l'orograp??ie---------
744 INTEGER, SAVE :: addtkeoro
745 !$OMP THREADPRIVATE(addtkeoro)
746 REAL, SAVE :: alphatkeoro
747 !$OMP THREADPRIVATE(alphatkeoro)
748 LOGICAL, SAVE :: smallscales_tkeoro
749 !$OMP THREADPRIVATE(smallscales_tkeoro)
750
751
752
753 !cc fin nrlmd le 10/04/2012
754
755 ! Variables locales pour la couche limite (al1):
756 !
757 !Al1 REAL pblh(klon) ! Hauteur de couche limite
758 !Al1 SAVE pblh
759 !34EK
760 !
761 ! Variables locales:
762 !
763 !AA
764 !AA Pour phytrac
765 960 REAL u1(klon) ! vents dans la premiere couche U
766 960 REAL v1(klon) ! vents dans la premiere couche V
767
768 !@$$ LOGICAL offline ! Controle du stockage ds "physique"
769 !@$$ PARAMETER (offline=.false.)
770 !@$$ INTEGER physid
771 960 REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
772 960 REAL frac_nucl(klon,klev) ! idem (nucleation)
773 ! RomP >>>
774 960 REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
775 ! RomP <<<
776 REAL :: calday
777
778 !IM cf FH pour Tiedtke 080604
779 960 REAL rain_tiedtke(klon),snow_tiedtke(klon)
780 !
781 !IM 050204 END
782 960 REAL devap(klon) ! evaporation et sa derivee
783 960 REAL dsens(klon) ! chaleur sensible et sa derivee
784
785 !
786 ! Conditions aux limites
787 !
788 !
789 REAL :: day_since_equinox
790 ! Date de l'equinoxe de printemps
791 INTEGER, parameter :: mth_eq=3, day_eq=21
792 REAL :: jD_eq
793
794 LOGICAL, parameter :: new_orbit = .TRUE.
795
796 !
797 INTEGER lmt_pas
798 SAVE lmt_pas ! frequence de mise a jour
799 !$OMP THREADPRIVATE(lmt_pas)
800 960 real zmasse(klon, nbp_lev),exner(klon, nbp_lev)
801 ! (column-density of mass of air in a cell, in kg m-2)
802 real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
803
804 !IM sorties
805 REAL un_jour
806 PARAMETER(un_jour=86400.)
807 INTEGER itapm1 !pas de temps de la physique du(es) mois precedents
808 SAVE itapm1 !mis a jour le dernier pas de temps du mois en cours
809 !$OMP THREADPRIVATE(itapm1)
810 !======================================================================
811 !
812 ! Declaration des procedures appelees
813 !
814 EXTERNAL angle ! calculer angle zenithal du soleil
815 EXTERNAL alboc ! calculer l'albedo sur ocean
816 EXTERNAL ajsec ! ajustement sec
817 EXTERNAL conlmd ! convection (schema LMD)
818 !KE43
819 EXTERNAL conema3 ! convect4.3
820 EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
821 !AA
822 ! JBM (3/14) fisrtilp_tr not loaded
823 ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
824 ! ! stockage des coefficients necessaires au
825 ! ! lessivage OFF-LINE et ON-LINE
826 EXTERNAL hgardfou ! verifier les temperatures
827 EXTERNAL nuage ! calculer les proprietes radiatives
828 !C EXTERNAL o3cm ! initialiser l'ozone
829 EXTERNAL orbite ! calculer l'orbite terrestre
830 EXTERNAL phyetat0 ! lire l'etat initial de la physique
831 EXTERNAL phyredem ! ecrire l'etat de redemarrage de la physique
832 EXTERNAL suphel ! initialiser certaines constantes
833 EXTERNAL transp ! transport total de l'eau et de l'energie
834 !IM
835 EXTERNAL haut2bas !variables de haut en bas
836 EXTERNAL ini_undefSTD !initialise a 0 une variable a 1 niveau de pression
837 EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression
838 ! EXTERNAL moy_undefSTD !moyenne d'1 var a 1 niveau de pression
839 ! EXTERNAL moyglo_aire
840 ! moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)
841 ! par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)
842 !
843 !
844 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
845 ! Local variables
846 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
847 !
848 960 REAL rhcl(klon,klev) ! humiditi relative ciel clair
849 960 REAL dialiq(klon,klev) ! eau liquide nuageuse
850 960 REAL diafra(klon,klev) ! fraction nuageuse
851 960 REAL cldliq(klon,klev) ! eau liquide nuageuse
852 !
853 !XXX PB
854 960 REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite
855 !
856 960 REAL zxfluxt(klon, klev)
857 960 REAL zxfluxq(klon, klev)
858 960 REAL zxfluxu(klon, klev)
859 960 REAL zxfluxv(klon, klev)
860
861 ! Le rayonnement n'est pas calcule tous les pas, il faut donc
862 ! sauvegarder les sorties du rayonnement
863 !ym SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
864 !ym SAVE sollwdownclr, toplwdown, toplwdownclr
865 !ym SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0
866 !
867 INTEGER itaprad
868 SAVE itaprad
869 !$OMP THREADPRIVATE(itaprad)
870 !
871 960 REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
872 960 REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
873 !
874 960 REAL zsav_tsol(klon)
875 !
876 960 REAL dist, rmu0(klon), fract(klon)
877 960 REAL zrmu0(klon), zfract(klon)
878 REAL zdtime, zdtime1, zdtime2, zlongi
879 !
880 REAL qcheck
881 960 REAL z_avant(klon), z_apres(klon), z_factor(klon)
882 LOGICAL zx_ajustq
883 !
884 REAL za
885 REAL zx_t, zx_qs, zdelta, zcor
886 960 real zqsat(klon,klev)
887 !
888 INTEGER i, k, iq, j, nsrf, ll, l
889 !
890 REAL t_coup
891 PARAMETER (t_coup=234.0)
892
893 !ym A voir plus tard !!
894 !ym REAL zx_relief(iim,jjmp1)
895 !ym REAL zx_aire(iim,jjmp1)
896 !
897 ! Grandeurs de sorties
898 960 REAL s_capCL(klon)
899 960 REAL s_oliqCL(klon), s_cteiCL(klon)
900 960 REAL s_trmb1(klon), s_trmb2(klon)
901 960 REAL s_trmb3(klon)
902
903 ! La convection n'est pas calculee tous les pas, il faut donc
904 ! sauvegarder les sorties de la convection
905 !ym SAVE
906 !ym SAVE
907 !ym SAVE
908 !
909 INTEGER itapcv, itapwk
910 SAVE itapcv, itapwk
911 !$OMP THREADPRIVATE(itapcv, itapwk)
912
913 !KE43
914 ! Variables locales pour la convection de K. Emanuel (sb):
915
916 960 REAL tvp(klon,klev) ! virtual temp of lifted parcel
917 CHARACTER*40 capemaxcels !max(CAPE)
918
919 REAL rflag(klon) ! flag fonctionnement de convect
920 960 INTEGER iflagctrl(klon) ! flag fonctionnement de convect
921
922 ! -- convect43:
923 INTEGER ntra ! nb traceurs pour convect4.3
924 960 REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
925 960 REAL dplcldt(klon), dplcldr(klon)
926 !? . condm_con(klon,klev),conda_con(klon,klev),
927 !? . mr_con(klon,klev),ep_con(klon,klev)
928 !? . ,sadiab(klon,klev),wadiab(klon,klev)
929 ! --
930 !34EK
931 !
932 ! Variables du changement
933 !
934 ! con: convection
935 ! lsc: condensation a grande echelle (Large-Scale-Condensation)
936 ! ajs: ajustement sec
937 ! eva: evaporation de l'eau liquide nuageuse
938 ! vdf: couche limite (Vertical DiFfusion)
939 !
940 ! tendance nulles
941 960 REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0
942 960 REAL, dimension(klon) :: dsig0, ddens0
943 960 INTEGER, dimension(klon) :: wkoccur1
944 ! tendance buffer pour appel de add_phys_tend
945 960 REAL, DIMENSION(klon,klev) :: d_q_ch4_dtime
946 !
947 ! Flag pour pouvoir ne pas ajouter les tendances.
948 ! Par defaut, les tendances doivente etre ajoutees et
949 ! flag_inhib_tend = 0
950 ! flag_inhib_tend > 0 : tendances non ajoutees, avec un nombre
951 ! croissant de print quand la valeur du flag augmente
952 !!! attention, ce flag doit etre change avec prudence !!!
953 INTEGER :: flag_inhib_tend = 0 ! 0 is the default value
954 !! INTEGER :: flag_inhib_tend = 2
955 !
956 ! Logical switch to a bug : reseting to 0 convective variables at the
957 ! begining of physiq.
958 LOGICAL, SAVE :: ok_bug_cv_trac = .TRUE.
959 !$OMP THREADPRIVATE(ok_bug_cv_trac)
960 !
961 ! Logical switch to a bug : changing wake_deltat when thermals are active
962 ! even when there are no wakes.
963 LOGICAL, SAVE :: ok_bug_split_th = .TRUE.
964 !$OMP THREADPRIVATE(ok_bug_split_th)
965
966 !
967 !********************************************************
968 ! declarations
969
970 !********************************************************
971 !IM 081204 END
972 !
973 960 REAL pen_u(klon,klev), pen_d(klon,klev)
974 960 REAL pde_u(klon,klev), pde_d(klon,klev)
975 960 INTEGER kcbot(klon), kctop(klon), kdtop(klon)
976 !
977 REAL ratqsbas,ratqshaut,tau_ratqs
978 SAVE ratqsbas,ratqshaut,tau_ratqs
979 !$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)
980 REAL, SAVE :: ratqsp0=50000., ratqsdp=20000.
981 !$OMP THREADPRIVATE(ratqsp0, ratqsdp)
982
983 ! Parametres lies au nouveau schema de nuages (SB, PDF)
984 REAL, SAVE :: fact_cldcon
985 REAL, SAVE :: facttemps
986 !$OMP THREADPRIVATE(fact_cldcon,facttemps)
987 LOGICAL, SAVE :: ok_newmicro
988 !$OMP THREADPRIVATE(ok_newmicro)
989
990 INTEGER, SAVE :: iflag_cld_th
991 !$OMP THREADPRIVATE(iflag_cld_th)
992 !IM logical ptconv(klon,klev) !passe dans phys_local_var_mod
993 !IM cf. AM 081204 BEG
994 960 LOGICAL ptconvth(klon,klev)
995 !IM cf. AM 081204 END
996 !
997 ! Variables liees a l'ecriture de la bande histoire physique
998 !
999 !======================================================================
1000 !
1001 !
1002 !JLD integer itau_w ! pas de temps ecriture = itap + itau_phy
1003 !
1004 !
1005 ! Variables locales pour effectuer les appels en serie
1006 !
1007 !IM RH a 2m (la surface)
1008 REAL Lheat
1009
1010 INTEGER length
1011 PARAMETER ( length = 100 )
1012 REAL tabcntr0( length )
1013 !
1014 !JLD INTEGER ndex2d(nbp_lon*nbp_lat)
1015 !IM
1016 !
1017 !IM AMIP2 BEG
1018 !JLD REAL moyglo, mountor
1019 !IM 141004 BEG
1020 960 REAL zustrdr(klon), zvstrdr(klon)
1021 960 REAL zustrli(klon), zvstrli(klon)
1022 960 REAL zustrph(klon), zvstrph(klon)
1023 REAL aam, torsfc
1024 !IM 141004 END
1025 !IM 190504 BEG
1026 ! INTEGER imp1jmp1
1027 ! PARAMETER(imp1jmp1=(iim+1)*jjmp1)
1028 !ym A voir plus tard
1029 ! REAL zx_tmp((nbp_lon+1)*nbp_lat)
1030 ! REAL airedyn(nbp_lon+1,nbp_lat)
1031 !IM 190504 END
1032 !JLD LOGICAL ok_msk
1033 !JLD REAL msk(klon)
1034 !ym A voir plus tard
1035 !ym REAL zm_wo(jjmp1, klev)
1036 !IM AMIP2 END
1037 !
1038 960 REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
1039 960 REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
1040 !JLD REAL zx_tmp_2d(nbp_lon,nbp_lat)
1041 !JLD REAL zx_lon(nbp_lon,nbp_lat)
1042 !JLD REAL zx_lat(nbp_lon,nbp_lat)
1043 !
1044 INTEGER nid_ctesGCM
1045 SAVE nid_ctesGCM
1046 !$OMP THREADPRIVATE(nid_ctesGCM)
1047 !
1048 !IM 280405 BEG
1049 ! INTEGER nid_bilKPins, nid_bilKPave
1050 ! SAVE nid_bilKPins, nid_bilKPave
1051 ! !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)
1052 !
1053 REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
1054 REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert.
1055 REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert.
1056 REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert.
1057 !
1058 !JLD REAL zjulian
1059 !JLD SAVE zjulian
1060 !JLD!$OMP THREADPRIVATE(zjulian)
1061
1062 !JLD INTEGER nhori, nvert
1063 !JLD REAL zsto
1064 !JLD REAL zstophy, zout
1065
1066 CHARACTER (LEN=20) :: modname='physiq_mod'
1067 CHARACTER*80 message, abort_message
1068 LOGICAL, SAVE :: ok_sync, ok_sync_omp
1069 !$OMP THREADPRIVATE(ok_sync)
1070 REAL date0
1071
1072 ! essai writephys
1073 INTEGER fid_day, fid_mth, fid_ins
1074 PARAMETER (fid_ins = 1, fid_day = 2, fid_mth = 3)
1075 INTEGER prof2d_on, prof3d_on, prof2d_av, prof3d_av
1076 PARAMETER (prof2d_on = 1, prof3d_on = 2, prof2d_av = 3, prof3d_av = 4)
1077 960 REAL ztsol(klon)
1078 960 REAL q2m(klon,nbsrf) ! humidite a 2m
1079
1080 !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
1081 CHARACTER*40 t2mincels, t2maxcels !t2m min., t2m max
1082 CHARACTER*40 tinst, tave
1083 960 REAL cldtaupi(klon,klev) ! Cloud optical thickness for
1084 ! pre-industrial (pi) aerosols
1085
1086 INTEGER :: naero
1087 ! Aerosol optical properties
1088 CHARACTER*4, DIMENSION(naero_grp) :: rfname
1089 960 REAL, DIMENSION(klon,klev) :: mass_solu_aero ! total mass
1090 ! concentration
1091 ! for all soluble
1092 ! aerosols[ug/m3]
1093 960 REAL, DIMENSION(klon,klev) :: mass_solu_aero_pi
1094 ! - " - (pre-industrial value)
1095
1096 ! Parameters
1097 LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not
1098 LOGICAL ok_alw ! Apply aerosol LW effect or not
1099 LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013)
1100 REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
1101 SAVE ok_ade, ok_aie, ok_alw, ok_cdnc, bl95_b0, bl95_b1
1102 !$OMP THREADPRIVATE(ok_ade, ok_aie, ok_alw, ok_cdnc, bl95_b0, bl95_b1)
1103 LOGICAL, SAVE :: aerosol_couple ! true : calcul des aerosols dans INCA
1104 ! false : lecture des aerosol dans un fichier
1105 !$OMP THREADPRIVATE(aerosol_couple)
1106 LOGICAL, SAVE :: chemistry_couple ! true : use INCA chemistry O3
1107 ! false : use offline chemistry O3
1108 !$OMP THREADPRIVATE(chemistry_couple)
1109 INTEGER, SAVE :: flag_aerosol
1110 !$OMP THREADPRIVATE(flag_aerosol)
1111 LOGICAL, SAVE :: flag_bc_internal_mixture
1112 !$OMP THREADPRIVATE(flag_bc_internal_mixture)
1113 !
1114 !--STRAT AEROSOL
1115 INTEGER, SAVE :: flag_aerosol_strat
1116 !$OMP THREADPRIVATE(flag_aerosol_strat)
1117 !
1118 !--INTERACTIVE AEROSOL FEEDBACK ON RADIATION
1119 LOGICAL, SAVE :: flag_aer_feedback
1120 !$OMP THREADPRIVATE(flag_aer_feedback)
1121
1122 !c-fin STRAT AEROSOL
1123 !
1124 ! Declaration des constantes et des fonctions thermodynamiques
1125 !
1126 LOGICAL,SAVE :: first=.TRUE.
1127 !$OMP THREADPRIVATE(first)
1128
1129 ! VARIABLES RELATED TO OZONE CLIMATOLOGIES ; all are OpenMP shared
1130 ! Note that pressure vectors are in Pa and in stricly ascending order
1131 INTEGER,SAVE :: read_climoz ! Read ozone climatology
1132 ! (let it keep the default OpenMP shared attribute)
1133 ! Allowed values are 0, 1 and 2
1134 ! 0: do not read an ozone climatology
1135 ! 1: read a single ozone climatology that will be used day and night
1136 ! 2: read two ozone climatologies, the average day and night
1137 ! climatology and the daylight climatology
1138 INTEGER,SAVE :: ncid_climoz ! NetCDF file identifier
1139 REAL, POINTER, SAVE :: press_cen_climoz(:) ! Pressure levels
1140 REAL, POINTER, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
1141 REAL, POINTER, SAVE :: time_climoz(:) ! Time vector
1142 CHARACTER(LEN=13), PARAMETER :: vars_climoz(2) &
1143 = ["tro3 ","tro3_daylight"]
1144 ! vars_climoz(1:read_climoz): variables names in climoz file.
1145 ! vars_climoz(1:read_climoz-2) if read_climoz>2 (temporary)
1146 REAL :: ro3i ! 0<=ro3i<=360 ; required time index in NetCDF file for
1147 ! the ozone fields, old method.
1148
1149 include "YOMCST.h"
1150 include "YOETHF.h"
1151 include "FCTTRE.h"
1152 !IM 100106 BEG : pouvoir sortir les ctes de la physique
1153 include "conema3.h"
1154 include "fisrtilp.h"
1155 include "nuage.h"
1156 include "compbl.h"
1157 !IM 100106 END : pouvoir sortir les ctes de la physique
1158 !
1159 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1160 ! Declarations pour Simulateur COSP
1161 !============================================================
1162 real :: mr_ozone(klon,klev), phicosp(klon,klev)
1163
1164 !IM stations CFMIP
1165 INTEGER, SAVE :: nCFMIP
1166 !$OMP THREADPRIVATE(nCFMIP)
1167 INTEGER, PARAMETER :: npCFMIP=120
1168 INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:)
1169 REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:)
1170 !$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP)
1171 INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:)
1172 REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:)
1173 !$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM)
1174 INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
1175 !$OMP THREADPRIVATE(iGCM, jGCM)
1176 logical, dimension(nfiles) :: phys_out_filestations
1177 logical, parameter :: lNMC=.FALSE.
1178
1179 !IM betaCRF
1180 REAL, SAVE :: pfree, beta_pbl, beta_free
1181 !$OMP THREADPRIVATE(pfree, beta_pbl, beta_free)
1182 REAL, SAVE :: lon1_beta, lon2_beta, lat1_beta, lat2_beta
1183 !$OMP THREADPRIVATE(lon1_beta, lon2_beta, lat1_beta, lat2_beta)
1184 LOGICAL, SAVE :: mskocean_beta
1185 !$OMP THREADPRIVATE(mskocean_beta)
1186 960 REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et
1187 ! cldemirad pour evaluer les
1188 ! retros liees aux CRF
1189 960 REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique
1190 ! pour radlwsw pour
1191 ! tester "CRF off"
1192 960 REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique
1193 ! pour radlwsw pour
1194 ! tester "CRF off"
1195 960 REAL, dimension(klon, klev) :: cldemirad ! emissivite pour
1196 ! radlwsw pour tester
1197 ! "CRF off"
1198 960 REAL, dimension(klon, klev) :: cldfrarad ! fraction nuageuse
1199
1200 960 REAL, DIMENSION(klon,nbtr) :: init_source
1201
1202 !lwoff=y : offset LW CRE for radiation code and other schemes
1203 REAL, SAVE :: betalwoff
1204 !OMP THREADPRIVATE(betalwoff)
1205 !
1206 INTEGER :: nbtr_tmp ! Number of tracer inside concvl
1207 960 REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
1208 960 REAL, dimension(klon,klev) :: ch_in ! Condensed humidity entering in phytrac (eau liquide)
1209 integer iostat
1210
1211 REAL zzz
1212 !albedo SB >>>
1213 REAL,DIMENSION(6), SAVE :: SFRWL
1214 !$OMP THREADPRIVATE(SFRWL)
1215 !albedo SB <<<
1216
1217 !--OB variables for mass fixer (hard coded for now)
1218 LOGICAL, PARAMETER :: mass_fixer=.FALSE.
1219 REAL qql1(klon),qql2(klon),corrqql
1220
1221 REAL pi
1222
1223 pi = 4. * ATAN(1.)
1224
1225 ! set-up call to alerte function
1226
3/4
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
480 call_alert = (alert_first_call .AND. is_master)
1227
1228 ! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
1229 480 jjmp1=nbp_lat
1230
1231 !======================================================================
1232 ! Gestion calendrier : mise a jour du module phys_cal_mod
1233 !
1234 480 pdtphys=pdtphys_
1235 480 CALL update_time(pdtphys)
1236 480 phys_tstep=NINT(pdtphys)
1237
1238 !======================================================================
1239 ! Ecriture eventuelle d'un profil verticale en entree de la physique.
1240 ! Utilise notamment en 1D mais peut etre active egalement en 3D
1241 ! en imposant la valeur de igout.
1242 !======================================================================d
1243
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level.ge.1) THEN
1244 igout=klon/2+1/klon
1245 write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
1246 write(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), &
1247 longitude_deg(igout)
1248 write(lunout,*) &
1249 'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
1250 write(lunout,*) &
1251 nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys
1252
1253 write(lunout,*) 'paprs, play, phi, u, v, t'
1254 DO k=1,klev
1255 write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
1256 u(igout,k),v(igout,k),t(igout,k)
1257 ENDDO
1258 write(lunout,*) 'ovap (g/kg), oliq (g/kg)'
1259 DO k=1,klev
1260 write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
1261 ENDDO
1262 ENDIF
1263
1264 ! Quick check on pressure levels:
1265 CALL assert(paprs(:, nbp_lev + 1) < paprs(:, nbp_lev), &
1266
3/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
477600 "physiq_mod paprs bad order")
1267
1268
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF (first) THEN
1269 1 CALL init_etat0_limit_unstruct
1270
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
1271 !CR:nvelles variables convection/poches froides
1272
1273 1 WRITE(lunout,*) '================================================='
1274 1 WRITE(lunout,*) 'Allocation des variables locales et sauvegardees'
1275 1 WRITE(lunout,*) '================================================='
1276 1 CALL phys_local_var_init
1277 !
1278 ! appel a la lecture du run.def physique
1279 CALL conf_phys(ok_journe, ok_mensuel, &
1280 ok_instan, ok_hf, &
1281 ok_LES, &
1282 callstats, &
1283 solarlong0,seuil_inversion, &
1284 fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
1285 iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
1286 ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, &
1287 chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
1288 flag_bc_internal_mixture, bl95_b0, bl95_b1, &
1289 ! nv flags pour la convection et les
1290 ! poches froides
1291 read_climoz, &
1292 1 alp_offset)
1293 1 CALL phys_state_var_init(read_climoz)
1294 1 CALL phys_output_var_init
1295
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
1 IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) &
1296 CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
1297
1298
1299 1 print*, '================================================='
1300 !
1301 !CR: check sur le nb de traceurs de l eau
1302
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
1 IF ((iflag_ice_thermo.gt.0).and.(nqo==2)) THEN
1303 WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
1304 '(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.'
1305 abort_message='see above'
1306 CALL abort_physic(modname,abort_message,1)
1307 ENDIF
1308
1309 1 Ncvpaseq1 = 0
1310
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 dnwd0=0.0
1311
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 ftd=0.0
1312
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 fqd=0.0
1313
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 cin=0.
1314 !ym Attention pbase pas initialise dans concvl !!!!
1315
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 pbase=0
1316 !IM 180608
1317
1318
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 itau_con=0
1319 1 first=.FALSE.
1320
1321 ENDIF ! first
1322
1323 !ym => necessaire pour iflag_con != 2
1324
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 pmfd(:,:) = 0.
1325
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 pen_u(:,:) = 0.
1326
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 pen_d(:,:) = 0.
1327
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 pde_d(:,:) = 0.
1328
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 pde_u(:,:) = 0.
1329 480 aam=0.
1330
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_t_adjwk(:,:)=0
1331
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_q_adjwk(:,:)=0
1332
1333
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 alp_bl_conv(:)=0.
1334
1335 480 torsfc=0.
1336
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
1337
1338
1339
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF (debut) THEN
1340 1 CALL suphel ! initialiser constantes et parametres phys.
1341 ! tau_gl : constante de rappel de la temperature a la surface de la glace - en
1342 1 tau_gl=5.
1343 1 CALL getin_p('tau_gl', tau_gl)
1344 ! tau_gl : constante de rappel de la temperature a la surface de la glace - en
1345 ! secondes
1346 1 tau_gl=86400.*tau_gl
1347 1 WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl
1348
1349 1 CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond)
1350 1 CALL getin_p('random_notrig_max',random_notrig_max)
1351 1 CALL getin_p('ok_adjwk',ok_adjwk)
1352
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ok_adjwk) iflag_adjwk=2 ! for compatibility with older versions
1353 ! iflag_adjwk: ! 0 = Default: no convective adjustment of w-region
1354 ! 1 => convective adjustment but state variables are unchanged
1355 ! 2 => convective adjustment and state variables are changed
1356 1 CALL getin_p('iflag_adjwk',iflag_adjwk)
1357 1 CALL getin_p('dtcon_multistep_max',dtcon_multistep_max)
1358 1 CALL getin_p('dqcon_multistep_max',dqcon_multistep_max)
1359 1 CALL getin_p('oliqmax',oliqmax)
1360 1 CALL getin_p('oicemax',oicemax)
1361 1 CALL getin_p('ratqsp0',ratqsp0)
1362 1 CALL getin_p('ratqsdp',ratqsdp)
1363 1 iflag_wake_tend = 0
1364 1 CALL getin_p('iflag_wake_tend',iflag_wake_tend)
1365 1 ok_bad_ecmwf_thermo=.TRUE. ! By default thermodynamical constants are set
1366 ! in rrtm/suphec.F90 (and rvtmp2 is set to 0).
1367 1 CALL getin_p('ok_bad_ecmwf_thermo',ok_bad_ecmwf_thermo)
1368 1 CALL getin_p('ok_bug_cv_trac',ok_bug_cv_trac)
1369 1 CALL getin_p('ok_bug_split_th',ok_bug_split_th)
1370 1 fl_ebil = 0 ! by default, conservation diagnostics are desactivated
1371 1 CALL getin_p('fl_ebil',fl_ebil)
1372 1 fl_cor_ebil = 0 ! by default, no correction to ensure energy conservation
1373 1 CALL getin_p('fl_cor_ebil',fl_cor_ebil)
1374 1 iflag_phytrac = 1 ! by default we do want to call phytrac
1375 1 CALL getin_p('iflag_phytrac',iflag_phytrac)
1376 1 nvm_lmdz = 13
1377 1 CALL getin_p('NVM',nvm_lmdz)
1378
1379 1 WRITE(lunout,*) 'iflag_alp_wk_cond=', iflag_alp_wk_cond
1380 1 WRITE(lunout,*) 'random_ntrig_max=', random_notrig_max
1381 1 WRITE(lunout,*) 'ok_adjwk=', ok_adjwk
1382 1 WRITE(lunout,*) 'iflag_adjwk=', iflag_adjwk
1383 1 WRITE(lunout,*) 'qtcon_multistep_max=',dtcon_multistep_max
1384 1 WRITE(lunout,*) 'qdcon_multistep_max=',dqcon_multistep_max
1385 1 WRITE(lunout,*) 'ratqsp0=', ratqsp0
1386 1 WRITE(lunout,*) 'ratqsdp=', ratqsdp
1387 1 WRITE(lunout,*) 'iflag_wake_tend=', iflag_wake_tend
1388 1 WRITE(lunout,*) 'ok_bad_ecmwf_thermo=',ok_bad_ecmwf_thermo
1389 1 WRITE(lunout,*) 'ok_bug_cv_trac=', ok_bug_cv_trac
1390 1 WRITE(lunout,*) 'ok_bug_split_th=', ok_bug_split_th
1391 1 WRITE(lunout,*) 'fl_ebil=', fl_ebil
1392 1 WRITE(lunout,*) 'fl_cor_ebil=', fl_cor_ebil
1393 1 WRITE(lunout,*) 'iflag_phytrac=', iflag_phytrac
1394 1 WRITE(lunout,*) 'NVM=', nvm_lmdz
1395
1396 !--PC: defining fields to be exchanged between LMDz, ORCHIDEE and NEMO
1397 1 WRITE(lunout,*) 'Call to infocfields from physiq'
1398 1 CALL infocfields_init
1399
1400 ENDIF
1401
1402
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level.ge.1) print *,'CONVERGENCE PHYSIQUE THERM 1 '
1403
1404 !======================================================================
1405 ! Gestion calendrier : mise a jour du module phys_cal_mod
1406 !
1407 ! CALL phys_cal_update(jD_cur,jH_cur)
1408
1409 !
1410 ! Si c'est le debut, il faut initialiser plusieurs choses
1411 ! ********
1412 !
1413
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF (debut) THEN
1414 !rv CRinitialisation de wght_th et lalim_conv pour la
1415 !definition de la couche alimentation de la convection a partir
1416 !des caracteristiques du thermique
1417
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 wght_th(:,:)=1.
1418
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 lalim_conv(:)=1
1419 !RC
1420
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 ustar(:,:)=0.
1421 ! u10m(:,:)=0.
1422 ! v10m(:,:)=0.
1423
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 rain_con(:)=0.
1424
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 snow_con(:)=0.
1425
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 topswai(:)=0.
1426
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 topswad(:)=0.
1427
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 solswai(:)=0.
1428
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 solswad(:)=0.
1429
1430
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 wmax_th(:)=0.
1431
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 tau_overturning_th(:)=0.
1432
1433
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
1 IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
1434 ! jg : initialisation jusqu'au ces variables sont dans restart
1435 ccm(:,:,:) = 0.
1436 tau_aero(:,:,:,:) = 0.
1437 piz_aero(:,:,:,:) = 0.
1438 cg_aero(:,:,:,:) = 0.
1439
1440 config_inca='none' ! default
1441 CALL getin_p('config_inca',config_inca)
1442
1443 ELSE
1444 1 config_inca='none' ! default
1445 ENDIF
1446
1447
8/8
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 26 times.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 1014 times.
✓ Branch 5 taken 26 times.
✓ Branch 6 taken 1007916 times.
✓ Branch 7 taken 1014 times.
1008959 tau_aero(:,:,:,:) = 1.e-15
1448
8/8
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 26 times.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 1014 times.
✓ Branch 5 taken 26 times.
✓ Branch 6 taken 1007916 times.
✓ Branch 7 taken 1014 times.
1008959 piz_aero(:,:,:,:) = 1.
1449
8/8
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 26 times.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 1014 times.
✓ Branch 5 taken 26 times.
✓ Branch 6 taken 1007916 times.
✓ Branch 7 taken 1014 times.
1008959 cg_aero(:,:,:,:) = 0.
1450
1451
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
1 IF (aerosol_couple .AND. (config_inca /= "aero" &
1452 .AND. config_inca /= "aeNP ")) THEN
1453 abort_message &
1454 = 'if aerosol_couple is activated, config_inca need to be ' &
1455 // 'aero or aeNP'
1456 CALL abort_physic (modname,abort_message,1)
1457 ENDIF
1458
1459
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 rnebcon0(:,:) = 0.0
1460
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 clwcon0(:,:) = 0.0
1461
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 rnebcon(:,:) = 0.0
1462
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 clwcon(:,:) = 0.0
1463
1464 !
1465 1 print*,'iflag_coupl,iflag_clos,iflag_wake', &
1466 2 iflag_coupl,iflag_clos,iflag_wake
1467 1 print*,'iflag_cycle_diurne', iflag_cycle_diurne
1468 !
1469
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
1 IF (iflag_con.EQ.2.AND.iflag_cld_th.GT.-1) THEN
1470 abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
1471 CALL abort_physic (modname,abort_message,1)
1472 ENDIF
1473 !
1474 !
1475 ! Initialiser les compteurs:
1476 !
1477 1 itap = 0
1478 1 itaprad = 0
1479 1 itapcv = 0
1480 1 itapwk = 0
1481
1482 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1483 !! Un petit travail \`a faire ici.
1484 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1485
1486
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (iflag_pbl>1) THEN
1487 1 PRINT*, "Using method MELLOR&YAMADA"
1488 ENDIF
1489
1490 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1491 ! FH 2008/05/02 changement lie a la lecture de nbapp_rad dans
1492 ! phylmd plutot que dyn3d
1493 ! Attention : la version precedente n'etait pas tres propre.
1494 ! Il se peut qu'il faille prendre une valeur differente de nbapp_rad
1495 ! pour obtenir le meme resultat.
1496 !jyg for fh<
1497 1 WRITE(lunout,*) 'Pas de temps phys_tstep pdtphys ',phys_tstep,pdtphys
1498
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (abs(phys_tstep-pdtphys)>1.e-10) THEN
1499 abort_message='pas de temps doit etre entier en seconde pour orchidee et XIOS'
1500 CALL abort_physic(modname,abort_message,1)
1501 ENDIF
1502 !>jyg
1503
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (MOD(NINT(86400./phys_tstep),nbapp_rad).EQ.0) THEN
1504 1 radpas = NINT( 86400./phys_tstep)/nbapp_rad
1505 ELSE
1506 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
1507 'multiple de nbapp_rad'
1508 WRITE(lunout,*) 'changer nbapp_rad ou alors commenter ce test ', &
1509 'mais 1+1<>2'
1510 abort_message='nbre de pas de temps physique n est pas multiple ' &
1511 // 'de nbapp_rad'
1512 CALL abort_physic(modname,abort_message,1)
1513 ENDIF
1514
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (nbapp_cv .EQ. 0) nbapp_cv=86400./phys_tstep
1515
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (nbapp_wk .EQ. 0) nbapp_wk=86400./phys_tstep
1516 1 print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk
1517
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (MOD(NINT(86400./phys_tstep),nbapp_cv).EQ.0) THEN
1518 1 cvpas_0 = NINT( 86400./phys_tstep)/nbapp_cv
1519 1 cvpas = cvpas_0
1520 1 print *,'physiq, cvpas ',cvpas
1521 ELSE
1522 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
1523 'multiple de nbapp_cv'
1524 WRITE(lunout,*) 'changer nbapp_cv ou alors commenter ce test ', &
1525 'mais 1+1<>2'
1526 abort_message='nbre de pas de temps physique n est pas multiple ' &
1527 // 'de nbapp_cv'
1528 CALL abort_physic(modname,abort_message,1)
1529 ENDIF
1530
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (MOD(NINT(86400./phys_tstep),nbapp_wk).EQ.0) THEN
1531 1 wkpas = NINT( 86400./phys_tstep)/nbapp_wk
1532 ! print *,'physiq, wkpas ',wkpas
1533 ELSE
1534 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
1535 'multiple de nbapp_wk'
1536 WRITE(lunout,*) 'changer nbapp_wk ou alors commenter ce test ', &
1537 'mais 1+1<>2'
1538 abort_message='nbre de pas de temps physique n est pas multiple ' &
1539 // 'de nbapp_wk'
1540 CALL abort_physic(modname,abort_message,1)
1541 ENDIF
1542 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1543 1 CALL init_iophy_new(latitude_deg,longitude_deg)
1544
1545 !===================================================================
1546 !IM stations CFMIP
1547 1 nCFMIP=npCFMIP
1548 OPEN(98,file='npCFMIP_param.data',status='old', &
1549 1 form='formatted',iostat=iostat)
1550
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (iostat == 0) THEN
1551 READ(98,*,end=998) nCFMIP
1552 998 CONTINUE
1553 CLOSE(98)
1554 CONTINUE
1555 IF(nCFMIP.GT.npCFMIP) THEN
1556 print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
1557 CALL abort_physic("physiq", "", 1)
1558 ELSE
1559 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
1560 ENDIF
1561
1562 !
1563 ALLOCATE(tabCFMIP(nCFMIP))
1564 ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
1565 ALLOCATE(tabijGCM(nCFMIP))
1566 ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
1567 ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))
1568 !
1569 ! lecture des nCFMIP stations CFMIP, de leur numero
1570 ! et des coordonnees geographiques lonCFMIP, latCFMIP
1571 !
1572 CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, &
1573 lonCFMIP, latCFMIP)
1574 !
1575 ! identification des
1576 ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la
1577 ! grille de LMDZ
1578 ! 2) indices points tabijGCM de la grille physique 1d sur
1579 ! klon points
1580 ! 3) indices iGCM, jGCM de la grille physique 2d
1581 !
1582 CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
1583 tabijGCM, lonGCM, latGCM, iGCM, jGCM)
1584 !
1585 ELSE
1586
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
1 ALLOCATE(tabijGCM(0))
1587
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
1 ALLOCATE(lonGCM(0), latGCM(0))
1588
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
1 ALLOCATE(iGCM(0), jGCM(0))
1589 ENDIF
1590
1591
1592 !$OMP MASTER
1593 ! FH : if ok_sync=.true. , the time axis is written at each time step
1594 ! in the output files. Only at the end in the opposite case
1595 1 ok_sync_omp=.FALSE.
1596 1 CALL getin('ok_sync',ok_sync_omp)
1597 CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
1598 iGCM,jGCM,lonGCM,latGCM, &
1599 jjmp1,nlevSTD,clevSTD,rlevSTD, phys_tstep,ok_veget, &
1600 type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
1601 ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, &
1602 read_climoz, phys_out_filestations, &
1603 aerosol_couple, &
1604 flag_aerosol_strat, pdtphys, paprs, pphis, &
1605 pplay, lmax_th, ptconv, ptconvth, ivap, &
1606 1 d_u, d_t, qx, d_qx, zmasse, ok_sync_omp)
1607 !$OMP END MASTER
1608 !$OMP BARRIER
1609 1 ok_sync=ok_sync_omp
1610
1611 1 freq_outNMC(1) = ecrit_files(7)
1612 1 freq_outNMC(2) = ecrit_files(8)
1613 1 freq_outNMC(3) = ecrit_files(9)
1614 1 WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
1615 1 WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
1616 1 WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)
1617
1618 1 CALL ini_paramLMDZ_phy(phys_tstep,nid_ctesGCM)
1619
1620 1 ecrit_reg = ecrit_reg * un_jour
1621 1 ecrit_tra = ecrit_tra * un_jour
1622
1623 !XXXPB Positionner date0 pour initialisation de ORCHIDEE
1624 1 date0 = jD_ref
1625 1 WRITE(*,*) 'physiq date0 : ',date0
1626 !
1627
1628 ! CALL create_climoz(read_climoz)
1629
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol) !! initialise aero from file for XIOS interpolation (unstructured_grid)
1630
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat) !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
1631
1632
1633
1634
1635 !
1636 !
1637 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1638 ! Nouvelle initialisation pour le rayonnement RRTM
1639 !
1640 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1641
1642
1/2
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
1 CALL iniradia(klon,klev,paprs(1,1:klev+1))
1643 !
1644 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1645 ! Initialisation des champs dans phytrac* qui sont utilises par phys_output_write*
1646 !
1647 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1648
1649 ! phys_output_write écrit des variables traceurs seulement si iflag_phytrac == 1
1650 ! donc seulement dans ce cas on doit appeler phytrac_init()
1651
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (iflag_phytrac == 1 ) THEN
1652 1 CALL phytrac_init()
1653 ENDIF
1654 CALL phys_output_write(itap, pdtphys, paprs, pphis, &
1655 pplay, lmax_th, aerosol_couple, &
1656 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ok_sync,&
1657 ptconv, read_climoz, clevSTD, &
1658 ptconvth, d_u, d_t, qx, d_qx, zmasse, &
1659 1 flag_aerosol, flag_aerosol_strat, ok_cdnc)
1660
1661
1662
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
1 IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
1663 1 CALL create_etat0_limit_unstruct
1664 1 CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
1665
1666 !jyg<
1667
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (iflag_pbl<=1) THEN
1668 ! No TKE for Standard Physics
1669 pbl_tke(:,:,:)=0.
1670
1671
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 ELSE IF (klon_glo==1) THEN
1672 pbl_tke(:,:,is_ave) = 0.
1673 DO nsrf=1,nbsrf
1674 DO k = 1,klev+1
1675 pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
1676 +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
1677 ENDDO
1678 ENDDO
1679 ELSE
1680
4/4
✓ Branch 0 taken 40 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 39760 times.
✓ Branch 3 taken 40 times.
39801 pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
1681 !>jyg
1682 ENDIF
1683 !IM begin
1684 1 print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
1685 2 ,ratqs(1,1)
1686 !IM end
1687
1688
1689 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1690 !
1691 ! on remet le calendrier a zero
1692 !
1693
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (raz_date .eq. 1) THEN
1694 1 itau_phy = 0
1695 ENDIF
1696
1697 ! IF (ABS(phys_tstep-pdtphys).GT.0.001) THEN
1698 ! WRITE(lunout,*) 'Pas physique n est pas correct',phys_tstep, &
1699 ! pdtphys
1700 ! abort_message='Pas physique n est pas correct '
1701 ! ! call abort_physic(modname,abort_message,1)
1702 ! phys_tstep=pdtphys
1703 ! ENDIF
1704
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (nlon .NE. klon) THEN
1705 WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, &
1706 klon
1707 abort_message='nlon et klon ne sont pas coherents'
1708 CALL abort_physic(modname,abort_message,1)
1709 ENDIF
1710
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (nlev .NE. klev) THEN
1711 WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, &
1712 klev
1713 abort_message='nlev et klev ne sont pas coherents'
1714 CALL abort_physic(modname,abort_message,1)
1715 ENDIF
1716 !
1717
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
1 IF (phys_tstep*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN
1718 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
1719 WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
1720 abort_message='Nbre d appels au rayonnement insuffisant'
1721 CALL abort_physic(modname,abort_message,1)
1722 ENDIF
1723
1724 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1725 ! Initialisation pour la convection de K.E. et pour les poches froides
1726 !
1727 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1728
1729 1 WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
1730 1 WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", ok_cvl
1731 !
1732 !KE43
1733 ! Initialisation pour la convection de K.E. (sb):
1734
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (iflag_con.GE.3) THEN
1735
1736 1 WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3 "
1737 WRITE(lunout,*) &
1738 1 "On va utiliser le melange convectif des traceurs qui"
1739 1 WRITE(lunout,*)"est calcule dans convect4.3"
1740 1 WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
1741
1742
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 DO i = 1, klon
1743 994 ema_cbmf(i) = 0.
1744 994 ema_pcb(i) = 0.
1745 995 ema_pct(i) = 0.
1746 ! ema_workcbmf(i) = 0.
1747 ENDDO
1748 !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG
1749
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 DO i = 1, klon
1750 994 ibas_con(i) = 1
1751 995 itop_con(i) = 1
1752 ENDDO
1753 !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END
1754 !================================================================
1755 !CR:04.12.07: initialisations poches froides
1756 ! Controle de ALE et ALP pour la fermeture convective (jyg)
1757
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (iflag_wake>=1) THEN
1758 CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
1759 1 ,alp_bl_prescr, ale_bl_prescr)
1760 ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
1761 ! print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
1762 !
1763 ! Initialize tendencies of wake state variables (for some flag values
1764 ! they are not computed).
1765
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltat_wk(:,:) = 0.
1766
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltaq_wk(:,:) = 0.
1767
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltat_wk_gw(:,:) = 0.
1768
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltaq_wk_gw(:,:) = 0.
1769
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltat_vdf(:,:) = 0.
1770
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltaq_vdf(:,:) = 0.
1771
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltat_the(:,:) = 0.
1772
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltaq_the(:,:) = 0.
1773
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltat_ajs_cv(:,:) = 0.
1774
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_deltaq_ajs_cv(:,:) = 0.
1775
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 d_s_wk(:) = 0.
1776
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 d_dens_wk(:) = 0.
1777 ENDIF ! (iflag_wake>=1)
1778
1779 ! do i = 1,klon
1780 ! Ale_bl(i)=0.
1781 ! Alp_bl(i)=0.
1782 ! enddo
1783
1784 !ELSE
1785 ! ALLOCATE(tabijGCM(0))
1786 ! ALLOCATE(lonGCM(0), latGCM(0))
1787 ! ALLOCATE(iGCM(0), jGCM(0))
1788 ENDIF ! (iflag_con.GE.3)
1789 !
1790
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 DO i=1,klon
1791 995 rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
1792 ENDDO
1793
1794 !34EK
1795
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ok_orodr) THEN
1796
1797 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1798 ! FH sans doute a enlever de finitivement ou, si on le
1799 ! garde, l'activer justement quand ok_orodr = false.
1800 ! ce rugoro est utilise par la couche limite et fait double emploi
1801 ! avec les param\'etrisations sp\'ecifiques de Francois Lott.
1802 ! DO i=1,klon
1803 ! rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
1804 ! ENDDO
1805 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1806
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ok_strato) THEN
1807 1 CALL SUGWD_strato(klon,klev,paprs,pplay)
1808 ELSE
1809 CALL SUGWD(klon,klev,paprs,pplay)
1810 ENDIF
1811
1812
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 DO i=1,klon
1813 994 zuthe(i)=0.
1814 994 zvthe(i)=0.
1815
2/2
✓ Branch 0 taken 464 times.
✓ Branch 1 taken 530 times.
995 IF (zstd(i).gt.10.) THEN
1816 464 zuthe(i)=(1.-zgam(i))*cos(zthe(i))
1817 464 zvthe(i)=(1.-zgam(i))*sin(zthe(i))
1818 ENDIF
1819 ENDDO
1820 ENDIF
1821 !
1822 !
1823 1 lmt_pas = NINT(86400./phys_tstep * 1.0) ! tous les jours
1824 1 WRITE(lunout,*)'La frequence de lecture surface est de ', &
1825 2 lmt_pas
1826 !
1827 1 capemaxcels = 't_max(X)'
1828 1 t2mincels = 't_min(X)'
1829 1 t2maxcels = 't_max(X)'
1830 1 tinst = 'inst(X)'
1831 1 tave = 'ave(X)'
1832 !IM cf. AM 081204 BEG
1833 1 write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
1834 !IM cf. AM 081204 END
1835 !
1836 !=============================================================
1837 ! Initialisation des sorties
1838 !=============================================================
1839
1840
1841 !
1842 CALL printflag( tabcntr0,radpas,ok_journe, &
1843 1 ok_instan, ok_region )
1844 !
1845 !
1846 ! Prescrire l'ozone dans l'atmosphere
1847 !
1848 !c DO i = 1, klon
1849 !c DO k = 1, klev
1850 !c CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
1851 !c ENDDO
1852 !c ENDDO
1853 !
1854 IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN ! ModThL
1855 ENDIF
1856 !
1857 IF (type_trac == 'repr') THEN
1858 ENDIF
1859
1860 !$omp single
1861
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (read_climoz >= 1) CALL open_climoz(ncid_climoz, press_cen_climoz, &
1862 press_edg_climoz, time_climoz, ok_daily_climoz, adjust_tropopause)
1863 !$omp end single
1864 !
1865 !IM betaCRF
1866 1 pfree=70000. !Pa
1867 1 beta_pbl=1.
1868 1 beta_free=1.
1869 1 lon1_beta=-180.
1870 1 lon2_beta=+180.
1871 1 lat1_beta=90.
1872 1 lat2_beta=-90.
1873 1 mskocean_beta=.FALSE.
1874
1875 !albedo SB >>>
1876 SELECT CASE(nsw)
1877 CASE(2)
1878 SFRWL(1)=0.45538747
1879 SFRWL(2)=0.54461211
1880 CASE(4)
1881 SFRWL(1)=0.45538747
1882 SFRWL(2)=0.32870591
1883 SFRWL(3)=0.18568763
1884 SFRWL(4)=3.02191470E-02
1885 CASE(6)
1886 1 SFRWL(1)=1.28432794E-03
1887 1 SFRWL(2)=0.12304168
1888 1 SFRWL(3)=0.33106142
1889 1 SFRWL(4)=0.32870591
1890 1 SFRWL(5)=0.18568763
1891
1/4
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
1 SFRWL(6)=3.02191470E-02
1892 END SELECT
1893 !albedo SB <<<
1894
1895 OPEN(99,file='beta_crf.data',status='old', &
1896
1/2
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
1 form='formatted',err=9999)
1897
1/2
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
1 READ(99,*,end=9998) pfree
1898
1/2
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
1 READ(99,*,end=9998) beta_pbl
1899
1/2
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
1 READ(99,*,end=9998) beta_free
1900
1/2
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
1 READ(99,*,end=9998) lon1_beta
1901
1/2
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
1 READ(99,*,end=9998) lon2_beta
1902
1/2
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
1 READ(99,*,end=9998) lat1_beta
1903
1/2
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
1 READ(99,*,end=9998) lat2_beta
1904 1 READ(99,*,end=9998) mskocean_beta
1905 9998 Continue
1906 1 CLOSE(99)
1907 9999 Continue
1908 1 WRITE(*,*)'pfree=',pfree
1909 1 WRITE(*,*)'beta_pbl=',beta_pbl
1910 1 WRITE(*,*)'beta_free=',beta_free
1911 1 WRITE(*,*)'lon1_beta=',lon1_beta
1912 1 WRITE(*,*)'lon2_beta=',lon2_beta
1913 1 WRITE(*,*)'lat1_beta=',lat1_beta
1914 1 WRITE(*,*)'lat2_beta=',lat2_beta
1915 1 WRITE(*,*)'mskocean_beta=',mskocean_beta
1916
1917 !lwoff=y : offset LW CRE for radiation code and other schemes
1918 !lwoff=y : betalwoff=1.
1919 1 betalwoff=0.
1920
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ok_lwoff) THEN
1921 betalwoff=1.
1922 ENDIF
1923 1 WRITE(*,*)'ok_lwoff=',ok_lwoff
1924 !
1925 !lwoff=y to begin only sollw and sollwdown are set up to CS values
1926
3/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 994 times.
✓ Branch 3 taken 1 times.
996 sollw = sollw + betalwoff * (sollw0 - sollw)
1927 sollwdown(:)= sollwdown(:) + betalwoff *(-1.*ZFLDN0(:,1) - &
1928
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 sollwdown(:))
1929
1930
1931 ENDIF
1932 !
1933 ! **************** Fin de IF ( debut ) ***************
1934 !
1935 !
1936 ! Incrementer le compteur de la physique
1937 !
1938 480 itap = itap + 1
1939
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
480 IF (is_master .OR. prt_level > 9) THEN
1940
3/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 96 times.
✓ Branch 3 taken 384 times.
480 IF (prt_level > 5 .or. MOD(itap,5) == 0) THEN
1941 96 WRITE(LUNOUT,*)'Entering physics elapsed seconds since start ', current_time
1942 96 WRITE(LUNOUT,100)year_cur,mth_cur,day_cur,hour/3600.
1943 100 FORMAT('Date = ',i4.4,' / ',i2.2, ' / ',i2.2,' : ',f20.17)
1944 ENDIF
1945 ENDIF
1946 !
1947 !
1948 ! Update fraction of the sub-surfaces (pctsrf) and
1949 ! initialize, where a new fraction has appeared, all variables depending
1950 ! on the surface fraction.
1951 !
1952 CALL change_srf_frac(itap, phys_tstep, days_elapsed+1, &
1953 pctsrf, fevap, z0m, z0h, agesno, &
1954 480 falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
1955
1956 ! Update time and other variables in Reprobus
1957 IF (type_trac == 'repr') THEN
1958 ENDIF
1959
1960 ! Tendances bidons pour les processus qui n'affectent pas certaines
1961 ! variables.
1962
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 du0(:,:)=0.
1963
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dv0(:,:)=0.
1964
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dt0 = 0.
1965
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dq0(:,:)=0.
1966
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dql0(:,:)=0.
1967
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dqi0(:,:)=0.
1968
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 dsig0(:) = 0.
1969
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 ddens0(:) = 0.
1970
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 wkoccur1(:)=1
1971 !
1972 ! Mettre a zero des variables de sortie (pour securite)
1973 !
1974
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
1975 477600 d_ps(i) = 0.0
1976 ENDDO
1977
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
1978
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
1979 18607680 d_t(i,k) = 0.0
1980 18607680 d_u(i,k) = 0.0
1981 18626400 d_v(i,k) = 0.0
1982 ENDDO
1983 ENDDO
1984
2/2
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
2880 DO iq = 1, nqtot
1985
2/2
✓ Branch 0 taken 93600 times.
✓ Branch 1 taken 2400 times.
96480 DO k = 1, klev
1986
2/2
✓ Branch 0 taken 93038400 times.
✓ Branch 1 taken 93600 times.
93134400 DO i = 1, klon
1987 93132000 d_qx(i,k,iq) = 0.0
1988 ENDDO
1989 ENDDO
1990 ENDDO
1991
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 beta_prec_fisrt(:,:)=0.
1992
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 beta_prec(:,:)=0.
1993 !
1994 ! Output variables from the convective scheme should not be set to 0
1995 ! since convection is not always called at every time step.
1996
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (ok_bug_cv_trac) THEN
1997 da(:,:)=0.
1998 mp(:,:)=0.
1999 phi(:,:,:)=0.
2000 ! RomP >>>
2001 phi2(:,:,:)=0.
2002 epmlmMm(:,:,:)=0.
2003 eplaMm(:,:)=0.
2004 d1a(:,:)=0.
2005 dam(:,:)=0.
2006 pmflxr(:,:)=0.
2007 pmflxs(:,:)=0.
2008 ! RomP <<<
2009 ENDIF
2010 !
2011 ! Ne pas affecter les valeurs entrees de u, v, h, et q
2012 !
2013
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
2014
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
2015 18607680 t_seri(i,k) = t(i,k)
2016 18607680 u_seri(i,k) = u(i,k)
2017 18607680 v_seri(i,k) = v(i,k)
2018 18607680 q_seri(i,k) = qx(i,k,ivap)
2019 18607680 ql_seri(i,k) = qx(i,k,iliq)
2020 !CR: ATTENTION, on rajoute la variable glace
2021
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 18607680 times.
18626400 IF (nqo.eq.2) THEN
2022 qs_seri(i,k) = 0.
2023
1/2
✓ Branch 0 taken 18607680 times.
✗ Branch 1 not taken.
18607680 ELSE IF (nqo.eq.3) THEN
2024 18607680 qs_seri(i,k) = qx(i,k,isol)
2025 ENDIF
2026 ENDDO
2027 ENDDO
2028 !
2029 !--OB mass fixer
2030 IF (mass_fixer) THEN
2031 !--store initial water burden
2032 qql1(:)=0.0
2033 DO k = 1, klev
2034 qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
2035 ENDDO
2036 ENDIF
2037 !--fin mass fixer
2038
2039
4/4
✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
19104480 tke0(:,:)=pbl_tke(:,:,is_ave)
2040 !CR:Nombre de traceurs de l'eau: nqo
2041 ! IF (nqtot.GE.3) THEN
2042
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (nqtot.GE.(nqo+1)) THEN
2043 ! DO iq = 3, nqtot
2044
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO iq = nqo+1, nqtot
2045
2/2
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
38880 DO k = 1, klev
2046
2/2
✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
37253760 DO i = 1, klon
2047 ! tr_seri(i,k,iq-2) = qx(i,k,iq)
2048 37252800 tr_seri(i,k,iq-nqo) = qx(i,k,iq)
2049 ENDDO
2050 ENDDO
2051 ENDDO
2052 ELSE
2053 DO k = 1, klev
2054 DO i = 1, klon
2055 tr_seri(i,k,1) = 0.0
2056 ENDDO
2057 ENDDO
2058 ENDIF
2059 !
2060 ! Temporary solutions adressing ticket #104 and the non initialisation of tr_ancien
2061 ! LF
2062
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF (debut) THEN
2063 1 WRITE(lunout,*)' WARNING: tr_ancien initialised to tr_seri'
2064
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 DO iq = nqo+1, nqtot
2065
4/4
✓ Branch 0 taken 78 times.
✓ Branch 1 taken 2 times.
✓ Branch 2 taken 77532 times.
✓ Branch 3 taken 78 times.
77613 tr_ancien(:,:,iq-nqo)=tr_seri(:,:,iq-nqo)
2066 ENDDO
2067 ENDIF
2068 !
2069
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
2070 477600 ztsol(i) = 0.
2071 ENDDO
2072
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nsrf = 1, nbsrf
2073
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 DO i = 1, klon
2074 1910400 ztsol(i) = ztsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
2075 ENDDO
2076 ENDDO
2077 ! Initialize variables used for diagnostic purpose
2078
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (flag_inhib_tend .ne. 0) CALL init_cmp_seri
2079
2080 ! Diagnostiquer la tendance dynamique
2081 !
2082
2/2
✓ Branch 0 taken 479 times.
✓ Branch 1 taken 1 times.
480 IF (ancien_ok) THEN
2083 !
2084
4/4
✓ Branch 0 taken 18681 times.
✓ Branch 1 taken 479 times.
✓ Branch 2 taken 18568914 times.
✓ Branch 3 taken 18681 times.
18588074 d_u_dyn(:,:) = (u_seri(:,:)-u_ancien(:,:))/phys_tstep
2085
4/4
✓ Branch 0 taken 18681 times.
✓ Branch 1 taken 479 times.
✓ Branch 2 taken 18568914 times.
✓ Branch 3 taken 18681 times.
18588074 d_v_dyn(:,:) = (v_seri(:,:)-v_ancien(:,:))/phys_tstep
2086
4/4
✓ Branch 0 taken 18681 times.
✓ Branch 1 taken 479 times.
✓ Branch 2 taken 18568914 times.
✓ Branch 3 taken 18681 times.
18588074 d_t_dyn(:,:) = (t_seri(:,:)-t_ancien(:,:))/phys_tstep
2087
4/4
✓ Branch 0 taken 18681 times.
✓ Branch 1 taken 479 times.
✓ Branch 2 taken 18568914 times.
✓ Branch 3 taken 18681 times.
18588074 d_q_dyn(:,:) = (q_seri(:,:)-q_ancien(:,:))/phys_tstep
2088
4/4
✓ Branch 0 taken 18681 times.
✓ Branch 1 taken 479 times.
✓ Branch 2 taken 18568914 times.
✓ Branch 3 taken 18681 times.
18588074 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep
2089
4/4
✓ Branch 0 taken 18681 times.
✓ Branch 1 taken 479 times.
✓ Branch 2 taken 18568914 times.
✓ Branch 3 taken 18681 times.
18588074 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep
2090 479 CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
2091
2/2
✓ Branch 0 taken 476126 times.
✓ Branch 1 taken 479 times.
476605 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep
2092 479 CALL water_int(klon,klev,ql_seri,zmasse,zx_tmp_fi2d)
2093
2/2
✓ Branch 0 taken 476126 times.
✓ Branch 1 taken 479 times.
476605 d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/phys_tstep
2094 479 CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d)
2095
2/2
✓ Branch 0 taken 476126 times.
✓ Branch 1 taken 479 times.
476605 d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep
2096 ! !! RomP >>> td dyn traceur
2097
1/2
✓ Branch 0 taken 479 times.
✗ Branch 1 not taken.
479 IF (nqtot.GT.nqo) THEN ! jyg
2098
2/2
✓ Branch 0 taken 479 times.
✓ Branch 1 taken 958 times.
1437 DO iq = nqo+1, nqtot ! jyg
2099
4/4
✓ Branch 0 taken 37362 times.
✓ Branch 1 taken 958 times.
✓ Branch 2 taken 37137828 times.
✓ Branch 3 taken 37362 times.
37176627 d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/phys_tstep ! jyg
2100 ENDDO
2101 ENDIF
2102 ! !! RomP <<<
2103 ELSE
2104
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_u_dyn(:,:) = 0.0
2105
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_v_dyn(:,:) = 0.0
2106
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_t_dyn(:,:) = 0.0
2107
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_q_dyn(:,:) = 0.0
2108
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_ql_dyn(:,:) = 0.0
2109
4/4
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
38806 d_qs_dyn(:,:) = 0.0
2110
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 d_q_dyn2d(:) = 0.0
2111
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 d_ql_dyn2d(:) = 0.0
2112
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 d_qs_dyn2d(:) = 0.0
2113 ! !! RomP >>> td dyn traceur
2114
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (nqtot.GT.nqo) THEN ! jyg
2115
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 DO iq = nqo+1, nqtot ! jyg
2116
4/4
✓ Branch 0 taken 78 times.
✓ Branch 1 taken 2 times.
✓ Branch 2 taken 77532 times.
✓ Branch 3 taken 78 times.
77613 d_tr_dyn(:,:,iq-nqo)= 0.0 ! jyg
2117 ENDDO
2118 ENDIF
2119 ! !! RomP <<<
2120 1 ancien_ok = .TRUE.
2121 ENDIF
2122 !
2123 ! Ajouter le geopotentiel du sol:
2124 !
2125
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
2126
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
2127 18626400 zphi(i,k) = pphi(i,k) + pphis(i)
2128 ENDDO
2129 ENDDO
2130 !
2131 ! Verifier les temperatures
2132 !
2133 !IM BEG
2134 IF (check) THEN
2135 amn=MIN(ftsol(1,is_ter),1000.)
2136 amx=MAX(ftsol(1,is_ter),-1000.)
2137 DO i=2, klon
2138 amn=MIN(ftsol(i,is_ter),amn)
2139 amx=MAX(ftsol(i,is_ter),amx)
2140 ENDDO
2141 !
2142 PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx
2143 ENDIF !(check) THEN
2144 !IM END
2145 !
2146 480 CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
2147
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'
2148
2149 !
2150 !IM BEG
2151 IF (check) THEN
2152 amn=MIN(ftsol(1,is_ter),1000.)
2153 amx=MAX(ftsol(1,is_ter),-1000.)
2154 DO i=2, klon
2155 amn=MIN(ftsol(i,is_ter),amn)
2156 amx=MAX(ftsol(i,is_ter),amx)
2157 ENDDO
2158 !
2159 PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx
2160 ENDIF !(check) THEN
2161 !IM END
2162 !
2163 ! Mettre en action les conditions aux limites (albedo, sst, etc.).
2164 ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
2165 !
2166 ! Update ozone if day change
2167
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 475 times.
480 IF (MOD(itap-1,lmt_pas) == 0) THEN
2168
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
5 IF (read_climoz <= 0) THEN
2169 ! Once per day, update ozone from Royer:
2170
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
5 IF (solarlong0<-999.) then
2171 ! Generic case with evolvoing season
2172 5 zzz=real(days_elapsed+1)
2173 ELSE IF (abs(solarlong0-1000.)<1.e-4) then
2174 ! Particular case with annual mean insolation
2175 zzz=real(90) ! could be revisited
2176 IF (read_climoz/=-1) THEN
2177 abort_message ='read_climoz=-1 is recommended when ' &
2178 // 'solarlong0=1000.'
2179 CALL abort_physic (modname,abort_message,1)
2180 ENDIF
2181 ELSE
2182 ! Case where the season is imposed with solarlong0
2183 zzz=real(90) ! could be revisited
2184 ENDIF
2185
2186
5/6
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 195 times.
✓ Branch 4 taken 5 times.
✓ Branch 5 taken 193830 times.
✓ Branch 6 taken 195 times.
194030 wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
2187 ELSE
2188 !--- ro3i = elapsed days number since current year 1st january, 0h
2189 ro3i=days_elapsed+jh_cur-jh_1jan
2190 !--- scaling for old style files (360 records)
2191 IF(SIZE(time_climoz)==360.AND..NOT.ok_daily_climoz) ro3i=ro3i*360./year_len
2192 IF(adjust_tropopause) THEN
2193 CALL regr_pr_time_av(ncid_climoz, vars_climoz(1:read_climoz), &
2194 ro3i, 'C', press_cen_climoz, pplay, wo, paprs(:,1), &
2195 time_climoz , longitude_deg, latitude_deg, &
2196 dyn_tropopause(t_seri, ztsol, paprs, pplay, rot))
2197 ELSE
2198 CALL regr_pr_time_av(ncid_climoz, vars_climoz(1:read_climoz), &
2199 ro3i, 'C', press_cen_climoz, pplay, wo, paprs(:,1), &
2200 time_climoz )
2201 ENDIF
2202 ! Convert from mole fraction of ozone to column density of ozone in a
2203 ! cell, in kDU:
2204 FORALL (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
2205 * zmasse / dobson_u / 1e3
2206 ! (By regridding ozone values for LMDZ only once a day, we
2207 ! have already neglected the variation of pressure in one
2208 ! day. So do not recompute "wo" at each time step even if
2209 ! "zmasse" changes a little.)
2210 ENDIF
2211 ENDIF
2212 !
2213 ! Re-evaporer l'eau liquide nuageuse
2214 !
2215 CALL reevap (klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, &
2216 480 & d_t_eva,d_q_eva,d_ql_eva,d_qi_eva)
2217
2218 CALL add_phys_tend &
2219 (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,paprs,&
2220 480 'eva',abortphy,flag_inhib_tend,itap,0)
2221 480 CALL prt_enerbil('eva',itap)
2222
2223 !=========================================================================
2224 ! Calculs de l'orbite.
2225 ! Necessaires pour le rayonnement et la surface (calcul de l'albedo).
2226 ! doit donc etre plac\'e avant radlwsw et pbl_surface
2227
2228 ! !! jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2229 480 CALL ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
2230 480 day_since_equinox = (jD_cur + jH_cur) - jD_eq
2231 !
2232 ! choix entre calcul de la longitude solaire vraie ou valeur fixee a
2233 ! solarlong0
2234
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (solarlong0<-999.) THEN
2235 480 IF (new_orbit) THEN
2236 ! calcul selon la routine utilisee pour les planetes
2237 CALL solarlong(day_since_equinox, zlongi, dist)
2238 ELSE
2239 ! calcul selon la routine utilisee pour l'AR4
2240 CALL orbite(REAL(days_elapsed+1),zlongi,dist)
2241 ENDIF
2242 ELSE
2243 zlongi=solarlong0 ! longitude solaire vraie
2244 dist=1. ! distance au soleil / moyenne
2245 ENDIF
2246
2247
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level.ge.1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
2248
2249
2250 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2251 ! Calcul de l'ensoleillement :
2252 ! ============================
2253 ! Pour une solarlong0=1000., on calcule un ensoleillement moyen sur
2254 ! l'annee a partir d'une formule analytique.
2255 ! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
2256 ! non nul aux poles.
2257
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (abs(solarlong0-1000.)<1.e-4) THEN
2258 CALL zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
2259 latitude_deg,longitude_deg,rmu0,fract)
2260 swradcorr(:) = 1.0
2261 JrNt(:) = 1.0
2262 zrmu0(:) = rmu0(:)
2263 ELSE
2264 ! recode par Olivier Boucher en sept 2015
2265 SELECT CASE (iflag_cycle_diurne)
2266 CASE(0)
2267 ! Sans cycle diurne
2268 CALL angle(zlongi, latitude_deg, fract, rmu0)
2269 swradcorr = 1.0
2270 JrNt = 1.0
2271 zrmu0 = rmu0
2272 CASE(1)
2273 ! Avec cycle diurne sans application des poids
2274 ! bit comparable a l ancienne formulation cycle_diurne=true
2275 ! on integre entre gmtime et gmtime+radpas
2276 480 zdtime=phys_tstep*REAL(radpas) ! pas de temps du rayonnement (s)
2277 CALL zenang(zlongi,jH_cur,0.0,zdtime, &
2278 480 latitude_deg,longitude_deg,rmu0,fract)
2279
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zrmu0 = rmu0
2280
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 swradcorr = 1.0
2281 ! Calcul du flag jour-nuit
2282
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 JrNt = 0.0
2283
4/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 253279 times.
✓ Branch 3 taken 223841 times.
477600 WHERE (fract.GT.0.0) JrNt = 1.0
2284 CASE(2)
2285 ! Avec cycle diurne sans application des poids
2286 ! On integre entre gmtime-pdtphys et gmtime+pdtphys*(radpas-1)
2287 ! Comme cette routine est appele a tous les pas de temps de
2288 ! la physique meme si le rayonnement n'est pas appele je
2289 ! remonte en arriere les radpas-1 pas de temps
2290 ! suivant. Petite ruse avec MOD pour prendre en compte le
2291 ! premier pas de temps de la physique pendant lequel
2292 ! itaprad=0
2293 zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1)
2294 zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1)
2295 CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
2296 latitude_deg,longitude_deg,rmu0,fract)
2297 !
2298 ! Calcul des poids
2299 !
2300 zdtime1=-phys_tstep !--on corrige le rayonnement pour representer le
2301 zdtime2=0.0 !--pas de temps de la physique qui se termine
2302 CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
2303 latitude_deg,longitude_deg,zrmu0,zfract)
2304 swradcorr = 0.0
2305 WHERE (rmu0.GE.1.e-10 .OR. fract.GE.1.e-10) &
2306 swradcorr=zfract/fract*zrmu0/rmu0
2307 ! Calcul du flag jour-nuit
2308 JrNt = 0.0
2309
1/8
✗ 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.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
480 WHERE (zfract.GT.0.0) JrNt = 1.0
2310 END SELECT
2311 ENDIF
2312
4/12
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 477120 times.
✓ Branch 11 taken 480 times.
478080 sza_o = ACOS (rmu0) *180./pi
2313
2314
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
2315 CALL writefield_phy('u_seri',u_seri,nbp_lev)
2316 CALL writefield_phy('v_seri',v_seri,nbp_lev)
2317 CALL writefield_phy('t_seri',t_seri,nbp_lev)
2318 CALL writefield_phy('q_seri',q_seri,nbp_lev)
2319 ENDIF
2320
2321 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
2322 ! Appel au pbl_surface : Planetary Boudary Layer et Surface
2323 ! Cela implique tous les interactions des sous-surfaces et la
2324 ! partie diffusion turbulent du couche limit.
2325 !
2326 ! Certains varibales de sorties de pbl_surface sont utiliser que pour
2327 ! ecriture des fihiers hist_XXXX.nc, ces sont :
2328 ! qsol, zq2m, s_pblh, s_lcl,
2329 ! s_capCL, s_oliqCL, s_cteiCL,s_pblT,
2330 ! s_therm, s_trmb1, s_trmb2, s_trmb3,
2331 ! zu10m, zv10m, fder,
2332 ! zxqsurf, delta_qsurf,
2333 ! rh2m, zxfluxu, zxfluxv,
2334 ! frugs, agesno, fsollw, fsolsw,
2335 ! d_ts, fevap, fluxlat, t2m,
2336 ! wfbils, wfbilo, fluxt, fluxu, fluxv,
2337 !
2338 ! Certains ne sont pas utiliser du tout :
2339 ! dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq
2340 !
2341
2342 ! Calcul de l'humidite de saturation au niveau du sol
2343
2344
2345
2346
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_pbl/=0) THEN
2347
2348 !jyg+nrlmd<
2349 !!jyg IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
2350
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
480 IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,10) .ge. 1) THEN
2351 print *,'debut du splitting de la PBL, wake_s = ', wake_s(:)
2352 print *,'debut du splitting de la PBL, wake_deltat = ', wake_deltat(:,1)
2353 print *,'debut du splitting de la PBL, wake_deltaq = ', wake_deltaq(:,1)
2354 ENDIF
2355 ! !!
2356 !>jyg+nrlmd
2357 !
2358 !-------gustiness calculation-------!
2359 !ym : Warning gustiness non inialized for iflag_gusts=2 & iflag_gusts=3
2360
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 gustiness=0 !ym missing init
2361
2362
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_gusts==0) THEN
2363 gustiness(1:klon)=0
2364
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 ELSE IF (iflag_gusts==1) THEN
2365 gustiness(1:klon)=f_gust_bl*ale_bl(1:klon)+f_gust_wk*ale_wake(1:klon)
2366
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 ELSE IF (iflag_gusts==2) THEN
2367
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 gustiness(1:klon)=f_gust_bl*ale_bl_stat(1:klon)+f_gust_wk*ale_wake(1:klon)
2368 ! ELSE IF (iflag_gusts==2) THEN
2369 ! do i = 1, klon
2370 ! gustiness(i)=f_gust_bl*ale_bl(i)+sigma_wk(i)*f_gust_wk&
2371 ! *ale_wake(i) !! need to make sigma_wk accessible here
2372 ! enddo
2373 ! ELSE IF (iflag_gusts==3) THEN
2374 ! do i = 1, klon
2375 ! gustiness(i)=f_gust_bl*alp_bl(i)+f_gust_wk*alp_wake(i)
2376 ! enddo
2377 ENDIF
2378
2379 CALL pbl_surface( &
2380 phys_tstep, date0, itap, days_elapsed+1, &
2381 debut, lafin, &
2382 longitude_deg, latitude_deg, rugoro, zrmu0, &
2383 sollwdown, cldt, &
2384 rain_fall, snow_fall, solsw, solswfdiff, sollw, &
2385 gustiness, &
2386 t_seri, q_seri, u_seri, v_seri, &
2387 !nrlmd+jyg<
2388 wake_deltat, wake_deltaq, wake_cstar, wake_s, &
2389 !>nrlmd+jyg
2390 pplay, paprs, pctsrf, &
2391 ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
2392 !albedo SB <<<
2393 cdragh, cdragm, u1, v1, &
2394 beta_aridity, &
2395 !albedo SB >>>
2396 ! albsol1, albsol2, sens, evap, &
2397 albsol_dir, albsol_dif, sens, evap, &
2398 !albedo SB <<<
2399 albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, &
2400 zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
2401 d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_t_diss, &
2402 !nrlmd<
2403 !jyg<
2404 d_t_vdf_w, d_q_vdf_w, &
2405 d_t_vdf_x, d_q_vdf_x, &
2406 sens_x, zxfluxlat_x, sens_w, zxfluxlat_w, &
2407 !>jyg
2408 delta_tsurf,wake_dens, &
2409 cdragh_x,cdragh_w,cdragm_x,cdragm_w, &
2410 kh,kh_x,kh_w, &
2411 !>nrlmd
2412 coefh(1:klon,1:klev,1:nbsrf+1), coefm(1:klon,1:klev,1:nbsrf+1), &
2413 slab_wfbils, &
2414 qsol, zq2m, s_pblh, s_lcl, &
2415 !jyg<
2416 s_pblh_x, s_lcl_x, s_pblh_w, s_lcl_w, &
2417 !>jyg
2418 s_capCL, s_oliqCL, s_cteiCL,s_pblT, &
2419 s_therm, s_trmb1, s_trmb2, s_trmb3, &
2420 zustar, zu10m, zv10m, fder, &
2421 zxqsurf, delta_qsurf, rh2m, zxfluxu, zxfluxv, &
2422 z0m, z0h, agesno, fsollw, fsolsw, &
2423 d_ts, fevap, fluxlat, t2m, &
2424 wfbils, wfbilo, wfevap, wfrain, wfsnow, &
2425 fluxt, fluxu, fluxv, &
2426 dsens, devap, zxsnow, &
2427 zxfluxt, zxfluxq, q2m, fluxq, pbl_tke, &
2428 !nrlmd+jyg<
2429 wake_delta_pbl_TKE, &
2430 !>nrlmd+jyg
2431 480 treedrg )
2432 !FC
2433 !
2434 ! Add turbulent diffusion tendency to the wake difference variables
2435 !!jyg IF (mod(iflag_pbl_split,2) .NE. 0) THEN
2436
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mod(iflag_pbl_split,10) .NE. 0) THEN
2437 !jyg<
2438 d_deltat_vdf(:,:) = d_t_vdf_w(:,:)-d_t_vdf_x(:,:)
2439 d_deltaq_vdf(:,:) = d_q_vdf_w(:,:)-d_q_vdf_x(:,:)
2440 CALL add_wake_tend &
2441 (d_deltat_vdf, d_deltaq_vdf, dsig0, ddens0, ddens0, wkoccur1, 'vdf', abortphy)
2442 ELSE
2443
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_deltat_vdf(:,:) = 0.
2444
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_deltaq_vdf(:,:) = 0.
2445 !>jyg
2446 ENDIF
2447
2448 !---------------------------------------------------------------------
2449 ! ajout des tendances de la diffusion turbulente
2450
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (klon_glo==1) THEN
2451 CALL add_pbl_tend &
2452 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
2453 'vdf',abortphy,flag_inhib_tend,itap)
2454 ELSE
2455 CALL add_phys_tend &
2456 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
2457
5/6
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 18720 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 18607680 times.
✓ Branch 5 taken 18720 times.
18626880 'vdf',abortphy,flag_inhib_tend,itap,0)
2458 ENDIF
2459 480 CALL prt_enerbil('vdf',itap)
2460 !--------------------------------------------------------------------
2461
2462
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
2463 CALL writefield_phy('u_seri',u_seri,nbp_lev)
2464 CALL writefield_phy('v_seri',v_seri,nbp_lev)
2465 CALL writefield_phy('t_seri',t_seri,nbp_lev)
2466 CALL writefield_phy('q_seri',q_seri,nbp_lev)
2467 ENDIF
2468
2469 !albedo SB >>>
2470
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 albsol1=0.
2471
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 albsol2=0.
2472
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 falb1=0.
2473
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 falb2=0.
2474 SELECT CASE(nsw)
2475 CASE(2)
2476 albsol1=albsol_dir(:,1)
2477 albsol2=albsol_dir(:,2)
2478 falb1=falb_dir(:,1,:)
2479 falb2=falb_dir(:,2,:)
2480 CASE(4)
2481 albsol1=albsol_dir(:,1)
2482 albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3) &
2483 +albsol_dir(:,4)*SFRWL(4)
2484 albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
2485 falb1=falb_dir(:,1,:)
2486 falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3) &
2487 +falb_dir(:,4,:)*SFRWL(4)
2488 falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
2489 CASE(6)
2490 albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2) &
2491
4/12
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 477120 times.
✓ Branch 11 taken 480 times.
478080 +albsol_dir(:,3)*SFRWL(3)
2492
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
2493 albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5) &
2494
4/12
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 477120 times.
✓ Branch 11 taken 480 times.
478080 +albsol_dir(:,6)*SFRWL(6)
2495
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
2496 falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2) &
2497
7/16
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 480 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✓ Branch 12 taken 1920 times.
✓ Branch 13 taken 480 times.
✓ Branch 14 taken 1908480 times.
✓ Branch 15 taken 1920 times.
1911360 +falb_dir(:,3,:)*SFRWL(3)
2498
4/4
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
1910880 falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
2499 falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5) &
2500
7/16
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 480 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✓ Branch 12 taken 1920 times.
✓ Branch 13 taken 480 times.
✓ Branch 14 taken 1908480 times.
✓ Branch 15 taken 1920 times.
1911360 +falb_dir(:,6,:)*SFRWL(6)
2501
5/8
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1920 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 1908480 times.
✓ Branch 7 taken 1920 times.
1911360 falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
2502 END SELECt
2503 !albedo SB <<<
2504
2505
2506 CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
2507 480 t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)
2508
2509 ENDIF
2510 ! =================================================================== c
2511 ! Calcul de Qsat
2512
2513
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
2514
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
2515 18607680 zx_t = t_seri(i,k)
2516 IF (thermcep) THEN
2517 18607680 zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2518 18607680 zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2519 18607680 zx_qs = MIN(0.5,zx_qs)
2520 18607680 zcor = 1./(1.-retv*zx_qs)
2521 18607680 zx_qs = zx_qs*zcor
2522 ELSE
2523 !! IF (zx_t.LT.t_coup) THEN !jyg
2524 IF (zx_t.LT.rtt) THEN !jyg
2525 zx_qs = qsats(zx_t)/pplay(i,k)
2526 ELSE
2527 zx_qs = qsatl(zx_t)/pplay(i,k)
2528 ENDIF
2529 ENDIF
2530 18626400 zqsat(i,k)=zx_qs
2531 ENDDO
2532 ENDDO
2533
2534
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level.ge.1) THEN
2535 write(lunout,*) 'L qsat (g/kg) avant clouds_gno'
2536 write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
2537 ENDIF
2538 !
2539 ! Appeler la convection (au choix)
2540 !
2541
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
2542
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
2543 conv_q(i,k) = d_q_dyn(i,k) &
2544 18607680 + d_q_vdf(i,k)/phys_tstep
2545 conv_t(i,k) = d_t_dyn(i,k) &
2546 18626400 + d_t_vdf(i,k)/phys_tstep
2547 ENDDO
2548 ENDDO
2549 IF (check) THEN
2550 za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
2551 WRITE(lunout,*) "avantcon=", za
2552 ENDIF
2553 zx_ajustq = .FALSE.
2554
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
2555 IF (zx_ajustq) THEN
2556 DO i = 1, klon
2557 z_avant(i) = 0.0
2558 ENDDO
2559 DO k = 1, klev
2560 DO i = 1, klon
2561 z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
2562 *(paprs(i,k)-paprs(i,k+1))/RG
2563 ENDDO
2564 ENDDO
2565 ENDIF
2566
2567 ! Calcule de vitesse verticale a partir de flux de masse verticale
2568
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
2569
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
2570 18626400 omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
2571 ENDDO
2572 ENDDO
2573
2574
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
2575 omega(igout, :)
2576 !
2577 ! Appel de la convection tous les "cvpas"
2578 !
2579 !!jyg IF (MOD(itapcv,cvpas).EQ.0) THEN
2580 !! print *,' physiq : itapcv, cvpas, itap-1, cvpas_0 ', &
2581 !! itapcv, cvpas, itap-1, cvpas_0
2582
3/4
✓ Branch 0 taken 240 times.
✓ Branch 1 taken 240 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 240 times.
480 IF (MOD(itapcv,cvpas).EQ.0 .OR. MOD(itap-1,cvpas_0).EQ.0) THEN
2583
2584 !
2585 ! Mettre a zero des variables de sortie (pour securite)
2586 !
2587
4/4
✓ Branch 0 taken 9600 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9542400 times.
✓ Branch 3 taken 9600 times.
9552240 pmflxr(:,:) = 0.
2588
4/4
✓ Branch 0 taken 9600 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9542400 times.
✓ Branch 3 taken 9600 times.
9552240 pmflxs(:,:) = 0.
2589
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 wdtrainA(:,:) = 0.
2590
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 wdtrainS(:,:) = 0.
2591
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 wdtrainM(:,:) = 0.
2592
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 upwd(:,:) = 0.
2593
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 dnwd(:,:) = 0.
2594
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 ep(:,:) = 0.
2595
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 da(:,:)=0.
2596
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 mp(:,:)=0.
2597
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 wght_cvfd(:,:)=0.
2598
6/6
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 365040 times.
✓ Branch 3 taken 9360 times.
✓ Branch 4 taken 362849760 times.
✓ Branch 5 taken 365040 times.
363224400 phi(:,:,:)=0.
2599
6/6
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 365040 times.
✓ Branch 3 taken 9360 times.
✓ Branch 4 taken 362849760 times.
✓ Branch 5 taken 365040 times.
363224400 phi2(:,:,:)=0.
2600
6/6
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 365040 times.
✓ Branch 3 taken 9360 times.
✓ Branch 4 taken 362849760 times.
✓ Branch 5 taken 365040 times.
363224400 epmlmMm(:,:,:)=0.
2601
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 eplaMm(:,:)=0.
2602
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 d1a(:,:)=0.
2603
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 dam(:,:)=0.
2604
6/6
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 365040 times.
✓ Branch 3 taken 9360 times.
✓ Branch 4 taken 362849760 times.
✓ Branch 5 taken 365040 times.
363224400 elij(:,:,:)=0.
2605
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 ev(:,:)=0.
2606
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 qtaa(:,:)=0.
2607
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 clw(:,:)=0.
2608
6/6
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 365040 times.
✓ Branch 3 taken 9360 times.
✓ Branch 4 taken 362849760 times.
✓ Branch 5 taken 365040 times.
363224400 sij(:,:,:)=0.
2609 !
2610
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 240 times.
240 IF (iflag_con.EQ.1) THEN
2611 abort_message ='reactiver le call conlmd dans physiq.F'
2612 CALL abort_physic (modname,abort_message,1)
2613 ! CALL conlmd (phys_tstep, paprs, pplay, t_seri, q_seri, conv_q,
2614 ! . d_t_con, d_q_con,
2615 ! . rain_con, snow_con, ibas_con, itop_con)
2616
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 240 times.
240 ELSE IF (iflag_con.EQ.2) THEN
2617 CALL conflx(phys_tstep, paprs, pplay, t_seri, q_seri, &
2618 conv_t, conv_q, -evap, omega, &
2619 d_t_con, d_q_con, rain_con, snow_con, &
2620 pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
2621 kcbot, kctop, kdtop, pmflxr, pmflxs)
2622 d_u_con = 0.
2623 d_v_con = 0.
2624
2625 WHERE (rain_con < 0.) rain_con = 0.
2626 WHERE (snow_con < 0.) snow_con = 0.
2627 DO i = 1, klon
2628 ibas_con(i) = klev+1 - kcbot(i)
2629 itop_con(i) = klev+1 - kctop(i)
2630 ENDDO
2631
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 ELSE IF (iflag_con.GE.3) THEN
2632 ! nb of tracers for the KE convection:
2633 ! MAF la partie traceurs est faite dans phytrac
2634 ! on met ntra=1 pour limiter les appels mais on peut
2635 ! supprimer les calculs / ftra.
2636 ntra = 1
2637
2638 !=======================================================================
2639 !ajout pour la parametrisation des poches froides: calcul de
2640 !t_w et t_x: si pas de poches froides, t_w=t_x=t_seri
2641
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 IF (iflag_wake>=1) THEN
2642
2/2
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
9600 DO k=1,klev
2643
2/2
✓ Branch 0 taken 9303840 times.
✓ Branch 1 taken 9360 times.
9313440 DO i=1,klon
2644 9303840 t_w(i,k) = t_seri(i,k) + (1-wake_s(i))*wake_deltat(i,k)
2645 9303840 q_w(i,k) = q_seri(i,k) + (1-wake_s(i))*wake_deltaq(i,k)
2646 9303840 t_x(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
2647 9313200 q_x(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
2648 ENDDO
2649 ENDDO
2650 ELSE
2651 t_w(:,:) = t_seri(:,:)
2652 q_w(:,:) = q_seri(:,:)
2653 t_x(:,:) = t_seri(:,:)
2654 q_x(:,:) = q_seri(:,:)
2655 ENDIF
2656 !
2657 !jyg<
2658 ! Perform dry adiabatic adjustment on wake profile
2659 ! The corresponding tendencies are added to the convective tendencies
2660 ! after the call to the convective scheme.
2661
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 IF (iflag_wake>=1) then
2662
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 IF (iflag_adjwk >= 1) THEN
2663
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 limbas(:) = 1
2664 CALL ajsec(paprs, pplay, t_w, q_w, limbas, &
2665 240 d_t_adjwk, d_q_adjwk)
2666 !
2667
2/2
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
9600 DO k=1,klev
2668
2/2
✓ Branch 0 taken 9303840 times.
✓ Branch 1 taken 9360 times.
9313440 DO i=1,klon
2669
2/2
✓ Branch 0 taken 1603446 times.
✓ Branch 1 taken 7700394 times.
9313200 IF (wake_s(i) .GT. 1.e-3) THEN
2670 1603446 t_w(i,k) = t_w(i,k) + d_t_adjwk(i,k)
2671 1603446 q_w(i,k) = q_w(i,k) + d_q_adjwk(i,k)
2672 1603446 d_deltat_ajs_cv(i,k) = d_t_adjwk(i,k)
2673 1603446 d_deltaq_ajs_cv(i,k) = d_q_adjwk(i,k)
2674 ELSE
2675 7700394 d_deltat_ajs_cv(i,k) = 0.
2676 7700394 d_deltaq_ajs_cv(i,k) = 0.
2677 ENDIF
2678 ENDDO
2679 ENDDO
2680
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 IF (iflag_adjwk == 2) THEN
2681 CALL add_wake_tend &
2682 240 (d_deltat_ajs_cv, d_deltaq_ajs_cv, dsig0, ddens0, ddens0, wkoccur1, 'ajs_cv', abortphy)
2683 ENDIF ! (iflag_adjwk == 2)
2684 ENDIF ! (iflag_adjwk >= 1)
2685 ENDIF ! (iflag_wake>=1)
2686 !>jyg
2687 !
2688
2689 !! print *,'physiq. q_w(1,k), q_x(1,k) ', &
2690 !! (k, q_w(1,k), q_x(1,k),k=1,25)
2691
2692 !jyg<
2693 CALL alpale( debut, itap, phys_tstep, paprs, omega, t_seri, &
2694 alp_offset, it_wape_prescr, wape_prescr, fip_prescr, &
2695 ale_bl_prescr, alp_bl_prescr, &
2696 wake_pe, wake_fip, &
2697 Ale_bl, Ale_bl_trig, Alp_bl, &
2698 240 Ale, Alp , Ale_wake, Alp_wake)
2699 !>jyg
2700 !
2701 ! sb, oct02:
2702 ! Schema de convection modularise et vectorise:
2703 ! (driver commun aux versions 3 et 4)
2704 !
2705 IF (ok_cvl) THEN ! new driver for convectL
2706 !
2707 !jyg<
2708 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2709 ! Calculate the upmost level of deep convection loops: k_upper_cv
2710 ! (near 22 km)
2711 240 k_upper_cv = klev
2712 !izero = klon/2+1/klon
2713 !DO k = klev,1,-1
2714 ! IF (pphi(izero,k) > 22.e4) k_upper_cv = k
2715 !ENDDO
2716 ! FH : nouveau calcul base sur un profil global sans quoi
2717 ! le modele etait sensible au decoupage de domaines
2718
2/2
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
9600 DO k = klev,1,-1
2719
2/2
✓ Branch 0 taken 3120 times.
✓ Branch 1 taken 6240 times.
9600 IF (-7*log(presnivs(k)/presnivs(1)) > 25.) k_upper_cv = k
2720 ENDDO
2721
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 240 times.
240 IF (prt_level .ge. 5) THEN
2722 Print *, 'upmost level of deep convection loops: k_upper_cv = ', &
2723 k_upper_cv
2724 ENDIF
2725 !
2726 !>jyg
2727
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 240 times.
240 IF (type_trac == 'repr') THEN
2728 nbtr_tmp=ntra
2729 ELSE
2730 240 nbtr_tmp=nbtr
2731 ENDIF
2732 !jyg iflag_con est dans clesphys
2733 !c CALL concvl (iflag_con,iflag_clos,
2734 CALL concvl (iflag_clos, &
2735 phys_tstep, paprs, pplay, k_upper_cv, t_x,q_x, &
2736 t_w,q_w,wake_s, &
2737 u_seri,v_seri,tr_seri,nbtr_tmp, &
2738 ALE,ALP, &
2739 sig1,w01, &
2740 d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
2741 rain_con, snow_con, ibas_con, itop_con, sigd, &
2742 ema_cbmf,plcl,plfc,wbeff,convoccur,upwd,dnwd,dnwd0, &
2743 Ma,mipsh,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &
2744 pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
2745 ! RomP >>>
2746 !! . pmflxr,pmflxs,da,phi,mp,
2747 !! . ftd,fqd,lalim_conv,wght_th)
2748 pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,qtaa,clw,elij, &
2749 ftd,fqd,lalim_conv,wght_th, &
2750 ev, ep,epmlmMm,eplaMm, &
2751 wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &
2752 240 tau_cld_cv,coefw_cld_cv,epmax_diag)
2753
2754 ! RomP <<<
2755
2756 !IM begin
2757 ! print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
2758 ! .dnwd0(1,1),ftd(1,1),fqd(1,1)
2759 !IM end
2760 !IM cf. FH
2761
7/20
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 240 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 240 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
✓ Branch 16 taken 9360 times.
✓ Branch 17 taken 240 times.
✓ Branch 18 taken 9303840 times.
✓ Branch 19 taken 9360 times.
9313680 clwcon0=qcondc
2762
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 pmfu(:,:)=upwd(:,:)+dnwd(:,:)
2763 !
2764 !jyg<
2765 ! If convective tendencies are too large, then call convection
2766 ! every time step
2767 240 cvpas = cvpas_0
2768
2/2
✓ Branch 0 taken 6480 times.
✓ Branch 1 taken 240 times.
6720 DO k=1,k_upper_cv
2769
2/2
✓ Branch 0 taken 6441120 times.
✓ Branch 1 taken 6480 times.
6447840 DO i=1,klon
2770 IF (d_t_con(i,k) > 6.721 .AND. d_t_con(i,k) < 6.722 .AND.&
2771
1/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6441120 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
6447600 d_q_con(i,k) > -.0002171 .AND. d_q_con(i,k) < -.0002170) THEN
2772 dtcon_multistep_max = 3.
2773 dqcon_multistep_max = 0.02
2774 ENDIF
2775 ENDDO
2776 ENDDO
2777 !
2778
2/2
✓ Branch 0 taken 6480 times.
✓ Branch 1 taken 240 times.
6720 DO k=1,k_upper_cv
2779
2/2
✓ Branch 0 taken 6441120 times.
✓ Branch 1 taken 6480 times.
6447840 DO i=1,klon
2780 !! IF (abs(d_t_con(i,k)) > 0.24 .OR. &
2781 !! abs(d_q_con(i,k)) > 2.e-2) THEN
2782
2/4
✓ Branch 0 taken 6441120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6441120 times.
6441120 IF (abs(d_t_con(i,k)) > dtcon_multistep_max .OR. &
2783 6480 abs(d_q_con(i,k)) > dqcon_multistep_max) THEN
2784 cvpas = 1
2785 !! print *,'physiq1, i,k,d_t_con(i,k),d_q_con(i,k) ', &
2786 !! i,k,d_t_con(i,k),d_q_con(i,k)
2787 ENDIF
2788 ENDDO
2789 ENDDO
2790 !!! Ligne a ne surtout pas remettre sans avoir murement reflechi (jyg)
2791 !!! call bcast(cvpas)
2792 !!! ------------------------------------------------------------
2793 !>jyg
2794 !
2795
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 DO i = 1, klon
2796
2/2
✓ Branch 0 taken 43809 times.
✓ Branch 1 taken 194751 times.
238800 IF (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+cvpas
2797 ENDDO
2798 !
2799 !jyg<
2800 ! Add the tendency due to the dry adjustment of the wake profile
2801
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 IF (iflag_wake>=1) THEN
2802
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 IF (iflag_adjwk == 2) THEN
2803
2/2
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
9600 DO k=1,klev
2804
2/2
✓ Branch 0 taken 9303840 times.
✓ Branch 1 taken 9360 times.
9313440 DO i=1,klon
2805 9303840 ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/phys_tstep
2806 9303840 fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/phys_tstep
2807 9303840 d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
2808 9313200 d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
2809 ENDDO
2810 ENDDO
2811 ENDIF ! (iflag_adjwk = 2)
2812 ENDIF ! (iflag_wake>=1)
2813 !>jyg
2814 !
2815 ELSE ! ok_cvl
2816
2817 ! MAF conema3 ne contient pas les traceurs
2818 CALL conema3 (phys_tstep, &
2819 paprs,pplay,t_seri,q_seri, &
2820 u_seri,v_seri,tr_seri,ntra, &
2821 sig1,w01, &
2822 d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
2823 rain_con, snow_con, ibas_con, itop_con, &
2824 upwd,dnwd,dnwd0,bas,top, &
2825 Ma,cape,tvp,rflag, &
2826 pbase &
2827 ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr &
2828 ,clwcon0)
2829
2830 ENDIF ! ok_cvl
2831
2832 !
2833 ! Correction precip
2834
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 rain_con = rain_con * cvl_corr
2835
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 snow_con = snow_con * cvl_corr
2836 !
2837
2838 IF (.NOT. ok_gust) THEN
2839
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 do i = 1, klon
2840 238800 wd(i)=0.0
2841 enddo
2842 ENDIF
2843
2844 ! =================================================================== c
2845 ! Calcul des proprietes des nuages convectifs
2846 !
2847
2848 ! calcul des proprietes des nuages convectifs
2849
4/4
✓ Branch 0 taken 9360 times.
✓ Branch 1 taken 240 times.
✓ Branch 2 taken 9303840 times.
✓ Branch 3 taken 9360 times.
9313440 clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
2850
1/2
✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
240 IF (iflag_cld_cv == 0) THEN
2851 CALL clouds_gno &
2852 240 (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
2853 ELSE
2854 CALL clouds_bigauss &
2855 (klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
2856 ENDIF
2857
2858
2859 ! =================================================================== c
2860
2861
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 DO i = 1, klon
2862 238560 itop_con(i) = min(max(itop_con(i),1),klev)
2863 238800 ibas_con(i) = min(max(ibas_con(i),1),itop_con(i))
2864 ENDDO
2865
2866
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 DO i = 1, klon
2867 238800 ema_pcb(i) = paprs(i,ibas_con(i))
2868 ENDDO
2869
2/2
✓ Branch 0 taken 240 times.
✓ Branch 1 taken 238560 times.
238800 DO i = 1, klon
2870 ! L'idicage de itop_con peut cacher un pb potentiel
2871 ! FH sous la dictee de JYG, CR
2872 238560 ema_pct(i) = paprs(i,itop_con(i)+1)
2873
2874
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 238560 times.
238800 IF (itop_con(i).gt.klev-3) THEN
2875 IF (prt_level >= 9) THEN
2876 write(lunout,*)'La convection monte trop haut '
2877 write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
2878 ENDIF
2879 ENDIF
2880 ENDDO
2881 ELSE IF (iflag_con.eq.0) THEN
2882 write(lunout,*) 'On n appelle pas la convection'
2883 clwcon0=0.
2884 rnebcon0=0.
2885 d_t_con=0.
2886 d_q_con=0.
2887 d_u_con=0.
2888 d_v_con=0.
2889 rain_con=0.
2890 snow_con=0.
2891 bas=1
2892 top=1
2893 ELSE
2894 WRITE(lunout,*) "iflag_con non-prevu", iflag_con
2895 CALL abort_physic("physiq", "", 1)
2896 ENDIF
2897
2898 ! CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
2899 ! . d_u_con, d_v_con)
2900
2901 !jyg Reinitialize proba_notrig and itapcv when convection has been called
2902
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
238800 proba_notrig(:) = 1.
2903 240 itapcv = 0
2904 ENDIF ! (MOD(itapcv,cvpas).EQ.0 .OR. MOD(itapcv,cvpas_0).EQ.0)
2905 !
2906 480 itapcv = itapcv+1
2907 !
2908 ! Compter les steps ou cvpas=1
2909
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (cvpas == 1) THEN
2910 Ncvpaseq1 = Ncvpaseq1+1
2911 ENDIF
2912
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mod(itap,1000) == 0) THEN
2913 print *,' physiq, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
2914 ENDIF
2915
2916 !!!jyg Appel diagnostique a add_phys_tend pour tester la conservation de
2917 !!! l'energie dans les courants satures.
2918 !! d_t_con_sat(:,:) = d_t_con(:,:) - ftd(:,:)*dtime
2919 !! d_q_con_sat(:,:) = d_q_con(:,:) - fqd(:,:)*dtime
2920 !! dql_sat(:,:) = (wdtrainA(:,:)+wdtrainM(:,:))*dtime/zmasse(:,:)
2921 !! CALL add_phys_tend(d_u_con, d_v_con, d_t_con_sat, d_q_con_sat, dql_sat, &
2922 !! dqi0, paprs, 'convection_sat', abortphy, flag_inhib_tend,&
2923 !! itap, 1)
2924 !! call prt_enerbil('convection_sat',itap)
2925 !!
2926 !!
2927 CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
2928 480 'convection',abortphy,flag_inhib_tend,itap,0)
2929 480 CALL prt_enerbil('convection',itap)
2930
2931 !-------------------------------------------------------------------------
2932
2933
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
2934 CALL writefield_phy('u_seri',u_seri,nbp_lev)
2935 CALL writefield_phy('v_seri',v_seri,nbp_lev)
2936 CALL writefield_phy('t_seri',t_seri,nbp_lev)
2937 CALL writefield_phy('q_seri',q_seri,nbp_lev)
2938 ENDIF
2939
2940 IF (check) THEN
2941 za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
2942 WRITE(lunout,*)"aprescon=", za
2943 zx_t = 0.0
2944 za = 0.0
2945 DO i = 1, klon
2946 za = za + cell_area(i)/REAL(klon)
2947 zx_t = zx_t + (rain_con(i)+ &
2948 snow_con(i))*cell_area(i)/REAL(klon)
2949 ENDDO
2950 zx_t = zx_t/za*phys_tstep
2951 WRITE(lunout,*)"Precip=", zx_t
2952 ENDIF
2953
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (zx_ajustq) THEN
2954 DO i = 1, klon
2955 z_apres(i) = 0.0
2956 ENDDO
2957 DO k = 1, klev
2958 DO i = 1, klon
2959 z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
2960 *(paprs(i,k)-paprs(i,k+1))/RG
2961 ENDDO
2962 ENDDO
2963 DO i = 1, klon
2964 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) &
2965 /z_apres(i)
2966 ENDDO
2967 DO k = 1, klev
2968 DO i = 1, klon
2969 IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
2970 z_factor(i).LT.(1.0-1.0E-08)) THEN
2971 q_seri(i,k) = q_seri(i,k) * z_factor(i)
2972 ENDIF
2973 ENDDO
2974 ENDDO
2975 ENDIF
2976 zx_ajustq=.FALSE.
2977
2978 !
2979 !==========================================================================
2980 !RR:Evolution de la poche froide: on ne fait pas de separation wake/env
2981 !pour la couche limite diffuse pour l instant
2982 !
2983 !
2984 ! nrlmd le 22/03/2011---Si on met les poches hors des thermiques
2985 ! il faut rajouter cette tendance calcul\'ee hors des poches
2986 ! froides
2987 !
2988
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_wake>=1) THEN
2989 !
2990 !
2991 ! Call wakes every "wkpas" step
2992 !
2993
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (MOD(itapwk,wkpas).EQ.0) THEN
2994 !
2995
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
2996
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
2997 18607680 dt_dwn(i,k) = ftd(i,k)
2998 18607680 dq_dwn(i,k) = fqd(i,k)
2999 18607680 M_dwn(i,k) = dnwd0(i,k)
3000 18607680 M_up(i,k) = upwd(i,k)
3001 18607680 dt_a(i,k) = d_t_con(i,k)/phys_tstep - ftd(i,k)
3002 18626400 dq_a(i,k) = d_q_con(i,k)/phys_tstep - fqd(i,k)
3003 ENDDO
3004 ENDDO
3005
3006
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_wake==2) THEN
3007 ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
3008 DO k = 1,klev
3009 dt_dwn(:,k)= dt_dwn(:,k)+ &
3010 ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/phys_tstep
3011 dq_dwn(:,k)= dq_dwn(:,k)+ &
3012 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep
3013 ENDDO
3014
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 ELSEIF (iflag_wake==3) THEN
3015 ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
3016 DO k = 1,klev
3017 DO i=1,klon
3018 IF (rneb(i,k)==0.) THEN
3019 ! On ne tient compte des tendances qu'en dehors des
3020 ! nuages (c'est-\`a-dire a priri dans une region ou
3021 ! l'eau se reevapore).
3022 dt_dwn(i,k)= dt_dwn(i,k)+ &
3023 ok_wk_lsp(i)*d_t_lsc(i,k)/phys_tstep
3024 dq_dwn(i,k)= dq_dwn(i,k)+ &
3025 ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep
3026 ENDIF
3027 ENDDO
3028 ENDDO
3029 ENDIF
3030
3031 !
3032 !calcul caracteristiques de la poche froide
3033 CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, &
3034 t_seri, q_seri, omega, &
3035 dt_dwn, dq_dwn, M_dwn, M_up, &
3036 dt_a, dq_a, cv_gen, &
3037 sigd, cin, &
3038 wake_deltat, wake_deltaq, wake_s, awake_dens, wake_dens, &
3039 wake_dth, wake_h, &
3040 !! wake_pe, wake_fip, wake_gfl, &
3041 wake_pe, wake_fip_0, wake_gfl, & !! jyg
3042 d_t_wake, d_q_wake, &
3043 wake_k, t_x, q_x, &
3044 wake_omgbdth, wake_dp_omgb, &
3045 wake_dtKE, wake_dqKE, &
3046 wake_omg, wake_dp_deltomg, &
3047 wake_spread, wake_Cstar, d_deltat_wk_gw, &
3048 480 d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_a_wk, d_dens_wk)
3049 !
3050 !jyg Reinitialize itapwk when wakes have been called
3051 480 itapwk = 0
3052 ENDIF ! (MOD(itapwk,wkpas).EQ.0)
3053 !
3054 480 itapwk = itapwk+1
3055 !
3056 !-----------------------------------------------------------------------
3057 ! ajout des tendances des poches froides
3058 CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake', &
3059 480 abortphy,flag_inhib_tend,itap,0)
3060 480 CALL prt_enerbil('wake',itap)
3061 !------------------------------------------------------------------------
3062
3063 ! Increment Wake state variables
3064
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_wake_tend .GT. 0.) THEN
3065
3066 CALL add_wake_tend &
3067 (d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_a_wk, d_dens_wk, wake_k, &
3068 'wake', abortphy)
3069 CALL prt_enerbil('wake',itap)
3070 ENDIF ! (iflag_wake_tend .GT. 0.)
3071 !
3072
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level .GE. 10) THEN
3073 print *,' physiq, after calwake, wake_s: ',wake_s(:)
3074 print *,' physiq, after calwake, wake_deltat: ',wake_deltat(:,1)
3075 print *,' physiq, after calwake, wake_deltaq: ',wake_deltaq(:,1)
3076 ENDIF
3077
3078
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_alp_wk_cond .GT. 0.) THEN
3079
3080 CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &
3081 480 wake_fip)
3082 ELSE
3083 wake_fip(:) = wake_fip_0(:)
3084 ENDIF ! (iflag_alp_wk_cond .GT. 0.)
3085
3086 ENDIF ! (iflag_wake>=1)
3087 !
3088 !===================================================================
3089 ! Convection seche (thermiques ou ajustement)
3090 !===================================================================
3091 !
3092 CALL stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
3093 480 ,seuil_inversion,weak_inversion,dthmin)
3094
3095
3096
3097
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_t_ajsb(:,:)=0.
3098
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_q_ajsb(:,:)=0.
3099
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_t_ajs(:,:)=0.
3100
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_u_ajs(:,:)=0.
3101
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_v_ajs(:,:)=0.
3102
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_q_ajs(:,:)=0.
3103
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 clwcon0th(:,:)=0.
3104 !
3105 ! fm_therm(:,:)=0.
3106 ! entr_therm(:,:)=0.
3107 ! detr_therm(:,:)=0.
3108 !
3109
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level>9) WRITE(lunout,*) &
3110 'AVANT LA CONVECTION SECHE , iflag_thermals=' &
3111 ,iflag_thermals,' nsplit_thermals=',nsplit_thermals
3112
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_thermals<0) THEN
3113 ! Rien
3114 ! ====
3115 IF (prt_level>9) WRITE(lunout,*)'pas de convection seche'
3116
3117
3118 ELSE
3119
3120 ! Thermiques
3121 ! ==========
3122
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level>9) WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
3123 ,iflag_thermals,' nsplit_thermals=',nsplit_thermals
3124
3125
3126 !cc nrlmd le 10/04/2012
3127
2/2
✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
19680 DO k=1,klev+1
3128
2/2
✓ Branch 0 taken 19084800 times.
✓ Branch 1 taken 19200 times.
19104480 DO i=1,klon
3129 19084800 pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
3130 19084800 pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
3131 19084800 pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
3132 19104000 pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
3133 ENDDO
3134 ENDDO
3135 !cc fin nrlmd le 10/04/2012
3136
3137
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_thermals>=1) THEN
3138 !jyg<
3139 !! IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
3140
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
3141 ! Appel des thermiques avec les profils exterieurs aux poches
3142
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
3143
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
3144 18607680 t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
3145 18607680 q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
3146 18607680 u_therm(i,k) = u_seri(i,k)
3147 18626400 v_therm(i,k) = v_seri(i,k)
3148 ENDDO
3149 ENDDO
3150 ELSE
3151 ! Appel des thermiques avec les profils moyens
3152 DO k=1,klev
3153 DO i=1,klon
3154 t_therm(i,k) = t_seri(i,k)
3155 q_therm(i,k) = q_seri(i,k)
3156 u_therm(i,k) = u_seri(i,k)
3157 v_therm(i,k) = v_seri(i,k)
3158 ENDDO
3159 ENDDO
3160 ENDIF
3161 !>jyg
3162 CALL calltherm(pdtphys &
3163 ,pplay,paprs,pphi,weak_inversion &
3164 ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
3165 ,u_therm,v_therm,t_therm,q_therm,zqsat,debut & !jyg
3166 ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
3167 ,fm_therm,entr_therm,detr_therm &
3168 ,zqasc,clwcon0th,lmax_th,ratqscth &
3169 ,ratqsdiff,zqsatth &
3170 !on rajoute ale et alp, et les
3171 !caracteristiques de la couche alim
3172 ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca &
3173 ,ztv,zpspsk,ztla,zthl &
3174 !cc nrlmd le 10/04/2012
3175 ,pbl_tke_input,pctsrf,omega,cell_area &
3176 ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
3177 ,n2,s2,ale_bl_stat &
3178 ,therm_tke_max,env_tke_max &
3179 ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
3180 ,alp_bl_conv,alp_bl_stat &
3181 !cc fin nrlmd le 10/04/2012
3182 480 ,zqla,ztva )
3183 !
3184 !jyg<
3185 !!jyg IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
3186
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
3187 ! Si les thermiques ne sont presents que hors des
3188 ! poches, la tendance moyenne associ\'ee doit etre
3189 ! multipliee par la fraction surfacique qu'ils couvrent.
3190
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
3191
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
3192 !
3193 18607680 d_deltat_the(i,k) = - d_t_ajs(i,k)
3194 18607680 d_deltaq_the(i,k) = - d_q_ajs(i,k)
3195 !
3196 18607680 d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
3197 18607680 d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
3198 18607680 d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
3199 18626400 d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
3200 !
3201 ENDDO
3202 ENDDO
3203 !
3204
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (ok_bug_split_th) THEN
3205 CALL add_wake_tend &
3206 480 (d_deltat_the, d_deltaq_the, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy)
3207 ELSE
3208 CALL add_wake_tend &
3209 (d_deltat_the, d_deltaq_the, dsig0, ddens0, ddens0, wake_k, 'the', abortphy)
3210 ENDIF
3211 480 CALL prt_enerbil('the',itap)
3212 !
3213 ENDIF ! (mod(iflag_pbl_split/10,10) .GE. 1)
3214 !
3215 CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, &
3216 480 dql0,dqi0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0)
3217 480 CALL prt_enerbil('thermals',itap)
3218 !
3219 !
3220 CALL alpale_th( phys_tstep, lmax_th, t_seri, cell_area, &
3221 cin, s2, n2, &
3222 ale_bl_trig, ale_bl_stat, ale_bl, &
3223 alp_bl, alp_bl_stat, &
3224 480 proba_notrig, random_notrig, cv_gen)
3225 !>jyg
3226
3227 ! ------------------------------------------------------------------
3228 ! Transport de la TKE par les panaches thermiques.
3229 ! FH : 2010/02/01
3230 ! if (iflag_pbl.eq.10) then
3231 ! call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
3232 ! s rg,paprs,pbl_tke)
3233 ! endif
3234 ! -------------------------------------------------------------------
3235
3236
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i=1,klon
3237 ! zmax_th(i)=pphi(i,lmax_th(i))/rg
3238 !CR:04/05/12:correction calcul zmax
3239 477600 zmax_th(i)=zmax0(i)
3240 ENDDO
3241
3242 ENDIF
3243
3244 ! Ajustement sec
3245 ! ==============
3246
3247 ! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
3248 ! a partir du sommet des thermiques.
3249 ! Dans le cas contraire, on demarre au niveau 1.
3250
3251
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN
3252
3253
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_thermals.eq.0) THEN
3254 IF (prt_level>9) WRITE(lunout,*)'ajsec'
3255 limbas(:)=1
3256 ELSE
3257
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 limbas(:)=lmax_th(:)
3258 ENDIF
3259
3260 ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
3261 ! pour des test de convergence numerique.
3262 ! Le nouveau ajsec est a priori mieux, meme pour le cas
3263 ! iflag_thermals = 0 (l'ancienne version peut faire des tendances
3264 ! non nulles numeriquement pour des mailles non concernees.
3265
3266
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_thermals==0) THEN
3267 ! Calling adjustment alone (but not the thermal plume model)
3268 CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
3269 , d_t_ajsb, d_q_ajsb)
3270
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 ELSE IF (iflag_thermals>0) THEN
3271 ! Calling adjustment above the top of thermal plumes
3272 CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
3273 480 , d_t_ajsb, d_q_ajsb)
3274 ENDIF
3275
3276 !--------------------------------------------------------------------
3277 ! ajout des tendances de l'ajustement sec ou des thermiques
3278 CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs, &
3279 480 'ajsb',abortphy,flag_inhib_tend,itap,0)
3280 480 CALL prt_enerbil('ajsb',itap)
3281
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
3282
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
3283
3284 !---------------------------------------------------------------------
3285
3286 ENDIF
3287
3288 ENDIF
3289 !
3290 !===================================================================
3291 ! Computation of ratqs, the width (normalized) of the subrid scale
3292 ! water distribution
3293 CALL calcratqs(klon,klev,prt_level,lunout, &
3294 iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
3295 ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
3296 tau_ratqs,fact_cldcon,wake_s, wake_deltaq, &
3297 ptconv,ptconvth,clwcon0th, rnebcon0th, &
3298 paprs,pplay,q_seri,zqsat,fm_therm, &
3299 480 ratqs,ratqsc,ratqs_inter)
3300
3301 !
3302 ! Appeler le processus de condensation a grande echelle
3303 ! et le processus de precipitation
3304 !-------------------------------------------------------------------------
3305
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level .GE.10) THEN
3306 print *,'itap, ->fisrtilp ',itap
3307 ENDIF
3308 !
3309 CALL fisrtilp(phys_tstep,paprs,pplay, &
3310 t_seri, q_seri,ptconv,ratqs, &
3311 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &
3312 rain_lsc, snow_lsc, &
3313 pfrac_impa, pfrac_nucl, pfrac_1nucl, &
3314 frac_impa, frac_nucl, beta_prec_fisrt, &
3315 prfl, psfl, rhcl, &
3316 zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
3317 480 iflag_ice_thermo)
3318 !
3319
3/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 477120 times.
477600 WHERE (rain_lsc < 0) rain_lsc = 0.
3320
3/4
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 477120 times.
477600 WHERE (snow_lsc < 0) snow_lsc = 0.
3321
3322 !+JLD
3323 ! write(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
3324 ! & ,((rcw-rcpd)*rain_lsc + (rcs-rcpd)*snow_lsc)*t_seri(1,1)-rlvtt*rain_lsc+rlstt*snow_lsc &
3325 ! & ,rain_lsc,snow_lsc
3326 ! write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
3327 !-JLD
3328 CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs, &
3329 480 'lsc',abortphy,flag_inhib_tend,itap,0)
3330 480 CALL prt_enerbil('lsc',itap)
3331
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 rain_num(:)=0.
3332
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
3333
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
3334
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 18607680 times.
18626400 IF (ql_seri(i,k)>oliqmax) THEN
3335 rain_num(i)=rain_num(i)+(ql_seri(i,k)-oliqmax)*zmasse(i,k)/pdtphys
3336 ql_seri(i,k)=oliqmax
3337 ENDIF
3338 ENDDO
3339 ENDDO
3340
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (nqo==3) THEN
3341
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
3342
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
3343
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 18607680 times.
18626400 IF (qs_seri(i,k)>oicemax) THEN
3344 rain_num(i)=rain_num(i)+(qs_seri(i,k)-oicemax)*zmasse(i,k)/pdtphys
3345 qs_seri(i,k)=oicemax
3346 ENDIF
3347 ENDDO
3348 ENDDO
3349 ENDIF
3350
3351 !---------------------------------------------------------------------------
3352
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
3353
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
3354 18607680 cldfra(i,k) = rneb(i,k)
3355 !CR: a quoi ca sert? Faut-il ajouter qs_seri?
3356
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 18607680 times.
18626400 IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
3357 ENDDO
3358 ENDDO
3359 IF (check) THEN
3360 za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
3361 WRITE(lunout,*)"apresilp=", za
3362 zx_t = 0.0
3363 za = 0.0
3364 DO i = 1, klon
3365 za = za + cell_area(i)/REAL(klon)
3366 zx_t = zx_t + (rain_lsc(i) &
3367 + snow_lsc(i))*cell_area(i)/REAL(klon)
3368 ENDDO
3369 zx_t = zx_t/za*phys_tstep
3370 WRITE(lunout,*)"Precip=", zx_t
3371 ENDIF
3372
3373
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
3374 CALL writefield_phy('u_seri',u_seri,nbp_lev)
3375 CALL writefield_phy('v_seri',v_seri,nbp_lev)
3376 CALL writefield_phy('t_seri',t_seri,nbp_lev)
3377 CALL writefield_phy('q_seri',q_seri,nbp_lev)
3378 ENDIF
3379
3380 !
3381 !-------------------------------------------------------------------
3382 ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
3383 !-------------------------------------------------------------------
3384
3385 ! 1. NUAGES CONVECTIFS
3386 !
3387 !IM cf FH
3388 ! IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
3389
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
3390 snow_tiedtke=0.
3391 ! print*,'avant calcul de la pseudo precip '
3392 ! print*,'iflag_cld_th',iflag_cld_th
3393 IF (iflag_cld_th.eq.-1) THEN
3394 rain_tiedtke=rain_con
3395 ELSE
3396 ! print*,'calcul de la pseudo precip '
3397 rain_tiedtke=0.
3398 ! print*,'calcul de la pseudo precip 0'
3399 DO k=1,klev
3400 DO i=1,klon
3401 IF (d_q_con(i,k).lt.0.) THEN
3402 rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
3403 *(paprs(i,k)-paprs(i,k+1))/rg
3404 ENDIF
3405 ENDDO
3406 ENDDO
3407 ENDIF
3408 !
3409 ! call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
3410 !
3411
3412 ! Nuages diagnostiques pour Tiedtke
3413 CALL diagcld1(paprs,pplay, &
3414 !IM cf FH. rain_con,snow_con,ibas_con,itop_con,
3415 rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
3416 diafra,dialiq)
3417 DO k = 1, klev
3418 DO i = 1, klon
3419 IF (diafra(i,k).GT.cldfra(i,k)) THEN
3420 cldliq(i,k) = dialiq(i,k)
3421 cldfra(i,k) = diafra(i,k)
3422 ENDIF
3423 ENDDO
3424 ENDDO
3425
3426
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 ELSE IF (iflag_cld_th.ge.3) THEN
3427 ! On prend pour les nuages convectifs le max du calcul de la
3428 ! convection et du calcul du pas de temps precedent diminue d'un facteur
3429 ! facttemps
3430 480 facteur = pdtphys *facttemps
3431
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
3432
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
3433 18607680 rnebcon(i,k)=rnebcon(i,k)*facteur
3434
2/2
✓ Branch 0 taken 1038140 times.
✓ Branch 1 taken 17569540 times.
18626400 IF (rnebcon0(i,k)*clwcon0(i,k).GT.rnebcon(i,k)*clwcon(i,k)) THEN
3435 1038140 rnebcon(i,k)=rnebcon0(i,k)
3436 1038140 clwcon(i,k)=clwcon0(i,k)
3437 ENDIF
3438 ENDDO
3439 ENDDO
3440
3441 ! On prend la somme des fractions nuageuses et des contenus en eau
3442
3443
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_cld_th>=5) THEN
3444
3445
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
3446
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 ptconvth(:,k)=fm_therm(:,k+1)>0.
3447 ENDDO
3448
3449
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_coupl==4) THEN
3450
3451 ! Dans le cas iflag_coupl==4, on prend la somme des convertures
3452 ! convectives et lsc dans la partie des thermiques
3453 ! Le controle par iflag_coupl est peut etre provisoire.
3454 DO k=1,klev
3455 DO i=1,klon
3456 IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
3457 cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
3458 cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
3459 ELSE IF (ptconv(i,k)) THEN
3460 cldfra(i,k)=rnebcon(i,k)
3461 cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
3462 ENDIF
3463 ENDDO
3464 ENDDO
3465
3466
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 ELSE IF (iflag_coupl==5) THEN
3467
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
19200 DO k=1,klev
3468
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
3469 18607680 cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
3470 18626400 cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
3471 ENDDO
3472 ENDDO
3473
3474 ELSE
3475
3476 ! Si on est sur un point touche par la convection
3477 ! profonde et pas par les thermiques, on prend la
3478 ! couverture nuageuse et l'eau nuageuse de la convection
3479 ! profonde.
3480
3481 !IM/FH: 2011/02/23
3482 ! definition des points sur lesquels ls thermiques sont actifs
3483
3484 DO k=1,klev
3485 DO i=1,klon
3486 IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
3487 cldfra(i,k)=rnebcon(i,k)
3488 cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
3489 ENDIF
3490 ENDDO
3491 ENDDO
3492
3493 ENDIF
3494
3495 ELSE
3496
3497 ! Ancienne version
3498 cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
3499 cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
3500 ENDIF
3501
3502 ENDIF
3503
3504 ! plulsc(:)=0.
3505 ! do k=1,klev,-1
3506 ! do i=1,klon
3507 ! zzz=prfl(:,k)+psfl(:,k)
3508 ! if (.not.ptconvth.zzz.gt.0.)
3509 ! enddo prfl, psfl,
3510 ! enddo
3511 !
3512 ! 2. NUAGES STARTIFORMES
3513 !
3514 IF (ok_stratus) THEN
3515 CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
3516 DO k = 1, klev
3517 DO i = 1, klon
3518 IF (diafra(i,k).GT.cldfra(i,k)) THEN
3519 cldliq(i,k) = dialiq(i,k)
3520 cldfra(i,k) = diafra(i,k)
3521 ENDIF
3522 ENDDO
3523 ENDDO
3524 ENDIF
3525 !
3526 ! Precipitation totale
3527 !
3528
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
3529 477120 rain_fall(i) = rain_con(i) + rain_lsc(i)
3530 477600 snow_fall(i) = snow_con(i) + snow_lsc(i)
3531 ENDDO
3532 !
3533 ! Calculer l'humidite relative pour diagnostique
3534 !
3535
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
3536
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
3537 18607680 zx_t = t_seri(i,k)
3538 IF (thermcep) THEN
3539 !! if (iflag_ice_thermo.eq.0) then !jyg
3540 18607680 zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
3541 !! else !jyg
3542 !! zdelta = MAX(0.,SIGN(1.,t_glace_min-zx_t)) !jyg
3543 !! endif !jyg
3544 18607680 zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
3545 18607680 zx_qs = MIN(0.5,zx_qs)
3546 18607680 zcor = 1./(1.-retv*zx_qs)
3547 18607680 zx_qs = zx_qs*zcor
3548 ELSE
3549 !! IF (zx_t.LT.t_coup) THEN !jyg
3550 IF (zx_t.LT.rtt) THEN !jyg
3551 zx_qs = qsats(zx_t)/pplay(i,k)
3552 ELSE
3553 zx_qs = qsatl(zx_t)/pplay(i,k)
3554 ENDIF
3555 ENDIF
3556 18607680 zx_rh(i,k) = q_seri(i,k)/zx_qs
3557
1/2
✓ Branch 0 taken 18607680 times.
✗ Branch 1 not taken.
18607680 IF (iflag_ice_thermo .GT. 0) THEN
3558 18607680 zx_rhl(i,k) = q_seri(i,k)/(qsatl(zx_t)/pplay(i,k))
3559 18607680 zx_rhi(i,k) = q_seri(i,k)/(qsats(zx_t)/pplay(i,k))
3560 ENDIF
3561 18626400 zqsat(i,k)=zx_qs
3562 ENDDO
3563 ENDDO
3564
3565 !IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
3566 ! equivalente a 2m (tpote) pour diagnostique
3567 !
3568
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
3569 477120 tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA
3570 IF (thermcep) THEN
3571
2/2
✓ Branch 0 taken 159993 times.
✓ Branch 1 taken 317127 times.
477120 IF(zt2m(i).LT.RTT) then
3572 159993 Lheat=RLSTT
3573 ELSE
3574 317127 Lheat=RLVTT
3575 ENDIF
3576 ELSE
3577 IF (zt2m(i).LT.RTT) THEN
3578 Lheat=RLSTT
3579 ELSE
3580 Lheat=RLVTT
3581 ENDIF
3582 ENDIF
3583 tpote(i) = tpot(i)* &
3584 477600 EXP((Lheat *qsat2m(i))/(RCPD*zt2m(i)))
3585 ENDDO
3586
3587 IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN ! ModThL
3588 ENDIF !type_trac = inca or inco
3589 IF (type_trac == 'repr') THEN
3590 ENDIF
3591
3592 !
3593 ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
3594 !
3595
2/2
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 360 times.
480 IF (MOD(itaprad,radpas).EQ.0) THEN
3596
3597 !
3598 !jq - introduce the aerosol direct and first indirect radiative forcings
3599 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
3600
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (flag_aerosol .GT. 0) THEN
3601 IF (iflag_rrtm .EQ. 0) THEN !--old radiation
3602 IF (.NOT. aerosol_couple) THEN
3603 !
3604 CALL readaerosol_optic( &
3605 debut, flag_aerosol, itap, jD_cur-jD_ref, &
3606 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
3607 mass_solu_aero, mass_solu_aero_pi, &
3608 tau_aero, piz_aero, cg_aero, &
3609 tausum_aero, tau3d_aero)
3610 ENDIF
3611 ELSE ! RRTM radiation
3612 IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
3613 abort_message='config_inca=aero et rrtm=1 impossible'
3614 CALL abort_physic(modname,abort_message,1)
3615 ELSE
3616 !
3617 IF (NSW.EQ.6) THEN
3618 !--new aerosol properties SW and LW
3619 !
3620 !--climatologies or INCA aerosols
3621 CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
3622 flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
3623 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
3624 tr_seri, mass_solu_aero, mass_solu_aero_pi, &
3625 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
3626 tausum_aero, drytausum_aero, tau3d_aero)
3627
3628 IF (flag_aerosol .EQ. 7) THEN
3629 CALL MACv2SP(pphis,pplay,paprs,longitude_deg,latitude_deg, &
3630 tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
3631 ENDIF
3632
3633 !
3634 ELSE IF (NSW.EQ.2) THEN
3635 !--for now we use the old aerosol properties
3636 !
3637 CALL readaerosol_optic( &
3638 debut, flag_aerosol, itap, jD_cur-jD_ref, &
3639 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
3640 mass_solu_aero, mass_solu_aero_pi, &
3641 tau_aero, piz_aero, cg_aero, &
3642 tausum_aero, tau3d_aero)
3643 !
3644 !--natural aerosols
3645 tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
3646 piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
3647 cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
3648 !--all aerosols
3649 tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
3650 piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
3651 cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
3652 !
3653 !--no LW optics
3654 tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
3655 !
3656 ELSE
3657 abort_message='Only NSW=2 or 6 are possible with ' &
3658 // 'aerosols and iflag_rrtm=1'
3659 CALL abort_physic(modname,abort_message,1)
3660 ENDIF
3661 !
3662 ENDIF
3663 ENDIF
3664 ELSE !--flag_aerosol = 0
3665
6/6
✓ Branch 0 taken 1680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 10080 times.
✓ Branch 3 taken 1680 times.
✓ Branch 4 taken 10019520 times.
✓ Branch 5 taken 10080 times.
10031400 tausum_aero(:,:,:) = 0.
3666
4/4
✓ Branch 0 taken 1680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 1669920 times.
✓ Branch 3 taken 1680 times.
1671720 drytausum_aero(:,:) = 0.
3667
4/4
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4651920 times.
✓ Branch 3 taken 4680 times.
4656720 mass_solu_aero(:,:) = 0.
3668
4/4
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4651920 times.
✓ Branch 3 taken 4680 times.
4656720 mass_solu_aero_pi(:,:) = 0.
3669
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (iflag_rrtm .EQ. 0) THEN !--old radiation
3670 tau_aero(:,:,:,:) = 1.e-15
3671 piz_aero(:,:,:,:) = 1.
3672 cg_aero(:,:,:,:) = 0.
3673 ELSE
3674
8/8
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 1440 times.
✓ Branch 3 taken 720 times.
✓ Branch 4 taken 56160 times.
✓ Branch 5 taken 1440 times.
✓ Branch 6 taken 55823040 times.
✓ Branch 7 taken 56160 times.
55881480 tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
3675
8/8
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 3840 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 149760 times.
✓ Branch 5 taken 3840 times.
✓ Branch 6 taken 148861440 times.
✓ Branch 7 taken 149760 times.
149017080 tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
3676
8/8
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 1440 times.
✓ Branch 3 taken 720 times.
✓ Branch 4 taken 56160 times.
✓ Branch 5 taken 1440 times.
✓ Branch 6 taken 55823040 times.
✓ Branch 7 taken 56160 times.
55881480 piz_aero_sw_rrtm(:,:,:,:) = 1.0
3677
8/8
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 1440 times.
✓ Branch 3 taken 720 times.
✓ Branch 4 taken 56160 times.
✓ Branch 5 taken 1440 times.
✓ Branch 6 taken 55823040 times.
✓ Branch 7 taken 56160 times.
55881480 cg_aero_sw_rrtm(:,:,:,:) = 0.0
3678 ENDIF
3679 ENDIF
3680 !
3681 !--WMO criterion to determine tropopause
3682 120 CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
3683 !
3684 !--STRAT AEROSOL
3685 !--updates tausum_aero,tau_aero,piz_aero,cg_aero
3686
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (flag_aerosol_strat.GT.0) THEN
3687 IF (prt_level .GE.10) THEN
3688 PRINT *,'appel a readaerosolstrat', mth_cur
3689 ENDIF
3690 IF (iflag_rrtm.EQ.0) THEN
3691 IF (flag_aerosol_strat.EQ.1) THEN
3692 CALL readaerosolstrato(debut)
3693 ELSE
3694 abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
3695 CALL abort_physic(modname,abort_message,1)
3696 ENDIF
3697 ELSE
3698 !--prescribed strat aerosols
3699 !--only in the case of non-interactive strat aerosols
3700 IF (flag_aerosol_strat.EQ.1) THEN
3701 CALL readaerosolstrato1_rrtm(debut)
3702 ELSEIF (flag_aerosol_strat.EQ.2) THEN
3703 CALL readaerosolstrato2_rrtm(debut, ok_volcan)
3704 ELSE
3705 abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
3706 CALL abort_physic(modname,abort_message,1)
3707 ENDIF
3708 ENDIF
3709 ELSE
3710
4/4
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 715680 times.
✓ Branch 3 taken 720 times.
716520 tausum_aero(:,:,id_STRAT_phy) = 0.
3711 ENDIF
3712 !
3713 !--fin STRAT AEROSOL
3714 !
3715
3716 ! Calculer les parametres optiques des nuages et quelques
3717 ! parametres pour diagnostiques:
3718 !
3719
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
120 IF (aerosol_couple.AND.config_inca=='aero') THEN
3720 mass_solu_aero(:,:) = ccm(:,:,1)
3721 mass_solu_aero_pi(:,:) = ccm(:,:,2)
3722 ENDIF
3723
3724
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
120 IF (ok_newmicro) then
3725 ! AI IF (iflag_rrtm.NE.0) THEN
3726
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
120 IF (iflag_rrtm.EQ.1) THEN
3727
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
120 IF (ok_cdnc.AND.NRADLP.NE.3) THEN
3728 abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
3729 // 'pour ok_cdnc'
3730 CALL abort_physic(modname,abort_message,1)
3731 ENDIF
3732 ENDIF
3733 CALL newmicro (flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, &
3734 paprs, pplay, t_seri, cldliq, cldfra, &
3735 cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
3736 flwp, fiwp, flwc, fiwc, &
3737 mass_solu_aero, mass_solu_aero_pi, &
3738 cldtaupi, re, fl, ref_liq, ref_ice, &
3739 120 ref_liq_pi, ref_ice_pi)
3740 ELSE
3741 CALL nuage (paprs, pplay, &
3742 t_seri, cldliq, cldfra, cldtau, cldemi, &
3743 cldh, cldl, cldm, cldt, cldq, &
3744 ok_aie, &
3745 mass_solu_aero, mass_solu_aero_pi, &
3746 bl95_b0, bl95_b1, &
3747 cldtaupi, re, fl)
3748 ENDIF
3749 !
3750 !IM betaCRF
3751 !
3752
4/4
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4651920 times.
✓ Branch 3 taken 4680 times.
4656720 cldtaurad = cldtau
3753
4/4
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4651920 times.
✓ Branch 3 taken 4680 times.
4656720 cldtaupirad = cldtaupi
3754
4/4
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4651920 times.
✓ Branch 3 taken 4680 times.
4656720 cldemirad = cldemi
3755
4/4
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4651920 times.
✓ Branch 3 taken 4680 times.
4656720 cldfrarad = cldfra
3756
3757 !
3758 IF (lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. &
3759
4/8
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 120 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 120 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 120 times.
✗ Branch 7 not taken.
120 lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN
3760 !
3761 ! global
3762 !
3763 !IM 251017 begin
3764 ! print*,'physiq betaCRF global zdtime=',zdtime
3765 !IM 251017 end
3766
2/2
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
4800 DO k=1, klev
3767
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
4656720 DO i=1, klon
3768
2/2
✓ Branch 0 taken 1007886 times.
✓ Branch 1 taken 3644034 times.
4651920 IF (pplay(i,k).GE.pfree) THEN
3769 1007886 beta(i,k) = beta_pbl
3770 ELSE
3771 3644034 beta(i,k) = beta_free
3772 ENDIF
3773
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
4651920 IF (mskocean_beta) THEN
3774 beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
3775 ENDIF
3776 4651920 cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
3777 4651920 cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
3778 4651920 cldemirad(i,k) = cldemi(i,k) * beta(i,k)
3779 4656600 cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
3780 ENDDO
3781 ENDDO
3782 !
3783 ELSE
3784 !
3785 ! regional
3786 !
3787 DO k=1, klev
3788 DO i=1,klon
3789 !
3790 IF (longitude_deg(i).ge.lon1_beta.AND. &
3791 longitude_deg(i).le.lon2_beta.AND. &
3792 latitude_deg(i).le.lat1_beta.AND. &
3793 latitude_deg(i).ge.lat2_beta) THEN
3794 IF (pplay(i,k).GE.pfree) THEN
3795 beta(i,k) = beta_pbl
3796 ELSE
3797 beta(i,k) = beta_free
3798 ENDIF
3799 IF (mskocean_beta) THEN
3800 beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
3801 ENDIF
3802 cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
3803 cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
3804 cldemirad(i,k) = cldemi(i,k) * beta(i,k)
3805 cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
3806 ENDIF
3807 !
3808 ENDDO
3809 ENDDO
3810 !
3811 ENDIF
3812
3813 !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek
3814
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (ok_chlorophyll) THEN
3815 print*,"-- reading chlorophyll"
3816 CALL readchlorophyll(debut)
3817 ENDIF
3818
3819 !--if ok_suntime_rrtm we use ancillay data for RSUN
3820 !--previous values are therefore overwritten
3821 !--this is needed for CMIP6 runs
3822 !--and only possible for new radiation scheme
3823
2/4
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 120 times.
120 IF (iflag_rrtm.EQ.1.AND.ok_suntime_rrtm) THEN
3824 CALL read_rsun_rrtm(debut)
3825 ENDIF
3826
3827
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (mydebug) THEN
3828 CALL writefield_phy('u_seri',u_seri,nbp_lev)
3829 CALL writefield_phy('v_seri',v_seri,nbp_lev)
3830 CALL writefield_phy('t_seri',t_seri,nbp_lev)
3831 CALL writefield_phy('q_seri',q_seri,nbp_lev)
3832 ENDIF
3833
3834 !
3835 !sonia : If Iflag_radia >=2, pertubation of some variables
3836 !input to radiation (DICE)
3837 !
3838
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (iflag_radia .ge. 2) THEN
3839 zsav_tsol (:) = zxtsol(:)
3840 CALL perturb_radlwsw(zxtsol,iflag_radia)
3841 ENDIF
3842
3843
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
120 IF (aerosol_couple.AND.config_inca=='aero') THEN
3844 ELSE
3845 !
3846 !IM calcul radiatif pour le cas actuel
3847 !
3848 120 RCO2 = RCO2_act
3849 120 RCH4 = RCH4_act
3850 120 RN2O = RN2O_act
3851 120 RCFC11 = RCFC11_act
3852 120 RCFC12 = RCFC12_act
3853 !
3854 !--interactive CO2 in ppm from carbon cycle
3855
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
120 IF (carbon_cycle_rad.AND..NOT.debut) THEN
3856 RCO2=RCO2_glo
3857 ENDIF
3858 !
3859
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (prt_level .GE.10) THEN
3860 print *,' ->radlwsw, number 1 '
3861 ENDIF
3862 !
3863 CALL radlwsw &
3864 (dist, rmu0, fract, &
3865 !albedo SB >>>
3866 ! paprs, pplay,zxtsol,albsol1, albsol2, &
3867 paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
3868 !albedo SB <<<
3869 t_seri,q_seri,wo, &
3870 cldfrarad, cldemirad, cldtaurad, &
3871 ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &
3872 flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
3873 tau_aero, piz_aero, cg_aero, &
3874 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
3875 ! Rajoute par OB pour RRTM
3876 tau_aero_lw_rrtm, &
3877 cldtaupirad, &
3878 ! zqsat, flwcrad, fiwcrad, &
3879 zqsat, flwc, fiwc, &
3880 ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
3881 heat,heat0,cool,cool0,albpla, &
3882 heat_volc,cool_volc, &
3883 topsw,toplw,solsw,solswfdiff,sollw, &
3884 sollwdown, &
3885 topsw0,toplw0,solsw0,sollw0, &
3886 lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup, &
3887 swdnc0, swdn0, swdn, swupc0, swup0, swup, &
3888 topswad_aero, solswad_aero, &
3889 topswai_aero, solswai_aero, &
3890 topswad0_aero, solswad0_aero, &
3891 topsw_aero, topsw0_aero, &
3892 solsw_aero, solsw0_aero, &
3893 topswcf_aero, solswcf_aero, &
3894 !-C. Kleinschmitt for LW diagnostics
3895 toplwad_aero, sollwad_aero,&
3896 toplwai_aero, sollwai_aero, &
3897 toplwad0_aero, sollwad0_aero,&
3898 !-end
3899 ZLWFT0_i, ZFLDN0, ZFLUP0, &
3900
2/4
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 120 times.
✗ Branch 3 not taken.
240 ZSWFT0_i, ZFSDN0, ZFSUP0)
3901
3902 !lwoff=y, betalwoff=1. : offset LW CRE for radiation code and other
3903 !schemes
3904
3/4
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 119280 times.
✓ Branch 3 taken 120 times.
119520 toplw = toplw + betalwoff * (toplw0 - toplw)
3905
3/4
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 119280 times.
✓ Branch 3 taken 120 times.
119520 sollw = sollw + betalwoff * (sollw0 - sollw)
3906
5/6
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4800 times.
✓ Branch 3 taken 120 times.
✓ Branch 4 taken 4771200 times.
✓ Branch 5 taken 4800 times.
4776240 lwdn = lwdn + betalwoff * (lwdn0 - lwdn)
3907
5/6
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4800 times.
✓ Branch 3 taken 120 times.
✓ Branch 4 taken 4771200 times.
✓ Branch 5 taken 4800 times.
4776240 lwup = lwup + betalwoff * (lwup0 - lwup)
3908 sollwdown(:)= sollwdown(:) + betalwoff *(-1.*ZFLDN0(:,1) - &
3909
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
119400 sollwdown(:))
3910
5/6
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4680 times.
✓ Branch 3 taken 120 times.
✓ Branch 4 taken 4651920 times.
✓ Branch 5 taken 4680 times.
4656840 cool = cool + betalwoff * (cool0 - cool)
3911
3912
3913 !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
3914 !IM des taux doit etre different du taux actuel
3915 !IM Par defaut on a les taux perturbes egaux aux taux actuels
3916 !
3917 IF (RCO2_per.NE.RCO2_act.OR. &
3918 RCH4_per.NE.RCH4_act.OR. &
3919 RN2O_per.NE.RN2O_act.OR. &
3920
5/10
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 120 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 120 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 120 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 120 times.
120 RCFC11_per.NE.RCFC11_act.OR. &
3921 RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE.
3922 !
3923
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (ok_4xCO2atm) THEN
3924 !
3925 RCO2 = RCO2_per
3926 RCH4 = RCH4_per
3927 RN2O = RN2O_per
3928 RCFC11 = RCFC11_per
3929 RCFC12 = RCFC12_per
3930 !
3931 IF (prt_level .GE.10) THEN
3932 print *,' ->radlwsw, number 2 '
3933 ENDIF
3934 !
3935 CALL radlwsw &
3936 (dist, rmu0, fract, &
3937 !albedo SB >>>
3938 ! paprs, pplay,zxtsol,albsol1, albsol2, &
3939 paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
3940 !albedo SB <<<
3941 t_seri,q_seri,wo, &
3942 cldfrarad, cldemirad, cldtaurad, &
3943 ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &
3944 flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
3945 tau_aero, piz_aero, cg_aero, &
3946 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
3947 ! Rajoute par OB pour RRTM
3948 tau_aero_lw_rrtm, &
3949 cldtaupi, &
3950 ! zqsat, flwcrad, fiwcrad, &
3951 zqsat, flwc, fiwc, &
3952 ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
3953 heatp,heat0p,coolp,cool0p,albplap, &
3954 heat_volc,cool_volc, &
3955 topswp,toplwp,solswp,solswfdiffp,sollwp, &
3956 sollwdownp, &
3957 topsw0p,toplw0p,solsw0p,sollw0p, &
3958 lwdnc0p, lwdn0p, lwdnp, lwupc0p, lwup0p, lwupp, &
3959 swdnc0p, swdn0p, swdnp, swupc0p, swup0p, swupp, &
3960 topswad_aerop, solswad_aerop, &
3961 topswai_aerop, solswai_aerop, &
3962 topswad0_aerop, solswad0_aerop, &
3963 topsw_aerop, topsw0_aerop, &
3964 solsw_aerop, solsw0_aerop, &
3965 topswcf_aerop, solswcf_aerop, &
3966 !-C. Kleinschmitt for LW diagnostics
3967 toplwad_aerop, sollwad_aerop,&
3968 toplwai_aerop, sollwai_aerop, &
3969 toplwad0_aerop, sollwad0_aerop,&
3970 !-end
3971 ZLWFT0_i, ZFLDN0, ZFLUP0, &
3972 ZSWFT0_i, ZFSDN0, ZFSUP0)
3973 ENDIF !ok_4xCO2atm
3974 ENDIF ! aerosol_couple
3975 120 itaprad = 0
3976 !
3977 ! If Iflag_radia >=2, reset pertubed variables
3978 !
3979
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
120 IF (iflag_radia .ge. 2) THEN
3980 zxtsol(:) = zsav_tsol (:)
3981 ENDIF
3982 ENDIF ! MOD(itaprad,radpas)
3983 480 itaprad = itaprad + 1
3984
3985
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_radia.eq.0) THEN
3986 IF (prt_level.ge.9) THEN
3987 PRINT *,'--------------------------------------------------'
3988 PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
3989 PRINT *,'>>>> heat et cool mis a zero '
3990 PRINT *,'--------------------------------------------------'
3991 ENDIF
3992 heat=0.
3993 cool=0.
3994 sollw=0. ! MPL 01032011
3995 solsw=0.
3996 radsol=0.
3997 swup=0. ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
3998 swup0=0.
3999 lwup=0.
4000 lwup0=0.
4001 lwdn=0.
4002 lwdn0=0.
4003 ENDIF
4004
4005 !
4006 ! Calculer radsol a l'exterieur de radlwsw
4007 ! pour prendre en compte le cycle diurne
4008 ! recode par Olivier Boucher en sept 2015
4009 !
4010
4/12
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 477120 times.
✓ Branch 11 taken 480 times.
478080 radsol=solsw*swradcorr+sollw
4011
4012
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (ok_4xCO2atm) THEN
4013 radsolp=solswp*swradcorr+sollwp
4014 ENDIF
4015
4016 !
4017 ! Ajouter la tendance des rayonnements (tous les pas)
4018 ! avec une correction pour le cycle diurne dans le SW
4019 !
4020
4021
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1, klev
4022
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626400 d_t_swr(:,k)=swradcorr(:)*heat(:,k)*phys_tstep/RDAY
4023
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626400 d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*phys_tstep/RDAY
4024
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626400 d_t_lwr(:,k)=-cool(:,k)*phys_tstep/RDAY
4025
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 d_t_lw0(:,k)=-cool0(:,k)*phys_tstep/RDAY
4026 ENDDO
4027
4028 480 CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy,flag_inhib_tend,itap,0)
4029 480 CALL prt_enerbil('SW',itap)
4030 480 CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy,flag_inhib_tend,itap,0)
4031 480 CALL prt_enerbil('LW',itap)
4032
4033 !
4034
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
4035 CALL writefield_phy('u_seri',u_seri,nbp_lev)
4036 CALL writefield_phy('v_seri',v_seri,nbp_lev)
4037 CALL writefield_phy('t_seri',t_seri,nbp_lev)
4038 CALL writefield_phy('q_seri',q_seri,nbp_lev)
4039 ENDIF
4040
4041 ! Calculer l'hydrologie de la surface
4042 !
4043 ! CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
4044 ! . agesno, ftsol,fqsurf,fsnow, ruis)
4045 !
4046
4047 !
4048 ! Calculer le bilan du sol et la derive de temperature (couplage)
4049 !
4050
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
4051 ! bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
4052 ! a la demande de JLD
4053 477600 bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
4054 ENDDO
4055 !
4056 !moddeblott(jan95)
4057 ! Appeler le programme de parametrisation de l'orographie
4058 ! a l'echelle sous-maille:
4059 !
4060
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level .GE.10) THEN
4061 print *,' call orography ? ', ok_orodr
4062 ENDIF
4063 !
4064
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (ok_orodr) THEN
4065 !
4066 ! selection des points pour lesquels le shema est actif:
4067 480 igwd=0
4068
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i=1,klon
4069 477120 itest(i)=0
4070 ! IF ((zstd(i).gt.10.0)) THEN
4071
3/4
✓ Branch 0 taken 222720 times.
✓ Branch 1 taken 254400 times.
✓ Branch 2 taken 222720 times.
✗ Branch 3 not taken.
477600 IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
4072 222720 itest(i)=1
4073 222720 igwd=igwd+1
4074 222720 idx(igwd)=i
4075 ENDIF
4076 ENDDO
4077 ! igwdim=MAX(1,igwd)
4078 !
4079
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (ok_strato) THEN
4080
4081 CALL drag_noro_strato(0,klon,klev,phys_tstep,paprs,pplay, &
4082 zmea,zstd, zsig, zgam, zthe,zpic,zval, &
4083 igwd,idx,itest, &
4084 t_seri, u_seri, v_seri, &
4085 zulow, zvlow, zustrdr, zvstrdr, &
4086 480 d_t_oro, d_u_oro, d_v_oro)
4087
4088 ELSE
4089 CALL drag_noro(klon,klev,phys_tstep,paprs,pplay, &
4090 zmea,zstd, zsig, zgam, zthe,zpic,zval, &
4091 igwd,idx,itest, &
4092 t_seri, u_seri, v_seri, &
4093 zulow, zvlow, zustrdr, zvstrdr, &
4094 d_t_oro, d_u_oro, d_v_oro)
4095 ENDIF
4096 !
4097 ! ajout des tendances
4098 !-----------------------------------------------------------------------
4099 ! ajout des tendances de la trainee de l'orographie
4100 CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro', &
4101 480 abortphy,flag_inhib_tend,itap,0)
4102 480 CALL prt_enerbil('oro',itap)
4103 !----------------------------------------------------------------------
4104 !
4105 ENDIF ! fin de test sur ok_orodr
4106 !
4107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
4108 CALL writefield_phy('u_seri',u_seri,nbp_lev)
4109 CALL writefield_phy('v_seri',v_seri,nbp_lev)
4110 CALL writefield_phy('t_seri',t_seri,nbp_lev)
4111 CALL writefield_phy('q_seri',q_seri,nbp_lev)
4112 ENDIF
4113
4114
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (ok_orolf) THEN
4115 !
4116 ! selection des points pour lesquels le shema est actif:
4117 480 igwd=0
4118
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i=1,klon
4119 477120 itest(i)=0
4120
2/2
✓ Branch 0 taken 222720 times.
✓ Branch 1 taken 254400 times.
477600 IF ((zpic(i)-zmea(i)).GT.100.) THEN
4121 222720 itest(i)=1
4122 222720 igwd=igwd+1
4123 222720 idx(igwd)=i
4124 ENDIF
4125 ENDDO
4126 ! igwdim=MAX(1,igwd)
4127 !
4128
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (ok_strato) THEN
4129
4130 CALL lift_noro_strato(klon,klev,phys_tstep,paprs,pplay, &
4131 latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
4132 igwd,idx,itest, &
4133 t_seri, u_seri, v_seri, &
4134 zulow, zvlow, zustrli, zvstrli, &
4135 480 d_t_lif, d_u_lif, d_v_lif )
4136
4137 ELSE
4138 CALL lift_noro(klon,klev,phys_tstep,paprs,pplay, &
4139 latitude_deg,zmea,zstd,zpic, &
4140 itest, &
4141 t_seri, u_seri, v_seri, &
4142 zulow, zvlow, zustrli, zvstrli, &
4143 d_t_lif, d_u_lif, d_v_lif)
4144 ENDIF
4145
4146 ! ajout des tendances de la portance de l'orographie
4147 CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, &
4148 480 'lif', abortphy,flag_inhib_tend,itap,0)
4149 480 CALL prt_enerbil('lif',itap)
4150 ENDIF ! fin de test sur ok_orolf
4151
4152
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (ok_hines) then
4153 ! HINES GWD PARAMETRIZATION
4154 east_gwstress=0.
4155 west_gwstress=0.
4156 du_gwd_hines=0.
4157 dv_gwd_hines=0.
4158 CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, &
4159 u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, &
4160 du_gwd_hines, dv_gwd_hines)
4161 zustr_gwd_hines=0.
4162 zvstr_gwd_hines=0.
4163 DO k = 1, klev
4164 zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/phys_tstep &
4165 * (paprs(:, k)-paprs(:, k+1))/rg
4166 zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/phys_tstep &
4167 * (paprs(:, k)-paprs(:, k+1))/rg
4168 ENDDO
4169
4170 d_t_hin(:, :)=0.
4171 CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
4172 dqi0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0)
4173 CALL prt_enerbil('hin',itap)
4174 ENDIF
4175
4176
2/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
480 IF (.not. ok_hines .and. ok_gwd_rando) then
4177 ! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod
4178 CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, &
4179 v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, &
4180 480 dv_gwd_front, east_gwstress, west_gwstress)
4181
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zustr_gwd_front=0.
4182
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zvstr_gwd_front=0.
4183
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
4184 zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/phys_tstep &
4185
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626400 * (paprs(:, k)-paprs(:, k+1))/rg
4186 zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/phys_tstep &
4187
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 * (paprs(:, k)-paprs(:, k+1))/rg
4188 ENDDO
4189
4190 CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &
4191 480 paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0)
4192 480 CALL prt_enerbil('front_gwd_rando',itap)
4193 ENDIF
4194
4195
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (ok_gwd_rando) THEN
4196 CALL FLOTT_GWD_rando(PHYS_TSTEP, pplay, t_seri, u_seri, v_seri, &
4197 rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
4198
3/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 480 times.
477600 du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
4199 CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, &
4200 480 paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0)
4201 480 CALL prt_enerbil('flott_gwd_rando',itap)
4202
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zustr_gwd_rando=0.
4203
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zvstr_gwd_rando=0.
4204
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
4205 zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/phys_tstep &
4206
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626400 * (paprs(:, k)-paprs(:, k+1))/rg
4207 zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/phys_tstep &
4208
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 * (paprs(:, k)-paprs(:, k+1))/rg
4209 ENDDO
4210 ENDIF
4211
4212 ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
4213
4214
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
4215 CALL writefield_phy('u_seri',u_seri,nbp_lev)
4216 CALL writefield_phy('v_seri',v_seri,nbp_lev)
4217 CALL writefield_phy('t_seri',t_seri,nbp_lev)
4218 CALL writefield_phy('q_seri',q_seri,nbp_lev)
4219 ENDIF
4220
4221
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
4222 477120 zustrph(i)=0.
4223 477600 zvstrph(i)=0.
4224 ENDDO
4225
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
4226
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
4227 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/phys_tstep* &
4228 18607680 (paprs(i,k)-paprs(i,k+1))/rg
4229 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/phys_tstep* &
4230 18626400 (paprs(i,k)-paprs(i,k+1))/rg
4231 ENDDO
4232 ENDDO
4233 !
4234 !IM calcul composantes axiales du moment angulaire et couple des montagnes
4235 !
4236
2/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
480 IF (is_sequential .and. ok_orodr) THEN
4237 CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
4238 ra,rg,romega, &
4239 latitude_deg,longitude_deg,pphis, &
4240 zustrdr,zustrli,zustrph, &
4241 zvstrdr,zvstrli,zvstrph, &
4242 paprs,u,v, &
4243 480 aam, torsfc)
4244 ENDIF
4245 !IM cf. FLott END
4246 !DC Calcul de la tendance due au methane
4247
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (ok_qch4) THEN
4248 CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
4249 ! ajout de la tendance d'humidite due au methane
4250 d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep
4251 CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, &
4252 'q_ch4', abortphy,flag_inhib_tend,itap,0)
4253 d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep
4254 ENDIF
4255 !
4256 !
4257
4258 !===============================================================
4259 ! Additional tendency of TKE due to orography
4260 !===============================================================
4261 !
4262 ! Inititialization
4263 !------------------
4264
4265 480 addtkeoro=0
4266 480 CALL getin_p('addtkeoro',addtkeoro)
4267
4268
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level.ge.5) &
4269 print*,'addtkeoro', addtkeoro
4270
4271 480 alphatkeoro=1.
4272 480 CALL getin_p('alphatkeoro',alphatkeoro)
4273 480 alphatkeoro=min(max(0.,alphatkeoro),1.)
4274
4275 480 smallscales_tkeoro=.FALSE.
4276 480 CALL getin_p('smallscales_tkeoro',smallscales_tkeoro)
4277
4278
4279
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dtadd(:,:)=0.
4280
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 duadd(:,:)=0.
4281
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dvadd(:,:)=0.
4282
4283 ! Choices for addtkeoro:
4284 ! ** 0 no TKE tendency from orography
4285 ! ** 1 we include a fraction alphatkeoro of the whole tendency duoro
4286 ! ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro
4287 !
4288
4289
2/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
480 IF (addtkeoro .GT. 0 .AND. ok_orodr ) THEN
4290 ! -------------------------------------------
4291
4292
4293 ! selection des points pour lesquels le schema est actif:
4294
4295
4296
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (addtkeoro .EQ. 1 ) THEN
4297
4298 duadd(:,:)=alphatkeoro*d_u_oro(:,:)
4299 dvadd(:,:)=alphatkeoro*d_v_oro(:,:)
4300
4301
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 ELSE IF (addtkeoro .EQ. 2) THEN
4302
4303
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (smallscales_tkeoro) THEN
4304 480 igwd=0
4305
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i=1,klon
4306 477120 itest(i)=0
4307 ! Etienne: ici je prends en compte plus de relief que la routine drag_noro_strato
4308 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
4309 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie!
4310
2/2
✓ Branch 0 taken 222720 times.
✓ Branch 1 taken 254400 times.
477600 IF (zstd(i).GT.1.0) THEN
4311 222720 itest(i)=1
4312 222720 igwd=igwd+1
4313 222720 idx(igwd)=i
4314 ENDIF
4315 ENDDO
4316
4317 ELSE
4318
4319 igwd=0
4320 DO i=1,klon
4321 itest(i)=0
4322 IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
4323 itest(i)=1
4324 igwd=igwd+1
4325 idx(igwd)=i
4326 ENDIF
4327 ENDDO
4328
4329 ENDIF
4330
4331 CALL drag_noro_strato(addtkeoro,klon,klev,phys_tstep,paprs,pplay, &
4332 zmea,zstd, zsig, zgam, zthe,zpic,zval, &
4333 igwd,idx,itest, &
4334 t_seri, u_seri, v_seri, &
4335 zulow, zvlow, zustrdr, zvstrdr, &
4336 480 d_t_oro_gw, d_u_oro_gw, d_v_oro_gw)
4337
4338
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zustrdr(:)=0.
4339
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zvstrdr(:)=0.
4340
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zulow(:)=0.
4341
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 zvlow(:)=0.
4342
4343
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:)
4344
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:)
4345 ENDIF
4346
4347
4348 ! TKE update from subgrid temperature and wind tendencies
4349 !----------------------------------------------------------
4350
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
4351
4352
4353 480 CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pctsrf,pbl_tke)
4354 !
4355 ! Prevent pbl_tke_w from becoming negative
4356
6/6
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 96000 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 95424000 times.
✓ Branch 5 taken 96000 times.
95522880 wake_delta_pbl_tke(:,:,:) = max(wake_delta_pbl_tke(:,:,:), -pbl_tke(:,:,:))
4357 !
4358
4359 ENDIF
4360 ! -----
4361 !===============================================================
4362
4363
4364 !====================================================================
4365 ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
4366 !====================================================================
4367 ! Abderrahmane 24.08.09
4368
4369 IF (ok_cosp) THEN
4370 ! adeclarer
4371
4372
4373
4374 ENDIF !ok_cosp
4375
4376
4377 ! Marine
4378
4379
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (ok_airs) then
4380
4381 IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN
4382 write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
4383 CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
4384 & map_prop_hc,map_prop_hist,&
4385 & map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
4386 & map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
4387 & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
4388 & map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
4389 & map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
4390 & map_ntot,map_hc,map_hist,&
4391 & map_Cb,map_ThCi,map_Anv,&
4392 & alt_tropo )
4393 ENDIF
4394
4395 ENDIF ! ok_airs
4396
4397
4398 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4399 !AA
4400 !AA Installation de l'interface online-offline pour traceurs
4401 !AA
4402 !====================================================================
4403 ! Calcul des tendances traceurs
4404 !====================================================================
4405 !
4406
4407
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (type_trac=='repr') THEN
4408 !MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod
4409 !MM dans Reprobus
4410 sh_in(:,:) = q_seri(:,:)
4411 ELSE
4412
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 sh_in(:,:) = qx(:,:,ivap)
4413
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (nqo .EQ. 3) THEN
4414
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol)
4415 ELSE
4416 ch_in(:,:) = qx(:,:,iliq)
4417 ENDIF
4418 ENDIF
4419
4420
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_phytrac == 1 ) THEN
4421 CALL phytrac ( &
4422 itap, days_elapsed+1, jH_cur, debut, &
4423 lafin, phys_tstep, u, v, t, &
4424 paprs, pplay, pmfu, pmfd, &
4425 pen_u, pde_u, pen_d, pde_d, &
4426 cdragh, coefh(1:klon,1:klev,is_ave), fm_therm, entr_therm, &
4427 u1, v1, ftsol, pctsrf, &
4428 zustar, zu10m, zv10m, &
4429 wstar(:,is_ave), ale_bl, ale_wake, &
4430 latitude_deg, longitude_deg, &
4431 frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, &
4432 presnivs, pphis, pphi, albsol1, &
4433 sh_in, ch_in, rhcl, cldfra, rneb, &
4434 diafra, cldliq, itop_con, ibas_con, &
4435 pmflxr, pmflxs, prfl, psfl, &
4436 da, phi, mp, upwd, &
4437 phi2, d1a, dam, sij, wght_cvfd, & !<<RomP+RL
4438 wdtrainA, wdtrainM, sigd, clw,elij, & !<<RomP
4439 ev, ep, epmlmMm, eplaMm, & !<<RomP
4440 dnwd, aerosol_couple, flxmass_w, &
4441 tau_aero, piz_aero, cg_aero, ccm, &
4442 rfname, &
4443 d_tr_dyn, & !<<RomP
4444 480 tr_seri, init_source)
4445 ENDIF ! (iflag_phytrac=1)
4446
4447 !ENDIF ! (iflag_phytrac=1)
4448
4449
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (offline) THEN
4450
4451 IF (prt_level.ge.9) &
4452 print*,'Attention on met a 0 les thermiques pour phystoke'
4453 CALL phystokenc ( &
4454 nlon,klev,pdtphys,longitude_deg,latitude_deg, &
4455 t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
4456 fm_therm,entr_therm, &
4457 cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
4458 frac_impa, frac_nucl, &
4459 pphis,cell_area,phys_tstep,itap, &
4460 qx(:,:,ivap),da,phi,mp,upwd,dnwd)
4461
4462
4463 ENDIF
4464
4465 !
4466 ! Calculer le transport de l'eau et de l'energie (diagnostique)
4467 !
4468 CALL transp (paprs,zxtsol, &
4469 t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
4470 480 ve, vq, ue, uq, vwat, uwat)
4471 !
4472 !IM global posePB BEG
4473 IF(1.EQ.0) THEN
4474 !
4475 CALL transp_lay (paprs,zxtsol, &
4476 t_seri, q_seri, u_seri, v_seri, zphi, &
4477 ve_lay, vq_lay, ue_lay, uq_lay)
4478 !
4479 ENDIF !(1.EQ.0) THEN
4480 !IM global posePB END
4481 ! Accumuler les variables a stocker dans les fichiers histoire:
4482 !
4483
4484 !================================================================
4485 ! Conversion of kinetic and potential energy into heat, for
4486 ! parameterisation of subgrid-scale motions
4487 !================================================================
4488
4489
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_t_ec(:,:)=0.
4490
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
4491 CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap),qx(:,:,iliq),qx(:,:,isol), &
4492 u_seri,v_seri,t_seri,q_seri,ql_seri,qs_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
4493
5/6
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 19200 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 19200 times.
✓ Branch 5 taken 19084800 times.
19104480 zmasse,exner,d_t_ec)
4494
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
4495
4496 !=======================================================================
4497 ! SORTIES
4498 !=======================================================================
4499 !
4500 !IM initialisation + calculs divers diag AMIP2
4501 !
4502 !
4503 !
4504 ! Initialisations diverses au tout debut
4505
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF(itap.EQ.1) THEN
4506 1 itapm1=0
4507 ENDIF
4508
4509 ! Initialisation debut de mois
4510
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF(itap.EQ.itapm1+1) THEN
4511
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 nday_rain(:)=0.
4512 ! print*,'initialisation mois suivants day_rain itap',itap
4513 ENDIF
4514
4515 ! Calcul fin de journee : total_rain, nday_rain
4516
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 475 times.
480 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
4517 ! print*,'calcul nday_rain itap ',itap
4518
2/2
✓ Branch 0 taken 4970 times.
✓ Branch 1 taken 5 times.
4975 DO i = 1, klon
4519 4970 total_rain(i)=rain_fall(i)+snow_fall(i)
4520
2/2
✓ Branch 0 taken 3543 times.
✓ Branch 1 taken 1427 times.
4975 IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.
4521 ENDDO
4522 ENDIF
4523
4524 ! Initialisation fin de mois
4525
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF(MOD(itap-itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.0) THEN
4526 itapm1=itapm1+NINT(mth_len*un_jour/phys_tstep)
4527 ! print*,'initialisation itapm1 ',itapm1
4528 ENDIF
4529 !
4530 ! calcul temperatures minimale et maximale moyennees sur le mois
4531 !
4532 !initialisation debut de mois ou de journee pour les fichiers mensuels
4533
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF(itap.EQ.itapm1+1) THEN
4534
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 t2m_min_mon=0.
4535
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 t2m_max_mon=0.
4536 ENDIF
4537
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 475 times.
480 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN
4538
4/14
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 5 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✓ Branch 12 taken 4970 times.
✓ Branch 13 taken 5 times.
4980 zt2m_min_mon=zt2m
4539
4/14
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 5 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✓ Branch 12 taken 4970 times.
✓ Branch 13 taken 5 times.
4980 zt2m_max_mon=zt2m
4540 ENDIF
4541 !calcul a chaque pas de temps pour les fichiers mensuels
4542
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i = 1, klon
4543 477120 zt2m_min_mon(i)=MIN(zt2m(i),zt2m_min_mon(i))
4544 477600 zt2m_max_mon(i)=MAX(zt2m(i),zt2m_max_mon(i))
4545 ENDDO
4546 !fin de journee
4547
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 475 times.
480 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
4548
3/4
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 4970 times.
✓ Branch 3 taken 5 times.
4980 t2m_min_mon=t2m_min_mon+zt2m_min_mon
4549
3/4
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 4970 times.
✓ Branch 3 taken 5 times.
4980 t2m_max_mon=t2m_max_mon+zt2m_max_mon
4550 ENDIF
4551 !fin mois
4552
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF(itap==itapm1) THEN
4553 t2m_min_mon=t2m_min_mon/mth_len
4554 t2m_max_mon=t2m_max_mon/mth_len
4555 ENDIF
4556 !
4557 !
4558 !IM Interpolation sur les niveaux de pression du NMC
4559 ! -------------------------------------------------
4560 !
4561 !IM on initialise les variables
4562 !
4563 ! missing_val=nf90_fill_real
4564 !
4565
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (.not. ok_all_xml) then
4566 480 CALL ini_undefSTD(itap,itapm1)
4567 ENDIF
4568 !
4569 !IM on interpole les champs sur les niveaux STD de pression
4570 !IM a chaque pas de temps de la physique
4571 !
4572 !-------------------------------------------------------c
4573 ! positionnement de l'argument logique a .false. c
4574 ! pour ne pas recalculer deux fois la meme chose ! c
4575 ! a cet effet un appel a plevel_new a ete deplace c
4576 ! a la fin de la serie d'appels c
4577 ! la boucle 'DO k=1, nlevSTD' a ete internalisee c
4578 ! dans plevel_new, d'ou la creation de cette routine... c
4579 !-------------------------------------------------------c
4580 !
4581 CALL plevel_new(klon,klev,nlevSTD,.true.,pplay,rlevSTD, &
4582 480 t_seri,tlevSTD)
4583 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4584 480 u_seri,ulevSTD)
4585 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4586 480 v_seri,vlevSTD)
4587 !
4588
4589 !
4590 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4591
5/6
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 18720 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 18607680 times.
✓ Branch 5 taken 18720 times.
18626880 zphi/RG,philevSTD)
4592 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4593 480 qx(:,:,ivap),qlevSTD)
4594 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4595
5/6
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 18720 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 18607680 times.
✓ Branch 5 taken 18720 times.
18626880 zx_rh*100.,rhlevSTD)
4596 !
4597
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4598
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4599 18626400 zx_tmp_fi3d(i,l)=u_seri(i,l)*v_seri(i,l)
4600 ENDDO !i
4601 ENDDO !l
4602 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4603 480 zx_tmp_fi3d,uvSTD)
4604 !
4605
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4606
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4607 18626400 zx_tmp_fi3d(i,l)=v_seri(i,l)*q_seri(i,l)
4608 ENDDO !i
4609 ENDDO !l
4610 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4611 480 zx_tmp_fi3d,vqSTD)
4612 !
4613
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4614
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4615 18626400 zx_tmp_fi3d(i,l)=v_seri(i,l)*t_seri(i,l)
4616 ENDDO !i
4617 ENDDO !l
4618 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4619 480 zx_tmp_fi3d,vTSTD)
4620 !
4621
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4622
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4623 18626400 zx_tmp_fi3d(i,l)=omega(i,l)*qx(i,l,ivap)
4624 ENDDO !i
4625 ENDDO !l
4626 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4627 480 zx_tmp_fi3d,wqSTD)
4628 !
4629
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4630
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4631 18626400 zx_tmp_fi3d(i,l)=v_seri(i,l)*zphi(i,l)/RG
4632 ENDDO !i
4633 ENDDO !l
4634 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4635 480 zx_tmp_fi3d,vphiSTD)
4636 !
4637
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4638
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4639 18626400 zx_tmp_fi3d(i,l)=omega(i,l)*t_seri(i,l)
4640 ENDDO !i
4641 ENDDO !l
4642 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4643 480 zx_tmp_fi3d,wTSTD)
4644 !
4645
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4646
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4647 18626400 zx_tmp_fi3d(i,l)=u_seri(i,l)*u_seri(i,l)
4648 ENDDO !i
4649 ENDDO !l
4650 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4651 480 zx_tmp_fi3d,u2STD)
4652 !
4653
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4654
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4655 18626400 zx_tmp_fi3d(i,l)=v_seri(i,l)*v_seri(i,l)
4656 ENDDO !i
4657 ENDDO !l
4658 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4659 480 zx_tmp_fi3d,v2STD)
4660 !
4661
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4662
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4663 18626400 zx_tmp_fi3d(i,l)=t_seri(i,l)*t_seri(i,l)
4664 ENDDO !i
4665 ENDDO !l
4666 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4667 480 zx_tmp_fi3d,T2STD)
4668
4669 !
4670
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 zx_tmp_fi3d(:,:)=wo(:,:,1) * dobson_u * 1e3 / zmasse / rmo3 * rmd
4671 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4672 480 zx_tmp_fi3d,O3STD)
4673 !
4674
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 if (read_climoz == 2) THEN
4675 zx_tmp_fi3d(:,:)=wo(:,:,2) * dobson_u * 1e3 / zmasse / rmo3 * rmd
4676 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
4677 zx_tmp_fi3d,O3daySTD)
4678 endif
4679 !
4680
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO l=1, klev
4681
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1, klon
4682 18626400 zx_tmp_fi3d(i,l)=paprs(i,l)
4683 ENDDO !i
4684 ENDDO !l
4685 CALL plevel_new(klon,klev,nlevSTD,.true.,zx_tmp_fi3d,rlevSTD, &
4686 480 omega,wlevSTD)
4687 !
4688 !IM on somme les valeurs toutes les freq_calNMC secondes
4689 !IM on moyenne a la fin du mois, du jour ou toutes les 6h
4690 !
4691
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (.not. ok_all_xml) then
4692 480 CALL undefSTD(itap, read_climoz)
4693 480 CALL moy_undefSTD(itap,itapm1)
4694 ENDIF
4695 !
4696 CALL plevel(klon,klev,.true.,pplay,50000., &
4697
5/6
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 18720 times.
✓ Branch 3 taken 480 times.
✓ Branch 4 taken 18607680 times.
✓ Branch 5 taken 18720 times.
18626880 zphi/RG,geo500)
4698
4699 !IM on interpole a chaque pas de temps le SWup(clr) et SWdn(clr) a 200 hPa
4700 !
4701 CALL plevel(klon,klevp1,.true.,paprs,20000., &
4702 480 swdn0,SWdn200clr)
4703 CALL plevel(klon,klevp1,.false.,paprs,20000., &
4704 480 swdn,SWdn200)
4705 CALL plevel(klon,klevp1,.false.,paprs,20000., &
4706 480 swup0,SWup200clr)
4707 CALL plevel(klon,klevp1,.false.,paprs,20000., &
4708 480 swup,SWup200)
4709 !
4710 CALL plevel(klon,klevp1,.false.,paprs,20000., &
4711 480 lwdn0,LWdn200clr)
4712 CALL plevel(klon,klevp1,.false.,paprs,20000., &
4713 480 lwdn,LWdn200)
4714 CALL plevel(klon,klevp1,.false.,paprs,20000., &
4715 480 lwup0,LWup200clr)
4716 CALL plevel(klon,klevp1,.false.,paprs,20000., &
4717 480 lwup,LWup200)
4718 !
4719
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 twriteSTD(:,:,1)=tsumSTD(:,:,1)
4720
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 qwriteSTD(:,:,1)=qsumSTD(:,:,1)
4721
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 rhwriteSTD(:,:,1)=rhsumSTD(:,:,1)
4722
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 phiwriteSTD(:,:,1)=phisumSTD(:,:,1)
4723
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 uwriteSTD(:,:,1)=usumSTD(:,:,1)
4724
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 vwriteSTD(:,:,1)=vsumSTD(:,:,1)
4725
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 wwriteSTD(:,:,1)=wsumSTD(:,:,1)
4726
4727
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 twriteSTD(:,:,2)=tsumSTD(:,:,2)
4728
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 qwriteSTD(:,:,2)=qsumSTD(:,:,2)
4729
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 rhwriteSTD(:,:,2)=rhsumSTD(:,:,2)
4730
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 phiwriteSTD(:,:,2)=phisumSTD(:,:,2)
4731
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 uwriteSTD(:,:,2)=usumSTD(:,:,2)
4732
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 vwriteSTD(:,:,2)=vsumSTD(:,:,2)
4733
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 wwriteSTD(:,:,2)=wsumSTD(:,:,2)
4734
4735
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 twriteSTD(:,:,3)=tlevSTD(:,:)
4736
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 qwriteSTD(:,:,3)=qlevSTD(:,:)
4737
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 rhwriteSTD(:,:,3)=rhlevSTD(:,:)
4738
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 phiwriteSTD(:,:,3)=philevSTD(:,:)
4739
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 uwriteSTD(:,:,3)=ulevSTD(:,:)
4740
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 vwriteSTD(:,:,3)=vlevSTD(:,:)
4741
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 wwriteSTD(:,:,3)=wlevSTD(:,:)
4742
4743
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 twriteSTD(:,:,4)=tlevSTD(:,:)
4744
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 qwriteSTD(:,:,4)=qlevSTD(:,:)
4745
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 rhwriteSTD(:,:,4)=rhlevSTD(:,:)
4746
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 phiwriteSTD(:,:,4)=philevSTD(:,:)
4747
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 uwriteSTD(:,:,4)=ulevSTD(:,:)
4748
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 vwriteSTD(:,:,4)=vlevSTD(:,:)
4749
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 wwriteSTD(:,:,4)=wlevSTD(:,:)
4750 !
4751 !IM initialisation 5eme fichier de sortie
4752
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 twriteSTD(:,:,5)=tlevSTD(:,:)
4753
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 qwriteSTD(:,:,5)=qlevSTD(:,:)
4754
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 rhwriteSTD(:,:,5)=rhlevSTD(:,:)
4755
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 phiwriteSTD(:,:,5)=philevSTD(:,:)
4756
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 uwriteSTD(:,:,5)=ulevSTD(:,:)
4757
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 vwriteSTD(:,:,5)=vlevSTD(:,:)
4758
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 wwriteSTD(:,:,5)=wlevSTD(:,:)
4759 !
4760 !IM initialisation 6eme fichier de sortie
4761
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 twriteSTD(:,:,6)=tlevSTD(:,:)
4762
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 qwriteSTD(:,:,6)=qlevSTD(:,:)
4763
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 rhwriteSTD(:,:,6)=rhlevSTD(:,:)
4764
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 phiwriteSTD(:,:,6)=philevSTD(:,:)
4765
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 uwriteSTD(:,:,6)=ulevSTD(:,:)
4766
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 vwriteSTD(:,:,6)=vlevSTD(:,:)
4767
4/4
✓ Branch 0 taken 8160 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 8111040 times.
✓ Branch 3 taken 8160 times.
8119680 wwriteSTD(:,:,6)=wlevSTD(:,:)
4768 !IM for NMC files
4769
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 480 times.
1920 DO n=1, nlevSTD3
4770
2/2
✓ Branch 0 taken 24480 times.
✓ Branch 1 taken 1440 times.
26400 DO k=1, nlevSTD
4771
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 23040 times.
25920 if(rlevSTD3(n).EQ.rlevSTD(k)) THEN
4772
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 twriteSTD3(:,n)=tlevSTD(:,k)
4773
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 qwriteSTD3(:,n)=qlevSTD(:,k)
4774
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 rhwriteSTD3(:,n)=rhlevSTD(:,k)
4775
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 phiwriteSTD3(:,n)=philevSTD(:,k)
4776
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 uwriteSTD3(:,n)=ulevSTD(:,k)
4777
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 vwriteSTD3(:,n)=vlevSTD(:,k)
4778
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 wwriteSTD3(:,n)=wlevSTD(:,k)
4779 endif !rlevSTD3(n).EQ.rlevSTD(k)
4780 ENDDO
4781 ENDDO
4782 !
4783
2/2
✓ Branch 0 taken 3840 times.
✓ Branch 1 taken 480 times.
4320 DO n=1, nlevSTD8
4784
2/2
✓ Branch 0 taken 65280 times.
✓ Branch 1 taken 3840 times.
69600 DO k=1, nlevSTD
4785
2/2
✓ Branch 0 taken 3840 times.
✓ Branch 1 taken 61440 times.
69120 if(rlevSTD8(n).EQ.rlevSTD(k)) THEN
4786
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 tnondefSTD8(:,n)=tnondef(:,k,2)
4787
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 twriteSTD8(:,n)=tsumSTD(:,k,2)
4788
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 qwriteSTD8(:,n)=qsumSTD(:,k,2)
4789
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 rhwriteSTD8(:,n)=rhsumSTD(:,k,2)
4790
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 phiwriteSTD8(:,n)=phisumSTD(:,k,2)
4791
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 uwriteSTD8(:,n)=usumSTD(:,k,2)
4792
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 vwriteSTD8(:,n)=vsumSTD(:,k,2)
4793
2/2
✓ Branch 0 taken 3816960 times.
✓ Branch 1 taken 3840 times.
3820800 wwriteSTD8(:,n)=wsumSTD(:,k,2)
4794 endif !rlevSTD8(n).EQ.rlevSTD(k)
4795 ENDDO
4796 ENDDO
4797
4798 !
4799 ! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
4800 480 CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
4801 !
4802 !cc prw = eau precipitable
4803 ! prlw = colonne eau liquide
4804 ! prlw = colonne eau solide
4805
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 prw(:) = 0.
4806
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 prlw(:) = 0.
4807
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 prsw(:) = 0.
4808
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
4809
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626400 prw(:) = prw(:) + q_seri(:,k)*zmasse(:,k)
4810
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626400 prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k)
4811
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k)
4812 ENDDO
4813 !
4814 IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
4815 ENDIF
4816
4817
4818 !
4819 ! Convertir les incrementations en tendances
4820 !
4821
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level .GE.10) THEN
4822 print *,'Convertir les incrementations en tendances '
4823 ENDIF
4824 !
4825
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (mydebug) THEN
4826 CALL writefield_phy('u_seri',u_seri,nbp_lev)
4827 CALL writefield_phy('v_seri',v_seri,nbp_lev)
4828 CALL writefield_phy('t_seri',t_seri,nbp_lev)
4829 CALL writefield_phy('q_seri',q_seri,nbp_lev)
4830 ENDIF
4831
4832
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
4833
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
4834 18607680 d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / phys_tstep
4835 18607680 d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / phys_tstep
4836 18607680 d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / phys_tstep
4837 18607680 d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / phys_tstep
4838 18607680 d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep
4839 !CR: on ajoute le contenu en glace
4840
1/2
✓ Branch 0 taken 18607680 times.
✗ Branch 1 not taken.
18626400 IF (nqo.eq.3) THEN
4841 18607680 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
4842 ENDIF
4843 ENDDO
4844 ENDDO
4845 !
4846 !CR: nb de traceurs eau: nqo
4847 ! IF (nqtot.GE.3) THEN
4848
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (nqtot.GE.(nqo+1)) THEN
4849 ! DO iq = 3, nqtot
4850
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO iq = nqo+1, nqtot
4851
2/2
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
38880 DO k = 1, klev
4852
2/2
✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
37253760 DO i = 1, klon
4853 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / phys_tstep
4854 37252800 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / phys_tstep
4855 ENDDO
4856 ENDDO
4857 ENDDO
4858 ENDIF
4859 !
4860 !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
4861 !IM global posePB include "write_bilKP_ins.h"
4862 !IM global posePB include "write_bilKP_ave.h"
4863 !
4864
4865 !--OB mass fixer
4866 !--profile is corrected to force mass conservation of water
4867 IF (mass_fixer) THEN
4868 qql2(:)=0.0
4869 DO k = 1, klev
4870 qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
4871 ENDDO
4872 DO i = 1, klon
4873 !--compute ratio of what q+ql should be with conservation to what it is
4874 corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
4875 DO k = 1, klev
4876 q_seri(i,k) =q_seri(i,k)*corrqql
4877 ql_seri(i,k)=ql_seri(i,k)*corrqql
4878 ENDDO
4879 ENDDO
4880 ENDIF
4881 !--fin mass fixer
4882
4883 ! Sauvegarder les valeurs de t et q a la fin de la physique:
4884 !
4885
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 u_ancien(:,:) = u_seri(:,:)
4886
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 v_ancien(:,:) = v_seri(:,:)
4887
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 t_ancien(:,:) = t_seri(:,:)
4888
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 q_ancien(:,:) = q_seri(:,:)
4889
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 ql_ancien(:,:) = ql_seri(:,:)
4890
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 qs_ancien(:,:) = qs_seri(:,:)
4891 480 CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien)
4892 480 CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien)
4893 480 CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
4894 ! !! RomP >>>
4895 !CR: nb de traceurs eau: nqo
4896
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (nqtot.GT.nqo) THEN
4897
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO iq = nqo+1, nqtot
4898
4/4
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
✓ Branch 2 taken 37215360 times.
✓ Branch 3 taken 37440 times.
37254240 tr_ancien(:,:,iq-nqo) = tr_seri(:,:,iq-nqo)
4899 ENDDO
4900 ENDIF
4901 ! !! RomP <<<
4902 !==========================================================================
4903 ! Sorties des tendances pour un point particulier
4904 ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
4905 ! pour le debug
4906 ! La valeur de igout est attribuee plus haut dans le programme
4907 !==========================================================================
4908
4909
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (prt_level.ge.1) THEN
4910 write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
4911 write(lunout,*) &
4912 'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
4913 write(lunout,*) &
4914 nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
4915 pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
4916 pctsrf(igout,is_sic)
4917 write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
4918 DO k=1,klev
4919 write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
4920 d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
4921 d_t_eva(igout,k)
4922 ENDDO
4923 write(lunout,*) 'cool,heat'
4924 DO k=1,klev
4925 write(lunout,*) cool(igout,k),heat(igout,k)
4926 ENDDO
4927
4928 !jyg< (En attendant de statuer sur le sort de d_t_oli)
4929 !jyg! write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
4930 !jyg! do k=1,klev
4931 !jyg! write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
4932 !jyg! d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
4933 !jyg! enddo
4934 write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
4935 DO k=1,klev
4936 write(lunout,*) d_t_vdf(igout,k), &
4937 d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
4938 ENDDO
4939 !>jyg
4940
4941 write(lunout,*) 'd_ps ',d_ps(igout)
4942 write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
4943 DO k=1,klev
4944 write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
4945 d_qx(igout,k,1),d_qx(igout,k,2)
4946 ENDDO
4947 ENDIF
4948
4949 !============================================================
4950 ! Calcul de la temperature potentielle
4951 !============================================================
4952
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
4953
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
4954 !JYG/IM theta en debut du pas de temps
4955 !JYG/IM theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
4956 !JYG/IM theta en fin de pas de temps de physique
4957 18607680 theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
4958 ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
4959 ! MPL 20130625
4960 ! fth_fonctions.F90 et parkind1.F90
4961 ! sinon thetal=theta
4962 ! thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
4963 ! : ql_seri(i,k))
4964 18626400 thetal(i,k)=theta(i,k)
4965 ENDDO
4966 ENDDO
4967 !
4968
4969 ! 22.03.04 BEG
4970 !=============================================================
4971 ! Ecriture des sorties
4972 !=============================================================
4973
4974 ! Recupere des varibles calcule dans differents modules
4975 ! pour ecriture dans histxxx.nc
4976
4977 ! Get some variables from module fonte_neige_mod
4978 CALL fonte_neige_get_vars(pctsrf, &
4979 480 zxfqcalving, zxfqfonte, zxffonte, zxrunofflic)
4980
4981
4982 !=============================================================
4983 ! Separation entre thermiques et non thermiques dans les sorties
4984 ! de fisrtilp
4985 !=============================================================
4986
4987
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_thermals>=1) THEN
4988
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_t_lscth=0.
4989
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_t_lscst=0.
4990
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_q_lscth=0.
4991
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 d_q_lscst=0.
4992
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
4993
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
4994
2/2
✓ Branch 0 taken 1305081 times.
✓ Branch 1 taken 17302599 times.
18626400 IF (ptconvth(i,k)) THEN
4995 1305081 d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
4996 1305081 d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
4997 ELSE
4998 17302599 d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
4999 17302599 d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
5000 ENDIF
5001 ENDDO
5002 ENDDO
5003
5004
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO i=1,klon
5005 477120 plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
5006 477600 plul_th(i)=prfl(i,1)+psfl(i,1)
5007 ENDDO
5008 ENDIF
5009
5010 !On effectue les sorties:
5011
5012 CALL phys_output_write(itap, pdtphys, paprs, pphis, &
5013 pplay, lmax_th, aerosol_couple, &
5014 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, &
5015 ok_sync, ptconv, read_climoz, clevSTD, &
5016 ptconvth, d_u, d_t, qx, d_qx, zmasse, &
5017 480 flag_aerosol, flag_aerosol_strat, ok_cdnc)
5018
5019 480 CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
5020
5021
5022 !====================================================================
5023 ! Arret du modele apres hgardfou en cas de detection d'un
5024 ! plantage par hgardfou
5025 !====================================================================
5026
5027
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (abortphy==1) THEN
5028 abort_message ='Plantage hgardfou'
5029 CALL abort_physic (modname,abort_message,1)
5030 ENDIF
5031
5032 ! 22.03.04 END
5033 !
5034 !====================================================================
5035 ! Si c'est la fin, il faut conserver l'etat de redemarrage
5036 !====================================================================
5037 !
5038
5039 ! Disabling calls to the prt_alerte function
5040 480 alert_first_call = .FALSE.
5041
5042
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF (lafin) THEN
5043 1 itau_phy = itau_phy + itap
5044 1 CALL phyredem ("restartphy.nc")
5045 ! open(97,form="unformatted",file="finbin")
5046 ! write(97) u_seri,v_seri,t_seri,q_seri
5047 ! close(97)
5048
5049
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (is_omp_master) THEN
5050
5051
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (read_climoz >= 1) THEN
5052 IF (is_mpi_root) CALL nf95_close(ncid_climoz)
5053 DEALLOCATE(press_edg_climoz) ! pointer
5054 DEALLOCATE(press_cen_climoz) ! pointer
5055 ENDIF
5056
5057 ENDIF
5058 1 WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
5059 ENDIF
5060
5061 ! first=.false.
5062
5063 480 END SUBROUTINE physiq
5064
5065 END MODULE physiq_mod
5066