Directory: | ./ |
---|---|
File: | phys/thermcell_main.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 245 | 284 | 86.3% |
Branches: | 257 | 320 | 80.3% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | ! | ||
2 | ! $Id: thermcell_main.F90 3451 2019-01-27 11:07:30Z fhourdin $ | ||
3 | ! | ||
4 | 479521 | SUBROUTINE thermcell_main(itap,ngrid,nlay,ptimestep & | |
5 | & ,pplay,pplev,pphi,debut & | ||
6 | 480 | & ,pu,pv,pt,po & | |
7 | & ,pduadj,pdvadj,pdtadj,pdoadj & | ||
8 | 480 | & ,fm0,entr0,detr0,zqta,zqla,lmax & | |
9 | & ,ratqscth,ratqsdiff,zqsatth & | ||
10 | & ,Ale_bl,Alp_bl,lalim_conv,wght_th & | ||
11 | 480 | & ,zmax0, f0,zw2,fraca,ztv & | |
12 | & ,zpspsk,ztla,zthl & | ||
13 | !!! nrlmd le 10/04/2012 | ||
14 | & ,pbl_tke,pctsrf,omega,airephy & | ||
15 | & ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 & | ||
16 | & ,n2,s2,ale_bl_stat & | ||
17 | & ,therm_tke_max,env_tke_max & | ||
18 | & ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & | ||
19 | & ,alp_bl_conv,alp_bl_stat & | ||
20 | !!! fin nrlmd le 10/04/2012 | ||
21 | & ,ztva ) | ||
22 | |||
23 | USE dimphy | ||
24 | USE ioipsl | ||
25 | USE indice_sol_mod | ||
26 | USE print_control_mod, ONLY: lunout,prt_level | ||
27 | IMPLICIT NONE | ||
28 | |||
29 | !======================================================================= | ||
30 | ! Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu | ||
31 | ! Version du 09.02.07 | ||
32 | ! Calcul du transport vertical dans la couche limite en presence | ||
33 | ! de "thermiques" explicitement representes avec processus nuageux | ||
34 | ! | ||
35 | ! Reecriture a partir d'un listing papier a Habas, le 14/02/00 | ||
36 | ! | ||
37 | ! le thermique est suppose homogene et dissipe par melange avec | ||
38 | ! son environnement. la longueur l_mix controle l'efficacite du | ||
39 | ! melange | ||
40 | ! | ||
41 | ! Le calcul du transport des differentes especes se fait en prenant | ||
42 | ! en compte: | ||
43 | ! 1. un flux de masse montant | ||
44 | ! 2. un flux de masse descendant | ||
45 | ! 3. un entrainement | ||
46 | ! 4. un detrainement | ||
47 | ! | ||
48 | ! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr) | ||
49 | ! Introduction of an implicit computation of vertical advection in | ||
50 | ! the environment of thermal plumes in thermcell_dq | ||
51 | ! impl = 0 : explicit, 1 : implicit, -1 : old version | ||
52 | ! controled by iflag_thermals = | ||
53 | ! 15, 16 run with impl=-1 : numerical convergence with NPv3 | ||
54 | ! 17, 18 run with impl=1 : more stable | ||
55 | ! 15 and 17 correspond to the activation of the stratocumulus "bidouille" | ||
56 | ! | ||
57 | !======================================================================= | ||
58 | |||
59 | |||
60 | !----------------------------------------------------------------------- | ||
61 | ! declarations: | ||
62 | ! ------------- | ||
63 | |||
64 | ! | ||
65 | ! $Header$ | ||
66 | ! | ||
67 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
68 | ! veillez � n'utiliser que des ! pour les commentaires | ||
69 | ! et � bien positionner les & des lignes de continuation | ||
70 | ! (les placer en colonne 6 et en colonne 73) | ||
71 | ! | ||
72 | ! | ||
73 | ! A1.0 Fundamental constants | ||
74 | REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO | ||
75 | ! A1.1 Astronomical constants | ||
76 | REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA | ||
77 | ! A1.1.bis Constantes concernant l'orbite de la Terre: | ||
78 | REAL R_ecc, R_peri, R_incl | ||
79 | ! A1.2 Geoide | ||
80 | REAL RA,RG,R1SA | ||
81 | ! A1.3 Radiation | ||
82 | ! REAL RSIGMA,RI0 | ||
83 | REAL RSIGMA | ||
84 | ! A1.4 Thermodynamic gas phase | ||
85 | REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12 | ||
86 | REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV | ||
87 | REAL RKAPPA,RETV, eps_w | ||
88 | ! A1.5,6 Thermodynamic liquid,solid phases | ||
89 | REAL RCW,RCS | ||
90 | ! A1.7 Thermodynamic transition of phase | ||
91 | REAL RLVTT,RLSTT,RLMLT,RTT,RATM | ||
92 | ! A1.8 Curve of saturation | ||
93 | REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS | ||
94 | REAL RALPD,RBETD,RGAMD | ||
95 | ! | ||
96 | COMMON/YOMCST/RPI ,RCLUM ,RHPLA ,RKBOL ,RNAVO & | ||
97 | & ,RDAY ,REA ,REPSM ,RSIYEA,RSIDAY,ROMEGA & | ||
98 | & ,R_ecc, R_peri, R_incl & | ||
99 | & ,RA ,RG ,R1SA & | ||
100 | & ,RSIGMA & | ||
101 | & ,R ,RMD ,RMV ,RD ,RV ,RCPD & | ||
102 | & ,RMO3 ,RMCO2 ,RMC ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12 & | ||
103 | & ,RCPV ,RCVD ,RCVV ,RKAPPA,RETV, eps_w & | ||
104 | & ,RCW ,RCS & | ||
105 | & ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM & | ||
106 | & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS & | ||
107 | & ,RALPD ,RBETD ,RGAMD | ||
108 | ! ------------------------------------------------------------------ | ||
109 | !$OMP THREADPRIVATE(/YOMCST/) | ||
110 | ! | ||
111 | ! $Id: YOETHF.h 2799 2017-02-24 18:50:33Z jyg $ | ||
112 | ! | ||
113 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
114 | ! veillez n'utiliser que des ! pour les commentaires | ||
115 | ! et bien positionner les & des lignes de continuation | ||
116 | ! (les placer en colonne 6 et en colonne 73) | ||
117 | ! | ||
118 | !* COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS | ||
119 | ! | ||
120 | ! *R__ES* *CONSTANTS USED FOR COMPUTATION OF SATURATION | ||
121 | ! MIXING RATIO OVER LIQUID WATER(*R_LES*) OR | ||
122 | ! ICE(*R_IES*). | ||
123 | ! *RVTMP2* *RVTMP2=RCPV/RCPD-1. | ||
124 | ! *RHOH2O* *DENSITY OF LIQUID WATER. (RATM/100.) | ||
125 | ! | ||
126 | REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES | ||
127 | REAL RVTMP2, RHOH2O | ||
128 | REAL R5ALVCP,R5ALSCP,RALVDCP,RALSDCP,RALFDCP,RTWAT,RTBER,RTBERCU | ||
129 | REAL RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,RKOOP2 | ||
130 | LOGICAL OK_BAD_ECMWF_THERMO ! If TRUE, then variables set by rrtm/suphec.F90 | ||
131 | ! If FALSE, then variables set by suphel.F90 | ||
132 | COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, & | ||
133 | & RVTMP2, RHOH2O, & | ||
134 | & R5ALVCP,R5ALSCP,RALVDCP,RALSDCP, & | ||
135 | & RALFDCP,RTWAT,RTBER,RTBERCU, & | ||
136 | & RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,& | ||
137 | & RKOOP2, & | ||
138 | & OK_BAD_ECMWF_THERMO | ||
139 | |||
140 | !$OMP THREADPRIVATE(/YOETHF/) | ||
141 | ! | ||
142 | ! $Header$ | ||
143 | ! | ||
144 | ! | ||
145 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
146 | ! veillez n'utiliser que des ! pour les commentaires | ||
147 | ! et bien positionner les & des lignes de continuation | ||
148 | ! (les placer en colonne 6 et en colonne 73) | ||
149 | ! | ||
150 | ! ------------------------------------------------------------------ | ||
151 | ! This COMDECK includes the Thermodynamical functions for the cy39 | ||
152 | ! ECMWF Physics package. | ||
153 | ! Consistent with YOMCST Basic physics constants, assuming the | ||
154 | ! partial pressure of water vapour is given by a first order | ||
155 | ! Taylor expansion of Qs(T) w.r.t. to Temperature, using constants | ||
156 | ! in YOETHF | ||
157 | ! ------------------------------------------------------------------ | ||
158 | REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG | ||
159 | REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl | ||
160 | LOGICAL thermcep | ||
161 | PARAMETER (thermcep=.TRUE.) | ||
162 | ! | ||
163 | FOEEW ( PTARG,PDELARG ) = EXP ( & | ||
164 | & (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) & | ||
165 | & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) ) | ||
166 | ! | ||
167 | FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG & | ||
168 | & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2 | ||
169 | ! | ||
170 | qsats(ptarg) = 100.0 * 0.622 * 10.0 & | ||
171 | & ** (2.07023 - 0.00320991 * ptarg & | ||
172 | & - 2484.896 / ptarg + 3.56654 * LOG10(ptarg)) | ||
173 | qsatl(ptarg) = 100.0 * 0.622 * 10.0 & | ||
174 | & ** (23.8319 - 2948.964 / ptarg & | ||
175 | & - 5.028 * LOG10(ptarg) & | ||
176 | & - 29810.16 * EXP( - 0.0699382 * ptarg) & | ||
177 | & + 25.21935 * EXP( - 2999.924 / ptarg)) | ||
178 | ! | ||
179 | dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg & | ||
180 | & +2484.896*LOG(10.)/ptarg**2 & | ||
181 | & -0.00320991*LOG(10.)) | ||
182 | dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)* & | ||
183 | & (2948.964/ptarg**2-5.028/LOG(10.)/ptarg & | ||
184 | & +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg) & | ||
185 | & +29810.16*0.0699382*EXP(-0.0699382*ptarg)) | ||
186 | integer :: iflag_thermals,nsplit_thermals | ||
187 | |||
188 | !!! nrlmd le 10/04/2012 | ||
189 | integer :: iflag_trig_bl,iflag_clos_bl | ||
190 | integer :: tau_trig_shallow,tau_trig_deep | ||
191 | real :: s_trig | ||
192 | !!! fin nrlmd le 10/04/2012 | ||
193 | |||
194 | real,parameter :: r_aspect_thermals=2.,l_mix_thermals=30. | ||
195 | real :: alp_bl_k | ||
196 | real :: tau_thermals,fact_thermals_ed_dz | ||
197 | integer,parameter :: w2di_thermals=0 | ||
198 | integer :: isplit | ||
199 | |||
200 | integer :: iflag_coupl,iflag_clos,iflag_wake | ||
201 | integer :: iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure | ||
202 | |||
203 | common/ctherm1/iflag_thermals,nsplit_thermals,iflag_thermals_closure | ||
204 | common/ctherm2/tau_thermals,alp_bl_k,fact_thermals_ed_dz | ||
205 | common/ctherm4/iflag_coupl,iflag_clos,iflag_wake | ||
206 | common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux | ||
207 | |||
208 | !!! nrlmd le 10/04/2012 | ||
209 | common/ctherm6/iflag_trig_bl,iflag_clos_bl | ||
210 | common/ctherm7/tau_trig_shallow,tau_trig_deep | ||
211 | common/ctherm8/s_trig | ||
212 | !!! fin nrlmd le 10/04/2012 | ||
213 | |||
214 | !$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/) | ||
215 | !$OMP THREADPRIVATE(/ctherm6/,/ctherm7/,/ctherm8/) | ||
216 | |||
217 | ! arguments: | ||
218 | ! ---------- | ||
219 | |||
220 | !IM 140508 | ||
221 | INTEGER itap | ||
222 | |||
223 | INTEGER ngrid,nlay | ||
224 | real ptimestep | ||
225 | REAL pt(ngrid,nlay),pdtadj(ngrid,nlay) | ||
226 | REAL pu(ngrid,nlay),pduadj(ngrid,nlay) | ||
227 | REAL pv(ngrid,nlay),pdvadj(ngrid,nlay) | ||
228 | REAL po(ngrid,nlay),pdoadj(ngrid,nlay) | ||
229 | REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1) | ||
230 | real pphi(ngrid,nlay) | ||
231 | LOGICAL debut | ||
232 | |||
233 | ! local: | ||
234 | ! ------ | ||
235 | |||
236 | integer icount | ||
237 | |||
238 | integer, save :: dvdq=1,dqimpl=-1 | ||
239 | !$OMP THREADPRIVATE(dvdq,dqimpl) | ||
240 | data icount/0/ | ||
241 | save icount | ||
242 | !$OMP THREADPRIVATE(icount) | ||
243 | |||
244 | integer,save :: igout=1 | ||
245 | !$OMP THREADPRIVATE(igout) | ||
246 | integer,save :: lunout1=6 | ||
247 | !$OMP THREADPRIVATE(lunout1) | ||
248 | integer,save :: lev_out=10 | ||
249 | !$OMP THREADPRIVATE(lev_out) | ||
250 | |||
251 | REAL susqr2pi, Reuler | ||
252 | |||
253 | INTEGER ig,k,l,ll,ierr | ||
254 | real zsortie1d(klon) | ||
255 | 960 | INTEGER lmax(klon),lmin(klon),lalim(klon) | |
256 | 960 | INTEGER lmix(klon) | |
257 | 960 | INTEGER lmix_bis(klon) | |
258 | 960 | real linter(klon) | |
259 | 960 | real zmix(klon) | |
260 | 960 | real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1),ztva_est(klon,klev) | |
261 | ! real fraca(klon,klev) | ||
262 | |||
263 | 960 | real zmax_sec(klon) | |
264 | !on garde le zmax du pas de temps precedent | ||
265 | real zmax0(klon) | ||
266 | !FH/IM save zmax0 | ||
267 | |||
268 | real lambda | ||
269 | |||
270 | 960 | real zlev(klon,klev+1),zlay(klon,klev) | |
271 | 960 | real deltaz(klon,klev) | |
272 | 960 | REAL zh(klon,klev) | |
273 | 960 | real zthl(klon,klev),zdthladj(klon,klev) | |
274 | REAL ztv(klon,klev) | ||
275 | 960 | real zu(klon,klev),zv(klon,klev),zo(klon,klev) | |
276 | 960 | real zl(klon,klev) | |
277 | real zsortie(klon,klev) | ||
278 | 960 | real zva(klon,klev) | |
279 | 960 | real zua(klon,klev) | |
280 | 960 | real zoa(klon,klev) | |
281 | |||
282 | 960 | real zta(klon,klev) | |
283 | 960 | real zha(klon,klev) | |
284 | real fraca(klon,klev+1) | ||
285 | real zf,zf2 | ||
286 | 960 | real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev) | |
287 | 960 | real q2(klon,klev) | |
288 | ! FH probleme de dimensionnement avec l'allocation dynamique | ||
289 | ! common/comtherm/thetath2,wth2 | ||
290 | 960 | real wq(klon,klev) | |
291 | 960 | real wthl(klon,klev) | |
292 | 960 | real wthv(klon,klev) | |
293 | |||
294 | real ratqscth(klon,klev) | ||
295 | real var | ||
296 | real vardiff | ||
297 | real ratqsdiff(klon,klev) | ||
298 | |||
299 | logical sorties | ||
300 | 960 | real rho(klon,klev),rhobarz(klon,klev),masse(klon,klev) | |
301 | real zpspsk(klon,klev) | ||
302 | |||
303 | 960 | real wmax(klon) | |
304 | 960 | real wmax_tmp(klon) | |
305 | 960 | real wmax_sec(klon) | |
306 | real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev) | ||
307 | 960 | real fm(klon,klev+1),entr(klon,klev),detr(klon,klev) | |
308 | |||
309 | real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev) | ||
310 | !niveau de condensation | ||
311 | 960 | integer nivcon(klon) | |
312 | 960 | real zcon(klon) | |
313 | REAL CHI | ||
314 | 960 | real zcon2(klon) | |
315 | 960 | real pcon(klon) | |
316 | 960 | real zqsat(klon,klev) | |
317 | real zqsatth(klon,klev) | ||
318 | |||
319 | 960 | real f_star(klon,klev+1),entr_star(klon,klev) | |
320 | 960 | real detr_star(klon,klev) | |
321 | 960 | real alim_star_tot(klon) | |
322 | 960 | real alim_star(klon,klev) | |
323 | 960 | real alim_star_clos(klon,klev) | |
324 | 960 | real f(klon), f0(klon) | |
325 | !FH/IM save f0 | ||
326 | real zlevinter(klon) | ||
327 | real seuil | ||
328 | 960 | real csc(klon,klev) | |
329 | |||
330 | !!! nrlmd le 10/04/2012 | ||
331 | |||
332 | !------Entr�es | ||
333 | real pbl_tke(klon,klev+1,nbsrf) | ||
334 | real pctsrf(klon,nbsrf) | ||
335 | real omega(klon,klev) | ||
336 | real airephy(klon) | ||
337 | !------Sorties | ||
338 | real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon) | ||
339 | real therm_tke_max0(klon),env_tke_max0(klon) | ||
340 | real n2(klon),s2(klon) | ||
341 | real ale_bl_stat(klon) | ||
342 | real therm_tke_max(klon,klev),env_tke_max(klon,klev) | ||
343 | real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon) | ||
344 | !------Local | ||
345 | integer nsrf | ||
346 | real rhobarz0(klon) ! Densit� au LCL | ||
347 | logical ok_lcl(klon) ! Existence du LCL des thermiques | ||
348 | integer klcl(klon) ! Niveau du LCL | ||
349 | real interp(klon) ! Coef d'interpolation pour le LCL | ||
350 | !--Triggering | ||
351 | real Su ! Surface unit�: celle d'un updraft �l�mentaire | ||
352 | parameter(Su=4e4) | ||
353 | real hcoef ! Coefficient directeur pour le calcul de s2 | ||
354 | parameter(hcoef=1) | ||
355 | real hmincoef ! Coefficient directeur pour l'ordonn�e � l'origine pour le calcul de s2 | ||
356 | parameter(hmincoef=0.3) | ||
357 | real eps1 ! Fraction de surface occup�e par la population 1 : eps1=n1*s1/(fraca0*Sd) | ||
358 | parameter(eps1=0.3) | ||
359 | real hmin(ngrid) ! Ordonn�e � l'origine pour le calcul de s2 | ||
360 | real zmax_moy(ngrid) ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl) | ||
361 | real zmax_moy_coef | ||
362 | parameter(zmax_moy_coef=0.33) | ||
363 | real depth(klon) ! Epaisseur moyenne du cumulus | ||
364 | real w_max(klon) ! Vitesse max statistique | ||
365 | real s_max(klon) | ||
366 | !--Closure | ||
367 | real pbl_tke_max(klon,klev) ! Profil de TKE moyenne | ||
368 | real pbl_tke_max0(klon) ! TKE moyenne au LCL | ||
369 | real w_ls(klon,klev) ! Vitesse verticale grande �chelle (m/s) | ||
370 | real coef_m ! On consid�re un rendement pour alp_bl_fluct_m | ||
371 | parameter(coef_m=1.) | ||
372 | real coef_tke ! On consid�re un rendement pour alp_bl_fluct_tke | ||
373 | parameter(coef_tke=1.) | ||
374 | |||
375 | !!! fin nrlmd le 10/04/2012 | ||
376 | |||
377 | ! | ||
378 | !nouvelles variables pour la convection | ||
379 | real Ale_bl(klon) | ||
380 | real Alp_bl(klon) | ||
381 | real alp_int(klon),dp_int(klon),zdp | ||
382 | real ale_int(klon) | ||
383 | integer n_int(klon) | ||
384 | real fm_tot(klon) | ||
385 | real wght_th(klon,klev) | ||
386 | integer lalim_conv(klon) | ||
387 | !v1d logical therm | ||
388 | !v1d save therm | ||
389 | |||
390 | character*2 str2 | ||
391 | character*10 str10 | ||
392 | |||
393 | character (len=20) :: modname='thermcell_main' | ||
394 | character (len=80) :: abort_message | ||
395 | |||
396 | EXTERNAL SCOPY | ||
397 | ! | ||
398 | |||
399 | !----------------------------------------------------------------------- | ||
400 | ! initialisation: | ||
401 | ! --------------- | ||
402 | ! | ||
403 | |||
404 | 480 | seuil=0.25 | |
405 | |||
406 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
|
480 | if (debut) then |
407 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | if (iflag_thermals==15.or.iflag_thermals==16) then |
408 | ✗ | dvdq=0 | |
409 | ✗ | dqimpl=-1 | |
410 | else | ||
411 | 1 | dvdq=1 | |
412 | 1 | dqimpl=1 | |
413 | endif | ||
414 | |||
415 |
4/4✓ Branch 0 taken 40 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 39760 times.
✓ Branch 3 taken 40 times.
|
39801 | fm0=0. |
416 |
4/4✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
|
38806 | entr0=0. |
417 |
4/4✓ Branch 0 taken 1 times.
✓ Branch 1 taken 39 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
|
38806 | detr0=0. |
418 | endif | ||
419 |
12/12✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
|
56357280 | fm=0. ; entr=0. ; detr=0. |
420 | 480 | icount=icount+1 | |
421 | |||
422 | !IM 090508 beg | ||
423 | !print*,'=====================================================================' | ||
424 | !print*,'=====================================================================' | ||
425 | !print*,' PAS ',icount,' PAS ',icount,' PAS ',icount,' PAS ',icount | ||
426 | !print*,'=====================================================================' | ||
427 | !print*,'=====================================================================' | ||
428 | !IM 090508 end | ||
429 | |||
430 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main V4' |
431 | |||
432 | sorties=.true. | ||
433 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF(ngrid.NE.klon) THEN |
434 | ✗ | PRINT* | |
435 | ✗ | PRINT*,'STOP dans convadj' | |
436 | ✗ | PRINT*,'ngrid =',ngrid | |
437 | ✗ | PRINT*,'klon =',klon | |
438 | ENDIF | ||
439 | ! | ||
440 | ! write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)' | ||
441 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,klon |
442 | 477120 | f0(ig)=max(f0(ig),1.e-2) | |
443 | 477600 | zmax0(ig)=max(zmax0(ig),40.) | |
444 | !IMmarche pas ?! if (f0(ig)<1.e-2) f0(ig)=1.e-2 | ||
445 | enddo | ||
446 | |||
447 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.20) then |
448 | ✗ | do ig=1,ngrid | |
449 | ✗ | print*,'th_main ig f0',ig,f0(ig) | |
450 | enddo | ||
451 | endif | ||
452 | !----------------------------------------------------------------------- | ||
453 | ! Calcul de T,q,ql a partir de Tl et qT dans l environnement | ||
454 | ! -------------------------------------------------------------------- | ||
455 | ! | ||
456 | CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay, & | ||
457 | 480 | & pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out) | |
458 | |||
459 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env' |
460 | |||
461 | !------------------------------------------------------------------------ | ||
462 | ! -------------------- | ||
463 | ! | ||
464 | ! | ||
465 | ! + + + + + + + + + + + | ||
466 | ! | ||
467 | ! | ||
468 | ! wa, fraca, wd, fracd -------------------- zlev(2), rhobarz | ||
469 | ! wh,wt,wo ... | ||
470 | ! | ||
471 | ! + + + + + + + + + + + zh,zu,zv,zo,rho | ||
472 | ! | ||
473 | ! | ||
474 | ! -------------------- zlev(1) | ||
475 | ! \\\\\\\\\\\\\\\\\\\! | ||
476 | ! | ||
477 | |||
478 | !----------------------------------------------------------------------- | ||
479 | ! Calcul des altitudes des couches | ||
480 | !----------------------------------------------------------------------- | ||
481 | |||
482 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do l=2,nlay |
483 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG |
484 | enddo | ||
485 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | zlev(:,1)=0. |
486 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG |
487 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
488 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | zlay(:,l)=pphi(:,l)/RG |
489 | enddo | ||
490 | !calcul de l epaisseur des couches | ||
491 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
492 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | deltaz(:,l)=zlev(:,l+1)-zlev(:,l) |
493 | enddo | ||
494 | |||
495 | ! print*,'2 OK convect8' | ||
496 | !----------------------------------------------------------------------- | ||
497 | ! Calcul des densites | ||
498 | !----------------------------------------------------------------------- | ||
499 | |||
500 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:)) |
501 | |||
502 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10)write(lunout,*) & |
503 | ✗ | & 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)' | |
504 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | rhobarz(:,1)=rho(:,1) |
505 | |||
506 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do l=2,nlay |
507 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1)) |
508 | enddo | ||
509 | |||
510 | !calcul de la masse | ||
511 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
512 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG |
513 | enddo | ||
514 | |||
515 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres initialisation' |
516 | |||
517 | !------------------------------------------------------------------ | ||
518 | ! | ||
519 | ! /|! -------- | F_k+1 ------- | ||
520 | ! ----> D_k | ||
521 | ! /|\ <---- E_k , A_k | ||
522 | ! -------- | F_k --------- | ||
523 | ! ----> D_k-1 | ||
524 | ! <---- E_k-1 , A_k-1 | ||
525 | ! | ||
526 | ! | ||
527 | ! | ||
528 | ! | ||
529 | ! | ||
530 | ! --------------------------- | ||
531 | ! | ||
532 | ! ----- F_lmax+1=0 ---------- ! lmax (zmax) | | ||
533 | ! --------------------------- | | ||
534 | ! | | ||
535 | ! --------------------------- | | ||
536 | ! | | ||
537 | ! --------------------------- | | ||
538 | ! | | ||
539 | ! --------------------------- | | ||
540 | ! | | ||
541 | ! --------------------------- | | ||
542 | ! | E | ||
543 | ! --------------------------- | D | ||
544 | ! | | ||
545 | ! --------------------------- | | ||
546 | ! | | ||
547 | ! --------------------------- \ | | ||
548 | ! lalim | | | ||
549 | ! --------------------------- | | | ||
550 | ! | | | ||
551 | ! --------------------------- | | | ||
552 | ! | A | | ||
553 | ! --------------------------- | | | ||
554 | ! | | | ||
555 | ! --------------------------- | | | ||
556 | ! lmin (=1 pour le moment) | | | ||
557 | ! ----- F_lmin=0 ------------ / / | ||
558 | ! | ||
559 | ! --------------------------- | ||
560 | ! ////////////////////////// | ||
561 | ! | ||
562 | ! | ||
563 | !============================================================================= | ||
564 | ! Calculs initiaux ne faisant pas intervenir les changements de phase | ||
565 | !============================================================================= | ||
566 | |||
567 | !------------------------------------------------------------------ | ||
568 | ! 1. alim_star est le profil vertical de l'alimentation a la base du | ||
569 | ! panache thermique, calcule a partir de la flotabilite de l'air sec | ||
570 | ! 2. lmin et lalim sont les indices inferieurs et superieurs de alim_star | ||
571 | !------------------------------------------------------------------ | ||
572 | ! | ||
573 |
14/14✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
✓ Branch 12 taken 477120 times.
✓ Branch 13 taken 480 times.
|
56356800 | entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0. |
574 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | lmin=1 |
575 | |||
576 | !----------------------------------------------------------------------------- | ||
577 | ! 3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un | ||
578 | ! panache sec conservatif (e=d=0) alimente selon alim_star | ||
579 | ! Il s'agit d'un calcul de type CAPE | ||
580 | ! zmax_sec est utilise pour determiner la geometrie du thermique. | ||
581 | !------------------------------------------------------------------------------ | ||
582 | !--------------------------------------------------------------------------------- | ||
583 | !calcul du melange et des variables dans le thermique | ||
584 | !-------------------------------------------------------------------------------- | ||
585 | ! | ||
586 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out |
587 | |||
588 | !===================================================================== | ||
589 | ! Old version of thermcell_plume in thermcell_plume_6A.F90 | ||
590 | ! It includes both thermcell_plume_6A and thermcell_plume_5B corresponding | ||
591 | ! to the 5B and 6A versions used for CMIP5 and CMIP6. | ||
592 | ! The latest was previously named thermcellV1_plume. | ||
593 | ! The new thermcell_plume is a clean version (removing obsolete | ||
594 | ! options) of thermcell_plume_6A. | ||
595 | ! The 3 versions are controled by | ||
596 | ! flag_thermals_ed <= 9 thermcell_plume_6A | ||
597 | ! <= 19 thermcell_plume_5B | ||
598 | ! else thermcell_plume (default 20 for convergence with 6A) | ||
599 | ! Fredho | ||
600 | !===================================================================== | ||
601 | |||
602 |
1/2✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
|
480 | if (iflag_thermals_ed<=9) then |
603 | ! print*,'THERM NOUVELLE/NOUVELLE Arnaud' | ||
604 | CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& | ||
605 | & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & | ||
606 | & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & | ||
607 | & ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter & | ||
608 | 480 | & ,lev_out,lunout1,igout) | |
609 | |||
610 | ✗ | elseif (iflag_thermals_ed<=19) then | |
611 | ! print*,'THERM RIO et al 2010, version d Arnaud' | ||
612 | CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& | ||
613 | & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & | ||
614 | & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & | ||
615 | & ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter & | ||
616 | ✗ | & ,lev_out,lunout1,igout) | |
617 | else | ||
618 | CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& | ||
619 | & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & | ||
620 | & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & | ||
621 | & ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter & | ||
622 | ✗ | & ,lev_out,lunout1,igout) | |
623 | endif | ||
624 | |||
625 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out |
626 | |||
627 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ') | |
628 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix ') | |
629 | |||
630 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume' |
631 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10) then |
632 | ✗ | write(lunout1,*) 'Dans thermcell_main 2' | |
633 | ✗ | write(lunout1,*) 'lmin ',lmin(igout) | |
634 | ✗ | write(lunout1,*) 'lalim ',lalim(igout) | |
635 | ✗ | write(lunout1,*) ' ig l alim_star entr_star detr_star f_star ' | |
636 | ✗ | write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) & | |
637 | ✗ | & ,f_star(igout,l+1),l=1,nint(linter(igout))+5) | |
638 | endif | ||
639 | |||
640 | !------------------------------------------------------------------------------- | ||
641 | ! Calcul des caracteristiques du thermique:zmax,zmix,wmax | ||
642 | !------------------------------------------------------------------------------- | ||
643 | ! | ||
644 | CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2, & | ||
645 | 480 | & zlev,lmax,zmax,zmax0,zmix,wmax,lev_out) | |
646 | ! Attention, w2 est transforme en sa racine carree dans cette routine | ||
647 | ! Le probleme vient du fait que linter et lmix sont souvent �gaux � 1. | ||
648 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | wmax_tmp=0. |
649 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
650 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | wmax_tmp(:)=max(wmax_tmp(:),zw2(:,l)) |
651 | enddo | ||
652 | ! print*,"ZMAX ",lalim,lmin,linter,lmix,lmax,zmax,zmax0,zmix,wmax | ||
653 | |||
654 | |||
655 | |||
656 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ') | |
657 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin ') | |
658 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix ') | |
659 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax ') | |
660 | |||
661 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height' |
662 | |||
663 | !------------------------------------------------------------------------------- | ||
664 | ! Fermeture,determination de f | ||
665 | !------------------------------------------------------------------------------- | ||
666 | ! | ||
667 | ! | ||
668 | !! write(lunout,*)'THERM NOUVEAU XXXXX' | ||
669 | CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, & | ||
670 | 480 | & lalim,lmin,zmax_sec,wmax_sec,lev_out) | |
671 | |||
672 | |||
673 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lmin ') | |
674 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lalim ') | |
675 | |||
676 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry' |
677 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10) then |
678 | ✗ | write(lunout1,*) 'Dans thermcell_main 1b' | |
679 | ✗ | write(lunout1,*) 'lmin ',lmin(igout) | |
680 | ✗ | write(lunout1,*) 'lalim ',lalim(igout) | |
681 | ✗ | write(lunout1,*) ' ig l alim_star entr_star detr_star f_star ' | |
682 | ✗ | write(lunout1,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) & | |
683 | ✗ | & ,l=1,lalim(igout)+4) | |
684 | endif | ||
685 | |||
686 | |||
687 | |||
688 | |||
689 | ! Choix de la fonction d'alimentation utilisee pour la fermeture. | ||
690 | ! Apparemment sans importance | ||
691 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | alim_star_clos(:,:)=alim_star(:,:) |
692 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | alim_star_clos(:,:)=entr_star(:,:)+alim_star(:,:) |
693 | ! | ||
694 | !CR Appel de la fermeture seche | ||
695 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (iflag_thermals_closure.eq.1) then |
696 | |||
697 | CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho, & | ||
698 | ✗ | & zlev,lalim,alim_star_clos,f_star,zmax_sec,wmax_sec,f,lev_out) | |
699 | |||
700 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
701 | ! Appel avec les zmax et wmax tenant compte de la condensation | ||
702 | ! Semble moins bien marcher | ||
703 |
1/2✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
|
480 | else if (iflag_thermals_closure.eq.2) then |
704 | |||
705 | CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho, & | ||
706 | 480 | & zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out) | |
707 | |||
708 | endif | ||
709 | |||
710 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
711 | |||
712 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure' |
713 | |||
714 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (tau_thermals>1.) then |
715 | ✗ | lambda=exp(-ptimestep/tau_thermals) | |
716 | ✗ | f0=(1.-lambda)*f+lambda*f0 | |
717 | else | ||
718 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | f0=f |
719 | endif | ||
720 | |||
721 | ! Test valable seulement en 1D mais pas genant | ||
722 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (.not. (f0(1).ge.0.) ) then |
723 | ✗ | abort_message = '.not. (f0(1).ge.0.)' | |
724 | ✗ | CALL abort_physic (modname,abort_message,1) | |
725 | endif | ||
726 | |||
727 | !------------------------------------------------------------------------------- | ||
728 | !deduction des flux | ||
729 | !------------------------------------------------------------------------------- | ||
730 | |||
731 | CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, & | ||
732 | & lalim,lmax,alim_star, & | ||
733 | & entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr, & | ||
734 | 480 | & detr,zqla,lev_out,lunout1,igout) | |
735 | !IM 060508 & detr,zqla,zmax,lev_out,lunout,igout) | ||
736 | |||
737 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux' |
738 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ') | |
739 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax ') | |
740 | |||
741 | !------------------------------------------------------------------ | ||
742 | ! On ne prend pas directement les profils issus des calculs precedents | ||
743 | ! mais on s'autorise genereusement une relaxation vers ceci avec | ||
744 | ! une constante de temps tau_thermals (typiquement 1800s). | ||
745 | !------------------------------------------------------------------ | ||
746 | |||
747 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (tau_thermals>1.) then |
748 | ✗ | lambda=exp(-ptimestep/tau_thermals) | |
749 | ✗ | fm0=(1.-lambda)*fm+lambda*fm0 | |
750 | ✗ | entr0=(1.-lambda)*entr+lambda*entr0 | |
751 | ✗ | detr0=(1.-lambda)*detr+lambda*detr0 | |
752 | else | ||
753 |
4/4✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
|
19104480 | fm0=fm |
754 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | entr0=entr |
755 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | detr0=detr |
756 | endif | ||
757 | |||
758 | !c------------------------------------------------------------------ | ||
759 | ! calcul du transport vertical | ||
760 | !------------------------------------------------------------------ | ||
761 | |||
762 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & | ||
763 | 480 | & zthl,zdthladj,zta,lev_out) | |
764 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & | ||
765 | 480 | & po,pdoadj,zoa,lev_out) | |
766 | |||
767 | !------------------------------------------------------------------ | ||
768 | ! Calcul de la fraction de l'ascendance | ||
769 | !------------------------------------------------------------------ | ||
770 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,klon |
771 | 477120 | fraca(ig,1)=0. | |
772 | 477600 | fraca(ig,nlay+1)=0. | |
773 | enddo | ||
774 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do l=2,nlay |
775 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,klon |
776 |
2/2✓ Branch 0 taken 1304631 times.
✓ Branch 1 taken 16825929 times.
|
18148800 | if (zw2(ig,l).gt.1.e-10) then |
777 | 1304631 | fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l)) | |
778 | else | ||
779 | 16825929 | fraca(ig,l)=0. | |
780 | endif | ||
781 | enddo | ||
782 | enddo | ||
783 | |||
784 | !------------------------------------------------------------------ | ||
785 | ! calcul du transport vertical du moment horizontal | ||
786 | !------------------------------------------------------------------ | ||
787 | |||
788 | !IM 090508 | ||
789 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (dvdq == 0 ) then |
790 | |||
791 | ! Calcul du transport de V tenant compte d'echange par gradient | ||
792 | ! de pression horizontal avec l'environnement | ||
793 | |||
794 | call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse & | ||
795 | ! & ,fraca*dvdq,zmax & | ||
796 | & ,fraca,zmax & | ||
797 | ✗ | & ,zu,zv,pduadj,pdvadj,zua,zva,lev_out) | |
798 | |||
799 | else | ||
800 | |||
801 | ! calcul purement conservatif pour le transport de V | ||
802 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse & | ||
803 | 480 | & ,zu,pduadj,zua,lev_out) | |
804 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse & | ||
805 | 480 | & ,zv,pdvadj,zva,lev_out) | |
806 | |||
807 | endif | ||
808 | |||
809 | ! print*,'13 OK convect8' | ||
810 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
811 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
812 | 18626400 | pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l) | |
813 | enddo | ||
814 | enddo | ||
815 | |||
816 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14 OK convect8' |
817 | !------------------------------------------------------------------ | ||
818 | ! Calculs de diagnostiques pour les sorties | ||
819 | !------------------------------------------------------------------ | ||
820 | !calcul de fraca pour les sorties | ||
821 | |||
822 | if (sorties) then | ||
823 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14a OK convect8' |
824 | ! calcul du niveau de condensation | ||
825 | ! initialisation | ||
826 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
827 | 477120 | nivcon(ig)=0 | |
828 | 477600 | zcon(ig)=0. | |
829 | enddo | ||
830 | !nouveau calcul | ||
831 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
832 | 477120 | CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1)) | |
833 | 477600 | pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI | |
834 | enddo | ||
835 | !IM do k=1,nlay | ||
836 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=1,nlay-1 |
837 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,ngrid |
838 | if ((pcon(ig).le.pplay(ig,k)) & | ||
839 |
4/4✓ Branch 0 taken 1543040 times.
✓ Branch 1 taken 16587520 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 1065920 times.
|
18148800 | & .and.(pcon(ig).gt.pplay(ig,k+1))) then |
840 | 477120 | zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100. | |
841 | endif | ||
842 | enddo | ||
843 | enddo | ||
844 | !IM | ||
845 | ierr=0 | ||
846 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
847 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 477120 times.
|
477600 | if (pcon(ig).le.pplay(ig,nlay)) then |
848 | ✗ | zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100. | |
849 | ierr=1 | ||
850 | endif | ||
851 | enddo | ||
852 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (ierr==1) then |
853 | ✗ | abort_message = 'thermcellV0_main: les thermiques vont trop haut ' | |
854 | ✗ | CALL abort_physic (modname,abort_message,1) | |
855 | endif | ||
856 | |||
857 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14b OK convect8' |
858 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do k=nlay,1,-1 |
859 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
860 |
2/2✓ Branch 0 taken 378607 times.
✓ Branch 1 taken 18229073 times.
|
18626400 | if (zqla(ig,k).gt.1e-10) then |
861 | 378607 | nivcon(ig)=k | |
862 | 378607 | zcon(ig)=zlev(ig,k) | |
863 | endif | ||
864 | enddo | ||
865 | enddo | ||
866 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14c OK convect8' |
867 | !calcul des moments | ||
868 | !initialisation | ||
869 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
870 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
871 | 18607680 | q2(ig,l)=0. | |
872 | 18607680 | wth2(ig,l)=0. | |
873 | 18607680 | wth3(ig,l)=0. | |
874 | 18607680 | ratqscth(ig,l)=0. | |
875 | 18626400 | ratqsdiff(ig,l)=0. | |
876 | enddo | ||
877 | enddo | ||
878 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14d OK convect8' |
879 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10)write(lunout,*) & |
880 | ✗ | & 'WARNING thermcell_main wth2=0. si zw2 > 1.e-10' | |
881 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
882 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
883 | 18607680 | zf=fraca(ig,l) | |
884 | 18607680 | zf2=zf/(1.-zf) | |
885 | ! | ||
886 | 18607680 | thetath2(ig,l)=zf2*(ztla(ig,l)-zthl(ig,l))**2 | |
887 |
2/2✓ Branch 0 taken 1304631 times.
✓ Branch 1 taken 17303049 times.
|
18607680 | if(zw2(ig,l).gt.1.e-10) then |
888 | 1304631 | wth2(ig,l)=zf2*(zw2(ig,l))**2 | |
889 | else | ||
890 | 17303049 | wth2(ig,l)=0. | |
891 | endif | ||
892 | wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l)) & | ||
893 | 18607680 | & *zw2(ig,l)*zw2(ig,l)*zw2(ig,l) | |
894 | 18607680 | q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2 | |
895 | !test: on calcul q2/po=ratqsc | ||
896 | 18626400 | ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.)) | |
897 | enddo | ||
898 | enddo | ||
899 | !calcul des flux: q, thetal et thetav | ||
900 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
901 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
902 | 18607680 | wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-po(ig,l)*1000.) | |
903 | 18607680 | wthl(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztla(ig,l)-zthl(ig,l)) | |
904 | 18626400 | wthv(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztva(ig,l)-ztv(ig,l)) | |
905 | enddo | ||
906 | enddo | ||
907 | ! | ||
908 | ! $Id: thermcell_main.F90 3451 2019-01-27 11:07:30Z fhourdin $ | ||
909 | ! | ||
910 | CALL thermcell_alp(ngrid,nlay,ptimestep & | ||
911 | & ,pplay,pplev & | ||
912 | & ,fm0,entr0,lmax & | ||
913 | & ,Ale_bl,Alp_bl,lalim_conv,wght_th & | ||
914 | & ,zw2,fraca & | ||
915 | !!! necessire en plus | ||
916 | & ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax & | ||
917 | !!! nrlmd le 10/04/2012 | ||
918 | & ,pbl_tke,pctsrf,omega,airephy & | ||
919 | & ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 & | ||
920 | & ,n2,s2,ale_bl_stat & | ||
921 | & ,therm_tke_max,env_tke_max & | ||
922 | & ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & | ||
923 | & ,alp_bl_conv,alp_bl_stat & | ||
924 | !!! fin nrlmd le 10/04/2012 | ||
925 | 480 | & ) | |
926 | |||
927 | |||
928 | |||
929 | !calcul du ratqscdiff | ||
930 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14e OK convect8' |
931 | var=0. | ||
932 | vardiff=0. | ||
933 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | ratqsdiff(:,:)=0. |
934 | |||
935 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,klev |
936 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
937 |
2/2✓ Branch 0 taken 1086781 times.
✓ Branch 1 taken 17520899 times.
|
18626400 | if (l<=lalim(ig)) then |
938 | 1086781 | var=var+alim_star(ig,l)*zqta(ig,l)*1000. | |
939 | endif | ||
940 | enddo | ||
941 | enddo | ||
942 | |||
943 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14f OK convect8' |
944 | |||
945 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,klev |
946 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
947 |
2/2✓ Branch 0 taken 1086781 times.
✓ Branch 1 taken 17520899 times.
|
18626400 | if (l<=lalim(ig)) then |
948 | 1086781 | zf=fraca(ig,l) | |
949 | zf2=zf/(1.-zf) | ||
950 | 1086781 | vardiff=vardiff+alim_star(ig,l)*(zqta(ig,l)*1000.-var)**2 | |
951 | endif | ||
952 | enddo | ||
953 | enddo | ||
954 | |||
955 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14g OK convect8' |
956 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
957 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
958 | 18626400 | ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.) | |
959 | ! write(11,*)'ratqsdiff=',ratqsdiff(ig,l) | ||
960 | enddo | ||
961 | enddo | ||
962 | !-------------------------------------------------------------------- | ||
963 | ! | ||
964 | !ecriture des fichiers sortie | ||
965 | ! print*,'15 OK convect8 CCCCCCCCCCCCCCCCCCc' | ||
966 | |||
967 | endif | ||
968 | |||
969 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main FIN OK' |
970 | |||
971 | 480 | return | |
972 | end | ||
973 | |||
974 | !----------------------------------------------------------------------------- | ||
975 | |||
976 | 4800 | subroutine test_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment) | |
977 | USE print_control_mod, ONLY: prt_level | ||
978 | IMPLICIT NONE | ||
979 | |||
980 | integer i, k, klon,klev | ||
981 | real pplev(klon,klev+1),pplay(klon,klev) | ||
982 | real ztv(klon,klev) | ||
983 | real po(klon,klev) | ||
984 | real ztva(klon,klev) | ||
985 | real zqla(klon,klev) | ||
986 | real f_star(klon,klev) | ||
987 | real zw2(klon,klev) | ||
988 | integer long(klon) | ||
989 | real seuil | ||
990 | character*21 comment | ||
991 | |||
992 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4800 times.
|
4800 | if (prt_level.ge.1) THEN |
993 | ✗ | print*,'WARNING !!! TEST ',comment | |
994 | endif | ||
995 | return | ||
996 | |||
997 | ! test sur la hauteur des thermiques ... | ||
998 | do i=1,klon | ||
999 | !IMtemp if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then | ||
1000 | if (prt_level.ge.10) then | ||
1001 | print*,'WARNING ',comment,' au point ',i,' K= ',long(i) | ||
1002 | print*,' K P(MB) THV(K) Qenv(g/kg)THVA QLA(g/kg) F* W2' | ||
1003 | do k=1,klev | ||
1004 | write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k) | ||
1005 | enddo | ||
1006 | endif | ||
1007 | enddo | ||
1008 | |||
1009 | |||
1010 | return | ||
1011 | end | ||
1012 | |||
1013 | !!! nrlmd le 10/04/2012 Transport de la TKE par le thermique moyen pour la fermeture en ALP | ||
1014 | ! On transporte pbl_tke pour donner therm_tke | ||
1015 | ! Copie conforme de la subroutine DTKE dans physiq.F �crite par Frederic Hourdin | ||
1016 | 480 | subroutine thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0, & | |
1017 | & rg,pplev,therm_tke_max) | ||
1018 | USE print_control_mod, ONLY: prt_level | ||
1019 | implicit none | ||
1020 | |||
1021 | !======================================================================= | ||
1022 | ! | ||
1023 | ! Calcul du transport verticale dans la couche limite en presence | ||
1024 | ! de "thermiques" explicitement representes | ||
1025 | ! calcul du dq/dt une fois qu'on connait les ascendances | ||
1026 | ! | ||
1027 | !======================================================================= | ||
1028 | |||
1029 | integer ngrid,nlay,nsrf | ||
1030 | |||
1031 | real ptimestep | ||
1032 | 960 | real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1) | |
1033 | real entr0(ngrid,nlay),rg | ||
1034 | real therm_tke_max(ngrid,nlay) | ||
1035 | 960 | real detr0(ngrid,nlay) | |
1036 | |||
1037 | |||
1038 | 960 | real masse(ngrid,nlay),fm(ngrid,nlay+1) | |
1039 | 960 | real entr(ngrid,nlay) | |
1040 | 960 | real q(ngrid,nlay) | |
1041 | integer lev_out ! niveau pour les print | ||
1042 | |||
1043 | 960 | real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1) | |
1044 | |||
1045 | real zzm | ||
1046 | |||
1047 | integer ig,k | ||
1048 | integer isrf | ||
1049 | |||
1050 | |||
1051 | lev_out=0 | ||
1052 | |||
1053 | |||
1054 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0' |
1055 | |||
1056 | ! calcul du detrainement | ||
1057 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
|
19200 | do k=1,nlay |
1058 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626400 | detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k) |
1059 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
|
18626880 | masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG |
1060 | enddo | ||
1061 | |||
1062 | |||
1063 | ! Decalage vertical des entrainements et detrainements. | ||
1064 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | masse(:,1)=0.5*masse0(:,1) |
1065 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | entr(:,1)=0.5*entr0(:,1) |
1066 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | detr(:,1)=0.5*detr0(:,1) |
1067 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | fm(:,1)=0. |
1068 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=1,nlay-1 |
1069 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18148800 | masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1)) |
1070 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18148800 | entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1)) |
1071 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18148800 | detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1)) |
1072 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18149280 | fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k) |
1073 | enddo | ||
1074 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | fm(:,nlay+1)=0. |
1075 | |||
1076 | !!! nrlmd le 16/09/2010 | ||
1077 | ! calcul de la valeur dans les ascendances | ||
1078 | ! do ig=1,ngrid | ||
1079 | ! qa(ig,1)=q(ig,1) | ||
1080 | ! enddo | ||
1081 | !!! | ||
1082 | |||
1083 | !do isrf=1,nsrf | ||
1084 | |||
1085 | ! q(:,:)=therm_tke(:,:,isrf) | ||
1086 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | q(:,:)=therm_tke_max(:,:) |
1087 | !!! nrlmd le 16/09/2010 | ||
1088 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | do ig=1,ngrid |
1089 | 477600 | qa(ig,1)=q(ig,1) | |
1090 | enddo | ||
1091 | !!! | ||
1092 | |||
1093 | if (1==1) then | ||
1094 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=2,nlay |
1095 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,ngrid |
1096 |
2/2✓ Branch 0 taken 1550514 times.
✓ Branch 1 taken 16580046 times.
|
18130560 | if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. & |
1097 | & 1.e-5*masse(ig,k)) then | ||
1098 | qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) & | ||
1099 | 1550514 | & /(fm(ig,k+1)+detr(ig,k)) | |
1100 | else | ||
1101 | 16580046 | qa(ig,k)=q(ig,k) | |
1102 | endif | ||
1103 | if (qa(ig,k).lt.0.) then | ||
1104 | ! print*,'qa<0!!!' | ||
1105 | endif | ||
1106 | 18240 | if (q(ig,k).lt.0.) then | |
1107 | ! print*,'q<0!!!' | ||
1108 | endif | ||
1109 | enddo | ||
1110 | enddo | ||
1111 | |||
1112 | ! Calcul du flux subsident | ||
1113 | |||
1114 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=2,nlay |
1115 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,ngrid |
1116 | 18130560 | wqd(ig,k)=fm(ig,k)*q(ig,k) | |
1117 | 18240 | if (wqd(ig,k).lt.0.) then | |
1118 | ! print*,'wqd<0!!!' | ||
1119 | endif | ||
1120 | enddo | ||
1121 | enddo | ||
1122 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | do ig=1,ngrid |
1123 | 477120 | wqd(ig,1)=0. | |
1124 | 477600 | wqd(ig,nlay+1)=0. | |
1125 | enddo | ||
1126 | |||
1127 | ! Calcul des tendances | ||
1128 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do k=1,nlay |
1129 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
1130 | q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k) & | ||
1131 | & -wqd(ig,k)+wqd(ig,k+1)) & | ||
1132 | 18626400 | & *ptimestep/masse(ig,k) | |
1133 | enddo | ||
1134 | enddo | ||
1135 | |||
1136 | endif | ||
1137 | |||
1138 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | therm_tke_max(:,:)=q(:,:) |
1139 | |||
1140 | 480 | return | |
1141 | !!! fin nrlmd le 10/04/2012 | ||
1142 | end | ||
1143 | |||
1144 |