Line |
Branch |
Exec |
Source |
1 |
|
|
! |
2 |
|
|
! $Id$ |
3 |
|
|
! |
4 |
|
✗ |
SUBROUTINE thermcellV0_main(itap,ngrid,nlay,ptimestep & |
5 |
|
|
& ,pplay,pplev,pphi,debut & |
6 |
|
✗ |
& ,pu,pv,pt,po & |
7 |
|
|
& ,pduadj,pdvadj,pdtadj,pdoadj & |
8 |
|
✗ |
& ,fm0,entr0,detr0,zqta,zqla,lmax & |
9 |
|
|
& ,ratqscth,ratqsdiff,zqsatth & |
10 |
|
|
& ,r_aspect,l_mix,tau_thermals & |
11 |
|
|
& ,Ale_bl,Alp_bl,lalim_conv,wght_th & |
12 |
|
✗ |
& ,zmax0, f0,zw2,fraca) |
13 |
|
|
|
14 |
|
|
USE dimphy |
15 |
|
|
USE print_control_mod, ONLY: prt_level,lunout |
16 |
|
|
IMPLICIT NONE |
17 |
|
|
|
18 |
|
|
!======================================================================= |
19 |
|
|
! Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu |
20 |
|
|
! Version du 09.02.07 |
21 |
|
|
! Calcul du transport vertical dans la couche limite en presence |
22 |
|
|
! de "thermiques" explicitement representes avec processus nuageux |
23 |
|
|
! |
24 |
|
|
! R��criture � partir d'un listing papier � Habas, le 14/02/00 |
25 |
|
|
! |
26 |
|
|
! le thermique est suppos� homog�ne et dissip� par m�lange avec |
27 |
|
|
! son environnement. la longueur l_mix contr�le l'efficacit� du |
28 |
|
|
! m�lange |
29 |
|
|
! |
30 |
|
|
! Le calcul du transport des diff�rentes esp�ces se fait en prenant |
31 |
|
|
! en compte: |
32 |
|
|
! 1. un flux de masse montant |
33 |
|
|
! 2. un flux de masse descendant |
34 |
|
|
! 3. un entrainement |
35 |
|
|
! 4. un detrainement |
36 |
|
|
! |
37 |
|
|
!======================================================================= |
38 |
|
|
|
39 |
|
|
!----------------------------------------------------------------------- |
40 |
|
|
! declarations: |
41 |
|
|
! ------------- |
42 |
|
|
|
43 |
|
|
include "YOMCST.h" |
44 |
|
|
include "YOETHF.h" |
45 |
|
|
include "FCTTRE.h" |
46 |
|
|
|
47 |
|
|
! arguments: |
48 |
|
|
! ---------- |
49 |
|
|
|
50 |
|
|
!IM 140508 |
51 |
|
|
INTEGER itap |
52 |
|
|
|
53 |
|
|
INTEGER ngrid,nlay,w2di |
54 |
|
|
real tau_thermals |
55 |
|
|
real ptimestep,l_mix,r_aspect |
56 |
|
|
REAL pt(ngrid,nlay),pdtadj(ngrid,nlay) |
57 |
|
|
REAL pu(ngrid,nlay),pduadj(ngrid,nlay) |
58 |
|
|
REAL pv(ngrid,nlay),pdvadj(ngrid,nlay) |
59 |
|
|
REAL po(ngrid,nlay),pdoadj(ngrid,nlay) |
60 |
|
|
REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1) |
61 |
|
|
real pphi(ngrid,nlay) |
62 |
|
|
|
63 |
|
|
! local: |
64 |
|
|
! ------ |
65 |
|
|
|
66 |
|
|
integer icount |
67 |
|
|
data icount/0/ |
68 |
|
|
save icount |
69 |
|
|
!$OMP THREADPRIVATE(icount) |
70 |
|
|
|
71 |
|
|
integer,save :: igout=1 |
72 |
|
|
!$OMP THREADPRIVATE(igout) |
73 |
|
|
integer,save :: lunout1=6 |
74 |
|
|
!$OMP THREADPRIVATE(lunout1) |
75 |
|
|
integer,save :: lev_out=10 |
76 |
|
|
!$OMP THREADPRIVATE(lev_out) |
77 |
|
|
|
78 |
|
|
INTEGER ig,k,l,ll |
79 |
|
|
real zsortie1d(klon) |
80 |
|
✗ |
INTEGER lmax(klon),lmin(klon),lalim(klon) |
81 |
|
✗ |
INTEGER lmix(klon) |
82 |
|
✗ |
INTEGER lmix_bis(klon) |
83 |
|
✗ |
real linter(klon) |
84 |
|
✗ |
real zmix(klon) |
85 |
|
✗ |
real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1) |
86 |
|
|
! real fraca(klon,klev) |
87 |
|
|
|
88 |
|
✗ |
real zmax_sec(klon) |
89 |
|
|
!on garde le zmax du pas de temps precedent |
90 |
|
|
real zmax0(klon) |
91 |
|
|
!FH/IM save zmax0 |
92 |
|
|
|
93 |
|
|
real lambda |
94 |
|
|
|
95 |
|
✗ |
real zlev(klon,klev+1),zlay(klon,klev) |
96 |
|
✗ |
real deltaz(klon,klev) |
97 |
|
✗ |
REAL zh(klon,klev) |
98 |
|
✗ |
real zthl(klon,klev),zdthladj(klon,klev) |
99 |
|
✗ |
REAL ztv(klon,klev) |
100 |
|
✗ |
real zu(klon,klev),zv(klon,klev),zo(klon,klev) |
101 |
|
✗ |
real zl(klon,klev) |
102 |
|
|
real zsortie(klon,klev) |
103 |
|
✗ |
real zva(klon,klev) |
104 |
|
✗ |
real zua(klon,klev) |
105 |
|
✗ |
real zoa(klon,klev) |
106 |
|
|
|
107 |
|
✗ |
real zta(klon,klev) |
108 |
|
✗ |
real zha(klon,klev) |
109 |
|
|
real fraca(klon,klev+1) |
110 |
|
|
real zf,zf2 |
111 |
|
✗ |
real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev) |
112 |
|
✗ |
real q2(klon,klev) |
113 |
|
|
! FH probleme de dimensionnement avec l'allocation dynamique |
114 |
|
|
! common/comtherm/thetath2,wth2 |
115 |
|
|
|
116 |
|
|
real ratqscth(klon,klev) |
117 |
|
|
real var |
118 |
|
|
real vardiff |
119 |
|
|
real ratqsdiff(klon,klev) |
120 |
|
|
|
121 |
|
|
logical sorties |
122 |
|
✗ |
real rho(klon,klev),rhobarz(klon,klev),masse(klon,klev) |
123 |
|
✗ |
real zpspsk(klon,klev) |
124 |
|
|
|
125 |
|
✗ |
real wmax(klon) |
126 |
|
✗ |
real wmax_sec(klon) |
127 |
|
|
real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev) |
128 |
|
✗ |
real fm(klon,klev+1),entr(klon,klev),detr(klon,klev) |
129 |
|
|
|
130 |
|
✗ |
real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev) |
131 |
|
|
!niveau de condensation |
132 |
|
✗ |
integer nivcon(klon) |
133 |
|
✗ |
real zcon(klon) |
134 |
|
|
REAL CHI |
135 |
|
✗ |
real zcon2(klon) |
136 |
|
✗ |
real pcon(klon) |
137 |
|
✗ |
real zqsat(klon,klev) |
138 |
|
|
real zqsatth(klon,klev) |
139 |
|
|
|
140 |
|
✗ |
real f_star(klon,klev+1),entr_star(klon,klev) |
141 |
|
✗ |
real detr_star(klon,klev) |
142 |
|
✗ |
real alim_star_tot(klon),alim_star2(klon) |
143 |
|
✗ |
real alim_star(klon,klev) |
144 |
|
✗ |
real f(klon), f0(klon) |
145 |
|
|
!FH/IM save f0 |
146 |
|
|
real zlevinter(klon) |
147 |
|
|
logical debut |
148 |
|
|
real seuil |
149 |
|
|
|
150 |
|
|
! Declaration uniquement pour les sorties dans thermcell_out3d. |
151 |
|
|
! Inutilise en 3D |
152 |
|
|
real wthl(klon,klev) |
153 |
|
|
real wthv(klon,klev) |
154 |
|
|
real wq(klon,klev) |
155 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
156 |
|
|
|
157 |
|
|
|
158 |
|
|
! |
159 |
|
|
!nouvelles variables pour la convection |
160 |
|
|
real Ale_bl(klon) |
161 |
|
|
real Alp_bl(klon) |
162 |
|
✗ |
real alp_int(klon) |
163 |
|
✗ |
real ale_int(klon) |
164 |
|
✗ |
integer n_int(klon) |
165 |
|
✗ |
real fm_tot(klon) |
166 |
|
|
real wght_th(klon,klev) |
167 |
|
|
integer lalim_conv(klon) |
168 |
|
|
!v1d logical therm |
169 |
|
|
!v1d save therm |
170 |
|
|
|
171 |
|
|
character*2 str2 |
172 |
|
|
character*10 str10 |
173 |
|
|
|
174 |
|
|
character (len=20) :: modname='thermcellV0_main' |
175 |
|
|
character (len=80) :: abort_message |
176 |
|
|
|
177 |
|
|
EXTERNAL SCOPY |
178 |
|
|
! |
179 |
|
|
|
180 |
|
|
!----------------------------------------------------------------------- |
181 |
|
|
! initialisation: |
182 |
|
|
! --------------- |
183 |
|
|
! |
184 |
|
|
|
185 |
|
✗ |
seuil=0.25 |
186 |
|
|
|
187 |
|
✗ |
if (debut) then |
188 |
|
✗ |
fm0=0. |
189 |
|
✗ |
entr0=0. |
190 |
|
✗ |
detr0=0. |
191 |
|
|
endif |
192 |
|
✗ |
fm=0. ; entr=0. ; detr=0. |
193 |
|
|
|
194 |
|
✗ |
icount=icount+1 |
195 |
|
|
|
196 |
|
|
!IM 090508 beg |
197 |
|
|
!print*,'=====================================================================' |
198 |
|
|
!print*,'=====================================================================' |
199 |
|
|
!print*,' PAS ',icount,' PAS ',icount,' PAS ',icount,' PAS ',icount |
200 |
|
|
!print*,'=====================================================================' |
201 |
|
|
!print*,'=====================================================================' |
202 |
|
|
!IM 090508 end |
203 |
|
|
|
204 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main V4' |
205 |
|
|
|
206 |
|
|
sorties=.true. |
207 |
|
✗ |
IF(ngrid.NE.klon) THEN |
208 |
|
✗ |
PRINT* |
209 |
|
✗ |
PRINT*,'STOP dans convadj' |
210 |
|
✗ |
PRINT*,'ngrid =',ngrid |
211 |
|
✗ |
PRINT*,'klon =',klon |
212 |
|
|
ENDIF |
213 |
|
|
! |
214 |
|
|
!Initialisation |
215 |
|
|
! |
216 |
|
✗ |
if (prt_level.ge.10)write(lunout,*) & |
217 |
|
✗ |
& 'WARNING thermcell_main f0=max(f0,1.e-2)' |
218 |
|
✗ |
do ig=1,klon |
219 |
|
✗ |
f0(ig)=max(f0(ig),1.e-2) |
220 |
|
|
enddo |
221 |
|
|
|
222 |
|
|
!----------------------------------------------------------------------- |
223 |
|
|
! Calcul de T,q,ql a partir de Tl et qT dans l environnement |
224 |
|
|
! -------------------------------------------------------------------- |
225 |
|
|
! |
226 |
|
|
CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay, & |
227 |
|
✗ |
& pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out) |
228 |
|
|
|
229 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env' |
230 |
|
|
|
231 |
|
|
!------------------------------------------------------------------------ |
232 |
|
|
! -------------------- |
233 |
|
|
! |
234 |
|
|
! |
235 |
|
|
! + + + + + + + + + + + |
236 |
|
|
! |
237 |
|
|
! |
238 |
|
|
! wa, fraca, wd, fracd -------------------- zlev(2), rhobarz |
239 |
|
|
! wh,wt,wo ... |
240 |
|
|
! |
241 |
|
|
! + + + + + + + + + + + zh,zu,zv,zo,rho |
242 |
|
|
! |
243 |
|
|
! |
244 |
|
|
! -------------------- zlev(1) |
245 |
|
|
! \\\\\\\\\\\\\\\\\\\! |
246 |
|
|
! |
247 |
|
|
|
248 |
|
|
!----------------------------------------------------------------------- |
249 |
|
|
! Calcul des altitudes des couches |
250 |
|
|
!----------------------------------------------------------------------- |
251 |
|
|
|
252 |
|
✗ |
do l=2,nlay |
253 |
|
✗ |
zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG |
254 |
|
|
enddo |
255 |
|
✗ |
zlev(:,1)=0. |
256 |
|
✗ |
zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG |
257 |
|
✗ |
do l=1,nlay |
258 |
|
✗ |
zlay(:,l)=pphi(:,l)/RG |
259 |
|
|
enddo |
260 |
|
|
!calcul de l epaisseur des couches |
261 |
|
✗ |
do l=1,nlay |
262 |
|
✗ |
deltaz(:,l)=zlev(:,l+1)-zlev(:,l) |
263 |
|
|
enddo |
264 |
|
|
|
265 |
|
|
! print*,'2 OK convect8' |
266 |
|
|
!----------------------------------------------------------------------- |
267 |
|
|
! Calcul des densites |
268 |
|
|
!----------------------------------------------------------------------- |
269 |
|
|
|
270 |
|
✗ |
do l=1,nlay |
271 |
|
✗ |
rho(:,l)=pplay(:,l)/(zpspsk(:,l)*RD*ztv(:,l)) |
272 |
|
|
enddo |
273 |
|
|
|
274 |
|
|
!IM |
275 |
|
✗ |
if (prt_level.ge.10)write(lunout,*) & |
276 |
|
✗ |
& 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)' |
277 |
|
✗ |
rhobarz(:,1)=rho(:,1) |
278 |
|
|
|
279 |
|
✗ |
do l=2,nlay |
280 |
|
✗ |
rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1)) |
281 |
|
|
enddo |
282 |
|
|
|
283 |
|
|
!calcul de la masse |
284 |
|
✗ |
do l=1,nlay |
285 |
|
✗ |
masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG |
286 |
|
|
enddo |
287 |
|
|
|
288 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main apres initialisation' |
289 |
|
|
|
290 |
|
|
!------------------------------------------------------------------ |
291 |
|
|
! |
292 |
|
|
! /|! -------- | F_k+1 ------- |
293 |
|
|
! ----> D_k |
294 |
|
|
! /|\ <---- E_k , A_k |
295 |
|
|
! -------- | F_k --------- |
296 |
|
|
! ----> D_k-1 |
297 |
|
|
! <---- E_k-1 , A_k-1 |
298 |
|
|
! |
299 |
|
|
! |
300 |
|
|
! |
301 |
|
|
! |
302 |
|
|
! |
303 |
|
|
! --------------------------- |
304 |
|
|
! |
305 |
|
|
! ----- F_lmax+1=0 ---------- ! lmax (zmax) | |
306 |
|
|
! --------------------------- | |
307 |
|
|
! | |
308 |
|
|
! --------------------------- | |
309 |
|
|
! | |
310 |
|
|
! --------------------------- | |
311 |
|
|
! | |
312 |
|
|
! --------------------------- | |
313 |
|
|
! | |
314 |
|
|
! --------------------------- | |
315 |
|
|
! | E |
316 |
|
|
! --------------------------- | D |
317 |
|
|
! | |
318 |
|
|
! --------------------------- | |
319 |
|
|
! | |
320 |
|
|
! --------------------------- \ | |
321 |
|
|
! lalim | | |
322 |
|
|
! --------------------------- | | |
323 |
|
|
! | | |
324 |
|
|
! --------------------------- | | |
325 |
|
|
! | A | |
326 |
|
|
! --------------------------- | | |
327 |
|
|
! | | |
328 |
|
|
! --------------------------- | | |
329 |
|
|
! lmin (=1 pour le moment) | | |
330 |
|
|
! ----- F_lmin=0 ------------ / / |
331 |
|
|
! |
332 |
|
|
! --------------------------- |
333 |
|
|
! ////////////////////////// |
334 |
|
|
! |
335 |
|
|
! |
336 |
|
|
!============================================================================= |
337 |
|
|
! Calculs initiaux ne faisant pas intervenir les changements de phase |
338 |
|
|
!============================================================================= |
339 |
|
|
|
340 |
|
|
!------------------------------------------------------------------ |
341 |
|
|
! 1. alim_star est le profil vertical de l'alimentation � la base du |
342 |
|
|
! panache thermique, calcul� � partir de la flotabilit� de l'air sec |
343 |
|
|
! 2. lmin et lalim sont les indices inferieurs et superieurs de alim_star |
344 |
|
|
!------------------------------------------------------------------ |
345 |
|
|
! |
346 |
|
✗ |
entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0. |
347 |
|
|
CALL thermcellV0_init(ngrid,nlay,ztv,zlay,zlev, & |
348 |
|
✗ |
& lalim,lmin,alim_star,alim_star_tot,lev_out) |
349 |
|
|
|
350 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lmin ') |
351 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lalim ') |
352 |
|
|
|
353 |
|
|
|
354 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main apres thermcell_init' |
355 |
|
✗ |
if (prt_level.ge.10) then |
356 |
|
✗ |
write(lunout1,*) 'Dans thermcell_main 1' |
357 |
|
✗ |
write(lunout1,*) 'lmin ',lmin(igout) |
358 |
|
✗ |
write(lunout1,*) 'lalim ',lalim(igout) |
359 |
|
✗ |
write(lunout1,*) ' ig l alim_star thetav' |
360 |
|
✗ |
write(lunout1,'(i6,i4,2e15.5)') (igout,l,alim_star(igout,l) & |
361 |
|
✗ |
& ,ztv(igout,l),l=1,lalim(igout)+4) |
362 |
|
|
endif |
363 |
|
|
|
364 |
|
|
!v1d do ig=1,klon |
365 |
|
|
!v1d if (alim_star(ig,1).gt.1.e-10) then |
366 |
|
|
!v1d therm=.true. |
367 |
|
|
!v1d endif |
368 |
|
|
!v1d enddo |
369 |
|
|
!----------------------------------------------------------------------------- |
370 |
|
|
! 3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un |
371 |
|
|
! panache sec conservatif (e=d=0) alimente selon alim_star |
372 |
|
|
! Il s'agit d'un calcul de type CAPE |
373 |
|
|
! zmax_sec est utilis� pour d�terminer la g�om�trie du thermique. |
374 |
|
|
!------------------------------------------------------------------------------ |
375 |
|
|
! |
376 |
|
|
CALL thermcellV0_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, & |
377 |
|
✗ |
& lalim,lmin,zmax_sec,wmax_sec,lev_out) |
378 |
|
|
|
379 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lmin ') |
380 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lalim ') |
381 |
|
|
|
382 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry' |
383 |
|
✗ |
if (prt_level.ge.10) then |
384 |
|
✗ |
write(lunout1,*) 'Dans thermcell_main 1b' |
385 |
|
✗ |
write(lunout1,*) 'lmin ',lmin(igout) |
386 |
|
✗ |
write(lunout1,*) 'lalim ',lalim(igout) |
387 |
|
✗ |
write(lunout1,*) ' ig l alim_star entr_star detr_star f_star ' |
388 |
|
✗ |
write(lunout1,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) & |
389 |
|
✗ |
& ,l=1,lalim(igout)+4) |
390 |
|
|
endif |
391 |
|
|
|
392 |
|
|
|
393 |
|
|
|
394 |
|
|
!--------------------------------------------------------------------------------- |
395 |
|
|
!calcul du melange et des variables dans le thermique |
396 |
|
|
!-------------------------------------------------------------------------------- |
397 |
|
|
! |
398 |
|
✗ |
if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out |
399 |
|
|
!IM 140508 CALL thermcell_plume(ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz, & |
400 |
|
|
CALL thermcellV0_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz, & |
401 |
|
|
& zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot, & |
402 |
|
|
& lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva, & |
403 |
|
|
& ztla,zqla,zqta,zha,zw2,zw_est,zqsatth,lmix,lmix_bis,linter & |
404 |
|
✗ |
& ,lev_out,lunout1,igout) |
405 |
|
✗ |
if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out |
406 |
|
|
|
407 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ') |
408 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix ') |
409 |
|
|
|
410 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume' |
411 |
|
✗ |
if (prt_level.ge.10) then |
412 |
|
✗ |
write(lunout1,*) 'Dans thermcell_main 2' |
413 |
|
✗ |
write(lunout1,*) 'lmin ',lmin(igout) |
414 |
|
✗ |
write(lunout1,*) 'lalim ',lalim(igout) |
415 |
|
✗ |
write(lunout1,*) ' ig l alim_star entr_star detr_star f_star ' |
416 |
|
✗ |
write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) & |
417 |
|
✗ |
& ,f_star(igout,l+1),l=1,nint(linter(igout))+5) |
418 |
|
|
endif |
419 |
|
|
|
420 |
|
|
!------------------------------------------------------------------------------- |
421 |
|
|
! Calcul des caracteristiques du thermique:zmax,zmix,wmax |
422 |
|
|
!------------------------------------------------------------------------------- |
423 |
|
|
! |
424 |
|
|
CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2, & |
425 |
|
✗ |
& zlev,lmax,zmax,zmax0,zmix,wmax,lev_out) |
426 |
|
|
|
427 |
|
|
|
428 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ') |
429 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin ') |
430 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix ') |
431 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax ') |
432 |
|
|
|
433 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height' |
434 |
|
|
|
435 |
|
|
!------------------------------------------------------------------------------- |
436 |
|
|
! Fermeture,determination de f |
437 |
|
|
!------------------------------------------------------------------------------- |
438 |
|
|
! |
439 |
|
|
!avant closure: on red�finit lalim, alim_star_tot et alim_star |
440 |
|
|
! do ig=1,klon |
441 |
|
|
! do l=2,lalim(ig) |
442 |
|
|
! alim_star(ig,l)=entr_star(ig,l) |
443 |
|
|
! entr_star(ig,l)=0. |
444 |
|
|
! enddo |
445 |
|
|
! enddo |
446 |
|
|
|
447 |
|
|
CALL thermcellV0_closure(ngrid,nlay,r_aspect,ptimestep,rho, & |
448 |
|
✗ |
& zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out) |
449 |
|
|
|
450 |
|
✗ |
if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure' |
451 |
|
|
|
452 |
|
✗ |
if (tau_thermals>1.) then |
453 |
|
✗ |
lambda=exp(-ptimestep/tau_thermals) |
454 |
|
✗ |
f0=(1.-lambda)*f+lambda*f0 |
455 |
|
|
else |
456 |
|
✗ |
f0=f |
457 |
|
|
endif |
458 |
|
|
|
459 |
|
|
! Test valable seulement en 1D mais pas genant |
460 |
|
✗ |
if (.not. (f0(1).ge.0.) ) then |
461 |
|
✗ |
abort_message = 'Dans thermcell_main f0(1).lt.0 ' |
462 |
|
✗ |
CALL abort_physic (modname,abort_message,1) |
463 |
|
|
endif |
464 |
|
|
|
465 |
|
|
!------------------------------------------------------------------------------- |
466 |
|
|
!deduction des flux |
467 |
|
|
!------------------------------------------------------------------------------- |
468 |
|
|
|
469 |
|
|
CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, & |
470 |
|
|
& lalim,lmax,alim_star, & |
471 |
|
|
& entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr, & |
472 |
|
✗ |
& detr,zqla,lev_out,lunout1,igout) |
473 |
|
|
!IM 060508 & detr,zqla,zmax,lev_out,lunout,igout) |
474 |
|
|
|
475 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux' |
476 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ') |
477 |
|
✗ |
call testV0_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax ') |
478 |
|
|
|
479 |
|
|
!------------------------------------------------------------------ |
480 |
|
|
! On ne prend pas directement les profils issus des calculs precedents |
481 |
|
|
! mais on s'autorise genereusement une relaxation vers ceci avec |
482 |
|
|
! une constante de temps tau_thermals (typiquement 1800s). |
483 |
|
|
!------------------------------------------------------------------ |
484 |
|
|
|
485 |
|
✗ |
if (tau_thermals>1.) then |
486 |
|
✗ |
lambda=exp(-ptimestep/tau_thermals) |
487 |
|
✗ |
fm0=(1.-lambda)*fm+lambda*fm0 |
488 |
|
✗ |
entr0=(1.-lambda)*entr+lambda*entr0 |
489 |
|
|
! detr0=(1.-lambda)*detr+lambda*detr0 |
490 |
|
|
else |
491 |
|
✗ |
fm0=fm |
492 |
|
✗ |
entr0=entr |
493 |
|
✗ |
detr0=detr |
494 |
|
|
endif |
495 |
|
|
|
496 |
|
|
!c------------------------------------------------------------------ |
497 |
|
|
! calcul du transport vertical |
498 |
|
|
!------------------------------------------------------------------ |
499 |
|
|
|
500 |
|
|
call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse, & |
501 |
|
✗ |
& zthl,zdthladj,zta,lev_out) |
502 |
|
|
call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse, & |
503 |
|
✗ |
& po,pdoadj,zoa,lev_out) |
504 |
|
|
|
505 |
|
|
!------------------------------------------------------------------ |
506 |
|
|
! Calcul de la fraction de l'ascendance |
507 |
|
|
!------------------------------------------------------------------ |
508 |
|
✗ |
do ig=1,klon |
509 |
|
✗ |
fraca(ig,1)=0. |
510 |
|
✗ |
fraca(ig,nlay+1)=0. |
511 |
|
|
enddo |
512 |
|
✗ |
do l=2,nlay |
513 |
|
✗ |
do ig=1,klon |
514 |
|
✗ |
if (zw2(ig,l).gt.1.e-10) then |
515 |
|
✗ |
fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l)) |
516 |
|
|
else |
517 |
|
✗ |
fraca(ig,l)=0. |
518 |
|
|
endif |
519 |
|
|
enddo |
520 |
|
|
enddo |
521 |
|
|
|
522 |
|
|
!------------------------------------------------------------------ |
523 |
|
|
! calcul du transport vertical du moment horizontal |
524 |
|
|
!------------------------------------------------------------------ |
525 |
|
|
|
526 |
|
|
!IM 090508 |
527 |
|
✗ |
if (1.eq.1) then |
528 |
|
|
!IM 070508 vers. _dq |
529 |
|
|
! if (1.eq.0) then |
530 |
|
|
|
531 |
|
|
|
532 |
|
|
! Calcul du transport de V tenant compte d'echange par gradient |
533 |
|
|
! de pression horizontal avec l'environnement |
534 |
|
|
|
535 |
|
|
call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse & |
536 |
|
|
& ,fraca,zmax & |
537 |
|
|
& ,zu,zv,pduadj,pdvadj,zua,zva,lev_out) |
538 |
|
|
!IM 050508 & ,zu,zv,pduadj,pdvadj,zua,zva,igout,lev_out) |
539 |
|
|
else |
540 |
|
|
|
541 |
|
|
! calcul purement conservatif pour le transport de V |
542 |
|
|
call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse & |
543 |
|
|
& ,zu,pduadj,zua,lev_out) |
544 |
|
|
call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse & |
545 |
|
|
& ,zv,pdvadj,zva,lev_out) |
546 |
|
|
endif |
547 |
|
|
|
548 |
|
|
! print*,'13 OK convect8' |
549 |
|
✗ |
do l=1,nlay |
550 |
|
✗ |
do ig=1,ngrid |
551 |
|
✗ |
pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l) |
552 |
|
|
enddo |
553 |
|
|
enddo |
554 |
|
|
|
555 |
|
✗ |
if (prt_level.ge.1) print*,'14 OK convect8' |
556 |
|
|
!------------------------------------------------------------------ |
557 |
|
|
! Calculs de diagnostiques pour les sorties |
558 |
|
|
!------------------------------------------------------------------ |
559 |
|
|
!calcul de fraca pour les sorties |
560 |
|
|
|
561 |
|
|
if (sorties) then |
562 |
|
✗ |
if (prt_level.ge.1) print*,'14a OK convect8' |
563 |
|
|
! calcul du niveau de condensation |
564 |
|
|
! initialisation |
565 |
|
✗ |
do ig=1,ngrid |
566 |
|
✗ |
nivcon(ig)=0 |
567 |
|
✗ |
zcon(ig)=0. |
568 |
|
|
enddo |
569 |
|
|
!nouveau calcul |
570 |
|
✗ |
do ig=1,ngrid |
571 |
|
✗ |
CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1)) |
572 |
|
✗ |
pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI |
573 |
|
|
enddo |
574 |
|
|
!IM do k=1,nlay |
575 |
|
✗ |
do k=1,nlay-1 |
576 |
|
✗ |
do ig=1,ngrid |
577 |
|
|
if ((pcon(ig).le.pplay(ig,k)) & |
578 |
|
✗ |
& .and.(pcon(ig).gt.pplay(ig,k+1))) then |
579 |
|
✗ |
zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100. |
580 |
|
|
endif |
581 |
|
|
enddo |
582 |
|
|
enddo |
583 |
|
|
!IM |
584 |
|
✗ |
do ig=1,ngrid |
585 |
|
✗ |
if (pcon(ig).le.pplay(ig,nlay)) then |
586 |
|
✗ |
zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100. |
587 |
|
✗ |
abort_message = 'thermcellV0_main: les thermiques vont trop haut ' |
588 |
|
✗ |
CALL abort_physic (modname,abort_message,1) |
589 |
|
|
endif |
590 |
|
|
enddo |
591 |
|
✗ |
if (prt_level.ge.1) print*,'14b OK convect8' |
592 |
|
✗ |
do k=nlay,1,-1 |
593 |
|
✗ |
do ig=1,ngrid |
594 |
|
✗ |
if (zqla(ig,k).gt.1e-10) then |
595 |
|
✗ |
nivcon(ig)=k |
596 |
|
✗ |
zcon(ig)=zlev(ig,k) |
597 |
|
|
endif |
598 |
|
|
enddo |
599 |
|
|
enddo |
600 |
|
✗ |
if (prt_level.ge.1) print*,'14c OK convect8' |
601 |
|
|
!calcul des moments |
602 |
|
|
!initialisation |
603 |
|
✗ |
do l=1,nlay |
604 |
|
✗ |
do ig=1,ngrid |
605 |
|
✗ |
q2(ig,l)=0. |
606 |
|
✗ |
wth2(ig,l)=0. |
607 |
|
✗ |
wth3(ig,l)=0. |
608 |
|
✗ |
ratqscth(ig,l)=0. |
609 |
|
✗ |
ratqsdiff(ig,l)=0. |
610 |
|
|
enddo |
611 |
|
|
enddo |
612 |
|
✗ |
if (prt_level.ge.1) print*,'14d OK convect8' |
613 |
|
✗ |
if (prt_level.ge.10)write(lunout,*) & |
614 |
|
✗ |
& 'WARNING thermcell_main wth2=0. si zw2 > 1.e-10' |
615 |
|
✗ |
do l=1,nlay |
616 |
|
✗ |
do ig=1,ngrid |
617 |
|
✗ |
zf=fraca(ig,l) |
618 |
|
✗ |
zf2=zf/(1.-zf) |
619 |
|
|
! |
620 |
|
✗ |
thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2 |
621 |
|
✗ |
if(zw2(ig,l).gt.1.e-10) then |
622 |
|
✗ |
wth2(ig,l)=zf2*(zw2(ig,l))**2 |
623 |
|
|
else |
624 |
|
✗ |
wth2(ig,l)=0. |
625 |
|
|
endif |
626 |
|
|
! print*,'wth2=',wth2(ig,l) |
627 |
|
|
wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l)) & |
628 |
|
✗ |
& *zw2(ig,l)*zw2(ig,l)*zw2(ig,l) |
629 |
|
✗ |
q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2 |
630 |
|
|
!test: on calcul q2/po=ratqsc |
631 |
|
✗ |
ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.)) |
632 |
|
|
enddo |
633 |
|
|
enddo |
634 |
|
|
|
635 |
|
✗ |
if (prt_level.ge.10) then |
636 |
|
✗ |
print*,'14e OK convect8 ig,l,zf,zf2',ig,l,zf,zf2 |
637 |
|
✗ |
ig=igout |
638 |
|
✗ |
do l=1,nlay |
639 |
|
✗ |
print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l) |
640 |
|
|
enddo |
641 |
|
✗ |
do l=1,nlay |
642 |
|
✗ |
print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l) |
643 |
|
|
enddo |
644 |
|
|
endif |
645 |
|
|
|
646 |
|
✗ |
do ig=1,ngrid |
647 |
|
✗ |
alp_int(ig)=0. |
648 |
|
✗ |
ale_int(ig)=0. |
649 |
|
✗ |
n_int(ig)=0 |
650 |
|
|
enddo |
651 |
|
|
! |
652 |
|
✗ |
do l=1,nlay |
653 |
|
✗ |
do ig=1,ngrid |
654 |
|
✗ |
if(l.LE.lmax(ig)) THEN |
655 |
|
✗ |
alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l) |
656 |
|
✗ |
ale_int(ig)=ale_int(ig)+0.5*zw2(ig,l)**2 |
657 |
|
✗ |
n_int(ig)=n_int(ig)+1 |
658 |
|
|
endif |
659 |
|
|
enddo |
660 |
|
|
enddo |
661 |
|
|
! print*,'avant calcul ale et alp' |
662 |
|
|
!calcul de ALE et ALP pour la convection |
663 |
|
✗ |
do ig=1,ngrid |
664 |
|
|
! Alp_bl(ig)=0.5*rhobarz(ig,lmix_bis(ig))*wth3(ig,lmix(ig)) |
665 |
|
|
! Alp_bl(ig)=0.5*rhobarz(ig,nivcon(ig))*wth3(ig,nivcon(ig)) |
666 |
|
|
! Alp_bl(ig)=0.5*rhobarz(ig,lmix(ig))*wth3(ig,lmix(ig)) |
667 |
|
|
! & *0.1 |
668 |
|
|
!valeur integree de alp_bl * 0.5: |
669 |
|
✗ |
if (n_int(ig).gt.0) then |
670 |
|
✗ |
Alp_bl(ig)=0.5*alp_int(ig)/n_int(ig) |
671 |
|
|
! if (Alp_bl(ig).lt.0.) then |
672 |
|
|
! Alp_bl(ig)=0. |
673 |
|
|
endif |
674 |
|
|
! endif |
675 |
|
|
! write(18,*),'rhobarz,wth3,Alp',rhobarz(ig,nivcon(ig)), |
676 |
|
|
! s wth3(ig,nivcon(ig)),Alp_bl(ig) |
677 |
|
|
! write(18,*),'ALP_BL',Alp_bl(ig),lmix(ig) |
678 |
|
|
! Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2 |
679 |
|
|
! if (nivcon(ig).eq.1) then |
680 |
|
|
! Ale_bl(ig)=0. |
681 |
|
|
! else |
682 |
|
|
!valeur max de ale_bl: |
683 |
|
✗ |
Ale_bl(ig)=0.5*zw2(ig,lmix(ig))**2 |
684 |
|
|
! & /2. |
685 |
|
|
! & *0.1 |
686 |
|
|
! Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2 |
687 |
|
|
! if (n_int(ig).gt.0) then |
688 |
|
|
! Ale_bl(ig)=ale_int(ig)/n_int(ig) |
689 |
|
|
! Ale_bl(ig)=4. |
690 |
|
|
! endif |
691 |
|
|
! endif |
692 |
|
|
! Ale_bl(ig)=0.5*wth2(ig,lmix_bis(ig)) |
693 |
|
|
! Ale_bl(ig)=wth2(ig,nivcon(ig)) |
694 |
|
|
! write(19,*),'wth2,ALE_BL',wth2(ig,nivcon(ig)),Ale_bl(ig) |
695 |
|
|
enddo |
696 |
|
|
!test:calcul de la ponderation des couches pour KE |
697 |
|
|
!initialisations |
698 |
|
|
! print*,'ponderation' |
699 |
|
✗ |
do ig=1,ngrid |
700 |
|
✗ |
fm_tot(ig)=0. |
701 |
|
|
enddo |
702 |
|
✗ |
do ig=1,ngrid |
703 |
|
✗ |
do k=1,klev |
704 |
|
✗ |
wght_th(ig,k)=1. |
705 |
|
|
enddo |
706 |
|
|
enddo |
707 |
|
✗ |
do ig=1,ngrid |
708 |
|
|
! lalim_conv(ig)=lmix_bis(ig) |
709 |
|
|
!la hauteur de la couche alim_conv = hauteur couche alim_therm |
710 |
|
✗ |
lalim_conv(ig)=lalim(ig) |
711 |
|
|
! zentr(ig)=zlev(ig,lalim(ig)) |
712 |
|
|
enddo |
713 |
|
✗ |
do ig=1,ngrid |
714 |
|
✗ |
do k=1,lalim_conv(ig) |
715 |
|
✗ |
fm_tot(ig)=fm_tot(ig)+fm(ig,k) |
716 |
|
|
enddo |
717 |
|
|
enddo |
718 |
|
✗ |
do ig=1,ngrid |
719 |
|
✗ |
do k=1,lalim_conv(ig) |
720 |
|
|
if (fm_tot(ig).gt.1.e-10) then |
721 |
|
|
! wght_th(ig,k)=fm(ig,k)/fm_tot(ig) |
722 |
|
|
endif |
723 |
|
|
!on pondere chaque couche par a* |
724 |
|
✗ |
if (alim_star(ig,k).gt.1.e-10) then |
725 |
|
✗ |
wght_th(ig,k)=alim_star(ig,k) |
726 |
|
|
else |
727 |
|
✗ |
wght_th(ig,k)=1. |
728 |
|
|
endif |
729 |
|
|
enddo |
730 |
|
|
enddo |
731 |
|
|
! print*,'apres wght_th' |
732 |
|
|
!test pour prolonger la convection |
733 |
|
✗ |
do ig=1,ngrid |
734 |
|
|
!v1d if ((alim_star(ig,1).lt.1.e-10).and.(therm)) then |
735 |
|
✗ |
if ((alim_star(ig,1).lt.1.e-10)) then |
736 |
|
✗ |
lalim_conv(ig)=1 |
737 |
|
✗ |
wght_th(ig,1)=1. |
738 |
|
|
! print*,'lalim_conv ok',lalim_conv(ig),wght_th(ig,1) |
739 |
|
|
endif |
740 |
|
|
enddo |
741 |
|
|
|
742 |
|
|
!calcul du ratqscdiff |
743 |
|
✗ |
if (prt_level.ge.1) print*,'14e OK convect8' |
744 |
|
|
var=0. |
745 |
|
|
vardiff=0. |
746 |
|
✗ |
ratqsdiff(:,:)=0. |
747 |
|
✗ |
do ig=1,ngrid |
748 |
|
✗ |
do l=1,lalim(ig) |
749 |
|
✗ |
var=var+alim_star(ig,l)*zqta(ig,l)*1000. |
750 |
|
|
enddo |
751 |
|
|
enddo |
752 |
|
✗ |
if (prt_level.ge.1) print*,'14f OK convect8' |
753 |
|
✗ |
do ig=1,ngrid |
754 |
|
✗ |
do l=1,lalim(ig) |
755 |
|
✗ |
zf=fraca(ig,l) |
756 |
|
✗ |
zf2=zf/(1.-zf) |
757 |
|
|
vardiff=vardiff+alim_star(ig,l) & |
758 |
|
✗ |
& *(zqta(ig,l)*1000.-var)**2 |
759 |
|
|
! ratqsdiff=ratqsdiff+alim_star(ig,l)* |
760 |
|
|
! s (zqta(ig,l)*1000.-po(ig,l)*1000.)**2 |
761 |
|
|
enddo |
762 |
|
|
enddo |
763 |
|
✗ |
if (prt_level.ge.1) print*,'14g OK convect8' |
764 |
|
✗ |
do l=1,nlay |
765 |
|
✗ |
do ig=1,ngrid |
766 |
|
✗ |
ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.) |
767 |
|
|
! write(11,*)'ratqsdiff=',ratqsdiff(ig,l) |
768 |
|
|
enddo |
769 |
|
|
enddo |
770 |
|
|
!-------------------------------------------------------------------- |
771 |
|
|
! |
772 |
|
|
!ecriture des fichiers sortie |
773 |
|
|
! print*,'15 OK convect8' |
774 |
|
|
|
775 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main sorties 3D' |
776 |
|
|
endif |
777 |
|
|
|
778 |
|
✗ |
if (prt_level.ge.1) print*,'thermcell_main FIN OK' |
779 |
|
|
|
780 |
|
|
! if(icount.eq.501) stop'au pas 301 dans thermcell_main' |
781 |
|
✗ |
return |
782 |
|
|
end |
783 |
|
|
|
784 |
|
|
!----------------------------------------------------------------------------- |
785 |
|
|
|
786 |
|
✗ |
subroutine testV0_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment) |
787 |
|
|
USE print_control_mod, ONLY: prt_level |
788 |
|
|
IMPLICIT NONE |
789 |
|
|
|
790 |
|
|
integer i, k, klon,klev |
791 |
|
|
real pplev(klon,klev+1),pplay(klon,klev) |
792 |
|
|
real ztv(klon,klev) |
793 |
|
|
real po(klon,klev) |
794 |
|
|
real ztva(klon,klev) |
795 |
|
|
real zqla(klon,klev) |
796 |
|
|
real f_star(klon,klev) |
797 |
|
|
real zw2(klon,klev) |
798 |
|
|
integer long(klon) |
799 |
|
|
real seuil |
800 |
|
|
character*21 comment |
801 |
|
|
|
802 |
|
✗ |
if (prt_level.ge.1) THEN |
803 |
|
✗ |
print*,'WARNING !!! TEST ',comment |
804 |
|
|
endif |
805 |
|
|
return |
806 |
|
|
|
807 |
|
|
! test sur la hauteur des thermiques ... |
808 |
|
|
do i=1,klon |
809 |
|
|
!IMtemp if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then |
810 |
|
|
if (prt_level.ge.10) then |
811 |
|
|
print*,'WARNING ',comment,' au point ',i,' K= ',long(i) |
812 |
|
|
print*,' K P(MB) THV(K) Qenv(g/kg)THVA QLA(g/kg) F* W2' |
813 |
|
|
do k=1,klev |
814 |
|
|
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) |
815 |
|
|
enddo |
816 |
|
|
endif |
817 |
|
|
enddo |
818 |
|
|
|
819 |
|
|
|
820 |
|
|
return |
821 |
|
|
end |
822 |
|
|
|
823 |
|
|
!============================================================================== |
824 |
|
✗ |
SUBROUTINE thermcellV0_closure(ngrid,nlay,r_aspect,ptimestep,rho, & |
825 |
|
✗ |
& zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out) |
826 |
|
|
|
827 |
|
|
!------------------------------------------------------------------------- |
828 |
|
|
!thermcell_closure: fermeture, determination de f |
829 |
|
|
!------------------------------------------------------------------------- |
830 |
|
|
USE print_control_mod, ONLY: prt_level,lunout |
831 |
|
|
IMPLICIT NONE |
832 |
|
|
|
833 |
|
|
include "thermcell.h" |
834 |
|
|
INTEGER ngrid,nlay |
835 |
|
|
INTEGER ig,k |
836 |
|
|
REAL r_aspect,ptimestep |
837 |
|
|
integer lev_out ! niveau pour les print |
838 |
|
|
|
839 |
|
|
INTEGER lalim(ngrid) |
840 |
|
|
REAL alim_star(ngrid,nlay) |
841 |
|
|
REAL alim_star_tot(ngrid) |
842 |
|
|
REAL rho(ngrid,nlay) |
843 |
|
|
REAL zlev(ngrid,nlay) |
844 |
|
|
REAL zmax(ngrid),zmax_sec(ngrid) |
845 |
|
|
REAL wmax(ngrid),wmax_sec(ngrid) |
846 |
|
|
real zdenom |
847 |
|
|
|
848 |
|
✗ |
REAL alim_star2(ngrid) |
849 |
|
|
|
850 |
|
|
REAL f(ngrid) |
851 |
|
|
|
852 |
|
|
character (len=20) :: modname='thermcellV0_main' |
853 |
|
|
character (len=80) :: abort_message |
854 |
|
|
|
855 |
|
✗ |
do ig=1,ngrid |
856 |
|
✗ |
alim_star2(ig)=0. |
857 |
|
|
enddo |
858 |
|
✗ |
do ig=1,ngrid |
859 |
|
✗ |
if (alim_star(ig,1).LT.1.e-10) then |
860 |
|
✗ |
f(ig)=0. |
861 |
|
|
else |
862 |
|
✗ |
do k=1,lalim(ig) |
863 |
|
|
alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2 & |
864 |
|
✗ |
& /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))) |
865 |
|
|
enddo |
866 |
|
✗ |
zdenom=max(500.,zmax(ig))*r_aspect*alim_star2(ig) |
867 |
|
✗ |
if (zdenom<1.e-14) then |
868 |
|
✗ |
print*,'ig=',ig |
869 |
|
✗ |
print*,'alim_star2',alim_star2(ig) |
870 |
|
✗ |
print*,'zmax',zmax(ig) |
871 |
|
✗ |
print*,'r_aspect',r_aspect |
872 |
|
✗ |
print*,'zdenom',zdenom |
873 |
|
✗ |
print*,'alim_star',alim_star(ig,:) |
874 |
|
✗ |
print*,'zmax_sec',zmax_sec(ig) |
875 |
|
✗ |
print*,'wmax_sec',wmax_sec(ig) |
876 |
|
✗ |
abort_message = 'zdenom<1.e-14' |
877 |
|
✗ |
CALL abort_physic (modname,abort_message,1) |
878 |
|
|
endif |
879 |
|
✗ |
if ((zmax_sec(ig).gt.1.e-10).and.(iflag_thermals_ed.eq.0)) then |
880 |
|
|
f(ig)=wmax_sec(ig)*alim_star_tot(ig)/(max(500.,zmax_sec(ig))*r_aspect & |
881 |
|
✗ |
& *alim_star2(ig)) |
882 |
|
|
! f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/ & |
883 |
|
|
! & zmax_sec(ig))*wmax_sec(ig)) |
884 |
|
✗ |
if(prt_level.GE.10) write(lunout,*)'closure dry',f(ig),wmax_sec(ig),alim_star_tot(ig),zmax_sec(ig) |
885 |
|
|
else |
886 |
|
✗ |
f(ig)=wmax(ig)*alim_star_tot(ig)/zdenom |
887 |
|
|
! f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/ & |
888 |
|
|
! & zmax(ig))*wmax(ig)) |
889 |
|
✗ |
if(prt_level.GE.10) print*,'closure moist',f(ig),wmax(ig),alim_star_tot(ig),zmax(ig) |
890 |
|
|
endif |
891 |
|
|
endif |
892 |
|
|
! f0(ig)=f(ig) |
893 |
|
|
enddo |
894 |
|
✗ |
if (prt_level.ge.1) print*,'apres fermeture' |
895 |
|
|
|
896 |
|
|
! |
897 |
|
✗ |
return |
898 |
|
|
end |
899 |
|
|
!============================================================================== |
900 |
|
✗ |
SUBROUTINE thermcellV0_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz, & |
901 |
|
|
& zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot, & |
902 |
|
✗ |
& lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva, & |
903 |
|
✗ |
& ztla,zqla,zqta,zha,zw2,w_est,zqsatth,lmix,lmix_bis,linter & |
904 |
|
|
& ,lev_out,lunout1,igout) |
905 |
|
|
|
906 |
|
|
!-------------------------------------------------------------------------- |
907 |
|
|
!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance |
908 |
|
|
!-------------------------------------------------------------------------- |
909 |
|
|
|
910 |
|
|
USE print_control_mod, ONLY: prt_level |
911 |
|
|
IMPLICIT NONE |
912 |
|
|
|
913 |
|
|
include "YOMCST.h" |
914 |
|
|
include "YOETHF.h" |
915 |
|
|
include "FCTTRE.h" |
916 |
|
|
include "thermcell.h" |
917 |
|
|
|
918 |
|
|
INTEGER itap |
919 |
|
|
INTEGER lunout1,igout |
920 |
|
|
INTEGER ngrid,klev |
921 |
|
|
REAL ptimestep |
922 |
|
|
REAL ztv(ngrid,klev) |
923 |
|
|
REAL zthl(ngrid,klev) |
924 |
|
|
REAL po(ngrid,klev) |
925 |
|
|
REAL zl(ngrid,klev) |
926 |
|
|
REAL rhobarz(ngrid,klev) |
927 |
|
|
REAL zlev(ngrid,klev+1) |
928 |
|
|
REAL pplev(ngrid,klev+1) |
929 |
|
|
REAL pphi(ngrid,klev) |
930 |
|
|
REAL zpspsk(ngrid,klev) |
931 |
|
|
REAL alim_star(ngrid,klev) |
932 |
|
|
REAL zmax_sec(ngrid) |
933 |
|
|
REAL f0(ngrid) |
934 |
|
|
REAL l_mix |
935 |
|
|
REAL r_aspect |
936 |
|
|
INTEGER lalim(ngrid) |
937 |
|
|
integer lev_out ! niveau pour les print |
938 |
|
|
real zcon2(ngrid) |
939 |
|
|
|
940 |
|
|
real alim_star_tot(ngrid) |
941 |
|
|
|
942 |
|
|
REAL ztva(ngrid,klev) |
943 |
|
|
REAL ztla(ngrid,klev) |
944 |
|
|
REAL zqla(ngrid,klev) |
945 |
|
✗ |
REAL zqla0(ngrid,klev) |
946 |
|
|
REAL zqta(ngrid,klev) |
947 |
|
|
REAL zha(ngrid,klev) |
948 |
|
|
|
949 |
|
|
REAL detr_star(ngrid,klev) |
950 |
|
|
REAL coefc |
951 |
|
✗ |
REAL detr_stara(ngrid,klev) |
952 |
|
✗ |
REAL detr_starb(ngrid,klev) |
953 |
|
✗ |
REAL detr_starc(ngrid,klev) |
954 |
|
✗ |
REAL detr_star0(ngrid,klev) |
955 |
|
✗ |
REAL detr_star1(ngrid,klev) |
956 |
|
✗ |
REAL detr_star2(ngrid,klev) |
957 |
|
|
|
958 |
|
|
REAL entr_star(ngrid,klev) |
959 |
|
✗ |
REAL entr_star1(ngrid,klev) |
960 |
|
✗ |
REAL entr_star2(ngrid,klev) |
961 |
|
✗ |
REAL detr(ngrid,klev) |
962 |
|
✗ |
REAL entr(ngrid,klev) |
963 |
|
|
|
964 |
|
|
REAL zw2(ngrid,klev+1) |
965 |
|
|
REAL w_est(ngrid,klev+1) |
966 |
|
|
REAL f_star(ngrid,klev+1) |
967 |
|
✗ |
REAL wa_moy(ngrid,klev+1) |
968 |
|
|
|
969 |
|
✗ |
REAL ztva_est(ngrid,klev) |
970 |
|
✗ |
REAL zqla_est(ngrid,klev) |
971 |
|
|
REAL zqsatth(ngrid,klev) |
972 |
|
✗ |
REAL zta_est(ngrid,klev) |
973 |
|
|
|
974 |
|
|
REAL linter(ngrid) |
975 |
|
|
INTEGER lmix(ngrid) |
976 |
|
|
INTEGER lmix_bis(ngrid) |
977 |
|
✗ |
REAL wmaxa(ngrid) |
978 |
|
|
|
979 |
|
|
INTEGER ig,l,k |
980 |
|
|
|
981 |
|
|
real zcor,zdelta,zcvm5,qlbef |
982 |
|
|
real Tbef,qsatbef |
983 |
|
|
real dqsat_dT,DT,num,denom |
984 |
|
|
REAL REPS,RLvCp,DDT0 |
985 |
|
|
PARAMETER (DDT0=.01) |
986 |
|
|
logical Zsat |
987 |
|
|
REAL fact_gamma,fact_epsilon |
988 |
|
✗ |
REAL c2(ngrid,klev) |
989 |
|
|
|
990 |
|
|
Zsat=.false. |
991 |
|
|
! Initialisation |
992 |
|
✗ |
RLvCp = RLVTT/RCPD |
993 |
|
|
|
994 |
|
✗ |
if (iflag_thermals_ed==0) then |
995 |
|
|
fact_gamma=1. |
996 |
|
|
fact_epsilon=1. |
997 |
|
✗ |
else if (iflag_thermals_ed==1) then |
998 |
|
|
fact_gamma=1. |
999 |
|
|
fact_epsilon=1. |
1000 |
|
✗ |
else if (iflag_thermals_ed==2) then |
1001 |
|
|
fact_gamma=1. |
1002 |
|
|
fact_epsilon=2. |
1003 |
|
|
endif |
1004 |
|
|
|
1005 |
|
✗ |
do l=1,klev |
1006 |
|
✗ |
do ig=1,ngrid |
1007 |
|
✗ |
zqla_est(ig,l)=0. |
1008 |
|
✗ |
ztva_est(ig,l)=ztva(ig,l) |
1009 |
|
✗ |
zqsatth(ig,l)=0. |
1010 |
|
|
enddo |
1011 |
|
|
enddo |
1012 |
|
|
|
1013 |
|
|
!CR: attention test couche alim |
1014 |
|
|
! do l=2,klev |
1015 |
|
|
! do ig=1,ngrid |
1016 |
|
|
! alim_star(ig,l)=0. |
1017 |
|
|
! enddo |
1018 |
|
|
! enddo |
1019 |
|
|
!AM:initialisations du thermique |
1020 |
|
✗ |
do k=1,klev |
1021 |
|
✗ |
do ig=1,ngrid |
1022 |
|
✗ |
ztva(ig,k)=ztv(ig,k) |
1023 |
|
✗ |
ztla(ig,k)=zthl(ig,k) |
1024 |
|
✗ |
zqla(ig,k)=0. |
1025 |
|
✗ |
zqta(ig,k)=po(ig,k) |
1026 |
|
|
! |
1027 |
|
✗ |
ztva(ig,k) = ztla(ig,k)*zpspsk(ig,k)+RLvCp*zqla(ig,k) |
1028 |
|
✗ |
ztva(ig,k) = ztva(ig,k)/zpspsk(ig,k) |
1029 |
|
✗ |
zha(ig,k) = ztva(ig,k) |
1030 |
|
|
! |
1031 |
|
|
enddo |
1032 |
|
|
enddo |
1033 |
|
✗ |
do k=1,klev |
1034 |
|
✗ |
do ig=1,ngrid |
1035 |
|
✗ |
detr_star(ig,k)=0. |
1036 |
|
✗ |
entr_star(ig,k)=0. |
1037 |
|
|
|
1038 |
|
✗ |
detr_stara(ig,k)=0. |
1039 |
|
✗ |
detr_starb(ig,k)=0. |
1040 |
|
✗ |
detr_starc(ig,k)=0. |
1041 |
|
✗ |
detr_star0(ig,k)=0. |
1042 |
|
✗ |
zqla0(ig,k)=0. |
1043 |
|
✗ |
detr_star1(ig,k)=0. |
1044 |
|
✗ |
detr_star2(ig,k)=0. |
1045 |
|
✗ |
entr_star1(ig,k)=0. |
1046 |
|
✗ |
entr_star2(ig,k)=0. |
1047 |
|
|
|
1048 |
|
✗ |
detr(ig,k)=0. |
1049 |
|
✗ |
entr(ig,k)=0. |
1050 |
|
|
enddo |
1051 |
|
|
enddo |
1052 |
|
✗ |
if (prt_level.ge.1) print*,'7 OK convect8' |
1053 |
|
✗ |
do k=1,klev+1 |
1054 |
|
✗ |
do ig=1,ngrid |
1055 |
|
✗ |
zw2(ig,k)=0. |
1056 |
|
✗ |
w_est(ig,k)=0. |
1057 |
|
✗ |
f_star(ig,k)=0. |
1058 |
|
✗ |
wa_moy(ig,k)=0. |
1059 |
|
|
enddo |
1060 |
|
|
enddo |
1061 |
|
|
|
1062 |
|
✗ |
if (prt_level.ge.1) print*,'8 OK convect8' |
1063 |
|
✗ |
do ig=1,ngrid |
1064 |
|
✗ |
linter(ig)=1. |
1065 |
|
✗ |
lmix(ig)=1 |
1066 |
|
✗ |
lmix_bis(ig)=2 |
1067 |
|
✗ |
wmaxa(ig)=0. |
1068 |
|
|
enddo |
1069 |
|
|
|
1070 |
|
|
!----------------------------------------------------------------------------------- |
1071 |
|
|
!boucle de calcul de la vitesse verticale dans le thermique |
1072 |
|
|
!----------------------------------------------------------------------------------- |
1073 |
|
✗ |
do l=1,klev-1 |
1074 |
|
✗ |
do ig=1,ngrid |
1075 |
|
|
|
1076 |
|
|
|
1077 |
|
|
|
1078 |
|
|
! Calcul dans la premiere couche active du thermique (ce qu'on teste |
1079 |
|
|
! en disant que la couche est instable et que w2 en bas de la couche |
1080 |
|
|
! est nulle. |
1081 |
|
|
|
1082 |
|
|
if (ztv(ig,l).gt.ztv(ig,l+1) & |
1083 |
|
|
& .and.alim_star(ig,l).gt.1.e-10 & |
1084 |
|
✗ |
& .and.zw2(ig,l).lt.1e-10) then |
1085 |
|
|
|
1086 |
|
|
|
1087 |
|
|
! Le panache va prendre au debut les caracteristiques de l'air contenu |
1088 |
|
|
! dans cette couche. |
1089 |
|
✗ |
ztla(ig,l)=zthl(ig,l) |
1090 |
|
✗ |
zqta(ig,l)=po(ig,l) |
1091 |
|
✗ |
zqla(ig,l)=zl(ig,l) |
1092 |
|
✗ |
f_star(ig,l+1)=alim_star(ig,l) |
1093 |
|
|
|
1094 |
|
|
zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1) & |
1095 |
|
|
& *(zlev(ig,l+1)-zlev(ig,l)) & |
1096 |
|
✗ |
& *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l)) |
1097 |
|
✗ |
w_est(ig,l+1)=zw2(ig,l+1) |
1098 |
|
|
! |
1099 |
|
|
|
1100 |
|
|
|
1101 |
|
✗ |
else if ((zw2(ig,l).ge.1e-10).and. & |
1102 |
|
|
& (f_star(ig,l)+alim_star(ig,l)).gt.1.e-10) then |
1103 |
|
|
!estimation du detrainement a partir de la geometrie du pas precedent |
1104 |
|
|
!tests sur la definition du detr |
1105 |
|
|
!calcul de detr_star et entr_star |
1106 |
|
|
|
1107 |
|
|
|
1108 |
|
|
|
1109 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1110 |
|
|
! FH le test miraculeux de Catherine ? Le bout du tunel ? |
1111 |
|
|
! w_est(ig,3)=zw2(ig,2)* & |
1112 |
|
|
! & ((f_star(ig,2))**2) & |
1113 |
|
|
! & /(f_star(ig,2)+alim_star(ig,2))**2+ & |
1114 |
|
|
! & 2.*RG*(ztva(ig,1)-ztv(ig,2))/ztv(ig,2) & |
1115 |
|
|
! & *(zlev(ig,3)-zlev(ig,2)) |
1116 |
|
|
! if (l.gt.2) then |
1117 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1118 |
|
|
|
1119 |
|
|
|
1120 |
|
|
|
1121 |
|
|
! Premier calcul de la vitesse verticale a partir de la temperature |
1122 |
|
|
! potentielle virtuelle |
1123 |
|
|
|
1124 |
|
|
! FH CESTQUOI CA ???? |
1125 |
|
|
!#undef |
1126 |
|
✗ |
if (l.ge.2) then |
1127 |
|
|
|
1128 |
|
|
if (1.eq.1) then |
1129 |
|
|
w_est(ig,3)=zw2(ig,2)* & |
1130 |
|
|
& ((f_star(ig,2))**2) & |
1131 |
|
|
& /(f_star(ig,2)+alim_star(ig,2))**2+ & |
1132 |
|
|
& 2.*RG*(ztva(ig,2)-ztv(ig,2))/ztv(ig,2) & |
1133 |
|
|
! & *1./3. & |
1134 |
|
✗ |
& *(zlev(ig,3)-zlev(ig,2)) |
1135 |
|
|
endif |
1136 |
|
|
|
1137 |
|
|
|
1138 |
|
|
!--------------------------------------------------------------------------- |
1139 |
|
|
!calcul de l entrainement et du detrainement lateral |
1140 |
|
|
!--------------------------------------------------------------------------- |
1141 |
|
|
! |
1142 |
|
|
!test:estimation de ztva_new_est sans entrainement |
1143 |
|
|
|
1144 |
|
✗ |
Tbef=ztla(ig,l-1)*zpspsk(ig,l) |
1145 |
|
✗ |
zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) |
1146 |
|
✗ |
qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) |
1147 |
|
✗ |
qsatbef=MIN(0.5,qsatbef) |
1148 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
1149 |
|
✗ |
qsatbef=qsatbef*zcor |
1150 |
|
✗ |
Zsat = (max(0.,zqta(ig,l-1)-qsatbef) .gt. 1.e-10) |
1151 |
|
✗ |
if (Zsat) then |
1152 |
|
|
qlbef=max(0.,zqta(ig,l-1)-qsatbef) |
1153 |
|
✗ |
DT = 0.5*RLvCp*qlbef |
1154 |
|
✗ |
do while (abs(DT).gt.DDT0) |
1155 |
|
✗ |
Tbef=Tbef+DT |
1156 |
|
✗ |
zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) |
1157 |
|
✗ |
qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) |
1158 |
|
✗ |
qsatbef=MIN(0.5,qsatbef) |
1159 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
1160 |
|
✗ |
qsatbef=qsatbef*zcor |
1161 |
|
✗ |
qlbef=zqta(ig,l-1)-qsatbef |
1162 |
|
|
|
1163 |
|
|
zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) |
1164 |
|
✗ |
zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta |
1165 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
1166 |
|
✗ |
dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor) |
1167 |
|
✗ |
num=-Tbef+ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*qlbef |
1168 |
|
✗ |
denom=1.+RLvCp*dqsat_dT |
1169 |
|
✗ |
DT=num/denom |
1170 |
|
|
enddo |
1171 |
|
✗ |
zqla_est(ig,l) = max(0.,zqta(ig,l-1)-qsatbef) |
1172 |
|
|
endif |
1173 |
|
✗ |
ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l) |
1174 |
|
✗ |
ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l) |
1175 |
|
✗ |
zta_est(ig,l)=ztva_est(ig,l) |
1176 |
|
|
ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1) & |
1177 |
|
✗ |
& -zqla_est(ig,l))-zqla_est(ig,l)) |
1178 |
|
|
|
1179 |
|
|
w_est(ig,l+1)=zw2(ig,l)* & |
1180 |
|
|
& ((f_star(ig,l))**2) & |
1181 |
|
|
& /(f_star(ig,l)+alim_star(ig,l))**2+ & |
1182 |
|
|
& 2.*RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1183 |
|
|
! & *1./3. & |
1184 |
|
✗ |
& *(zlev(ig,l+1)-zlev(ig,l)) |
1185 |
|
✗ |
if (w_est(ig,l+1).lt.0.) then |
1186 |
|
✗ |
w_est(ig,l+1)=zw2(ig,l) |
1187 |
|
|
endif |
1188 |
|
|
! |
1189 |
|
|
!calcul du detrainement |
1190 |
|
|
!======================= |
1191 |
|
|
|
1192 |
|
|
!CR:on vire les modifs |
1193 |
|
✗ |
if (iflag_thermals_ed==0) then |
1194 |
|
|
|
1195 |
|
|
! Modifications du calcul du detrainement. |
1196 |
|
|
! Dans la version de la these de Catherine, on passe brusquement |
1197 |
|
|
! de la version seche a la version nuageuse pour le detrainement |
1198 |
|
|
! ce qui peut occasioner des oscillations. |
1199 |
|
|
! dans la nouvelle version, on commence par calculer un detrainement sec. |
1200 |
|
|
! Puis un autre en cas de nuages. |
1201 |
|
|
! Puis on combine les deux lineairement en fonction de la quantite d'eau. |
1202 |
|
|
|
1203 |
|
|
!#undef |
1204 |
|
|
!1. Cas non nuageux |
1205 |
|
|
! 1.1 on est sous le zmax_sec et w croit |
1206 |
|
|
if ((w_est(ig,l+1).gt.w_est(ig,l)).and. & |
1207 |
|
✗ |
& (zlev(ig,l+1).lt.zmax_sec(ig)).and. & |
1208 |
|
|
& (zqla_est(ig,l).lt.1.e-10)) then |
1209 |
|
|
detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1) & |
1210 |
|
|
& *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1)) & |
1211 |
|
|
& -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l))) & |
1212 |
|
✗ |
& /(r_aspect*zmax_sec(ig))) |
1213 |
|
✗ |
detr_stara(ig,l)=detr_star(ig,l) |
1214 |
|
|
|
1215 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l',ig,l |
1216 |
|
|
|
1217 |
|
|
! 1.2 on est sous le zmax_sec et w decroit |
1218 |
|
✗ |
else if ((zlev(ig,l+1).lt.zmax_sec(ig)).and. & |
1219 |
|
|
& (zqla_est(ig,l).lt.1.e-10)) then |
1220 |
|
|
detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig)) & |
1221 |
|
|
& /(rhobarz(ig,lmix(ig))*wmaxa(ig))* & |
1222 |
|
|
& (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1)) & |
1223 |
|
|
& *((zmax_sec(ig)-zlev(ig,l+1))/ & |
1224 |
|
|
& ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2. & |
1225 |
|
|
& -rhobarz(ig,l)*sqrt(w_est(ig,l)) & |
1226 |
|
|
& *((zmax_sec(ig)-zlev(ig,l))/ & |
1227 |
|
✗ |
& ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.) |
1228 |
|
✗ |
detr_starb(ig,l)=detr_star(ig,l) |
1229 |
|
|
|
1230 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l',ig,l |
1231 |
|
|
|
1232 |
|
|
else |
1233 |
|
|
|
1234 |
|
|
! 1.3 dans les autres cas |
1235 |
|
|
detr_star(ig,l)=0.002*f0(ig)*f_star(ig,l) & |
1236 |
|
✗ |
& *(zlev(ig,l+1)-zlev(ig,l)) |
1237 |
|
✗ |
detr_starc(ig,l)=detr_star(ig,l) |
1238 |
|
|
|
1239 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 3 n: ig, l',ig, l |
1240 |
|
|
|
1241 |
|
|
endif |
1242 |
|
|
|
1243 |
|
|
|
1244 |
|
|
|
1245 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 444: ig, l', ig, l |
1246 |
|
|
!IM 730508 beg |
1247 |
|
|
! if(itap.GE.7200) THEN |
1248 |
|
|
! print*,'th_plume ig,l,itap,zqla_est=',ig,l,itap,zqla_est(ig,l) |
1249 |
|
|
! endif |
1250 |
|
|
!IM 730508 end |
1251 |
|
|
|
1252 |
|
✗ |
zqla0(ig,l)=zqla_est(ig,l) |
1253 |
|
✗ |
detr_star0(ig,l)=detr_star(ig,l) |
1254 |
|
|
!IM 060508 beg |
1255 |
|
|
! if(detr_star(ig,l).GT.1.) THEN |
1256 |
|
|
! print*,'th_plumeBEF ig l detr_star detr_starc coefc',ig,l,detr_star(ig,l) & |
1257 |
|
|
! & ,detr_starc(ig,l),coefc |
1258 |
|
|
! endif |
1259 |
|
|
!IM 060508 end |
1260 |
|
|
!IM 160508 beg |
1261 |
|
|
!IM 160508 IF (f0(ig).NE.0.) THEN |
1262 |
|
✗ |
detr_star(ig,l)=detr_star(ig,l)/f0(ig) |
1263 |
|
|
!IM 160508 ELSE IF(detr_star(ig,l).EQ.0.) THEN |
1264 |
|
|
!IM 160508 print*,'WARNING1 : th_plume f0=0, detr_star=0: ig, l, itap',ig,l,itap |
1265 |
|
|
!IM 160508 ELSE |
1266 |
|
|
!IM 160508 print*,'WARNING2 : th_plume f0=0, ig, l, itap, detr_star',ig,l,itap,detr_star(ig,l) |
1267 |
|
|
!IM 160508 ENDIF |
1268 |
|
|
!IM 160508 end |
1269 |
|
|
!IM 060508 beg |
1270 |
|
|
! if(detr_star(ig,l).GT.1.) THEN |
1271 |
|
|
! print*,'th_plumeAFT ig l detr_star f0 1/f0',ig,l,detr_star(ig,l),f0(ig), & |
1272 |
|
|
! & REAL(1)/f0(ig) |
1273 |
|
|
! endif |
1274 |
|
|
!IM 060508 end |
1275 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 445: ig, l', ig, l |
1276 |
|
|
! |
1277 |
|
|
!calcul de entr_star |
1278 |
|
|
|
1279 |
|
|
! #undef test2 |
1280 |
|
|
! #ifdef test2 |
1281 |
|
|
! La version test2 destabilise beaucoup le modele. |
1282 |
|
|
! Il semble donc que ca aide d'avoir un entrainement important sous |
1283 |
|
|
! le nuage. |
1284 |
|
|
! if (zqla_est(ig,l-1).ge.1.e-10.and.l.gt.lalim(ig)) then |
1285 |
|
|
! entr_star(ig,l)=0.4*detr_star(ig,l) |
1286 |
|
|
! else |
1287 |
|
|
! entr_star(ig,l)=0. |
1288 |
|
|
! endif |
1289 |
|
|
! #else |
1290 |
|
|
! |
1291 |
|
|
! Deplacement du calcul de entr_star pour eviter d'avoir aussi |
1292 |
|
|
! entr_star > fstar. |
1293 |
|
|
! Redeplacer suite a la transformation du cas detr>f |
1294 |
|
|
! FH |
1295 |
|
|
|
1296 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 446: ig, l', ig, l |
1297 |
|
|
!FH 070508 #define int1d4 |
1298 |
|
|
!#undef int1d4 |
1299 |
|
|
! L'option int1d4 correspond au choix dans le cas ou le detrainement |
1300 |
|
|
! devient trop grand. |
1301 |
|
|
|
1302 |
|
|
|
1303 |
|
✗ |
detr_star(ig,l)=min(detr_star(ig,l),f_star(ig,l)) |
1304 |
|
|
!FH 070508 plus |
1305 |
|
✗ |
detr_star(ig,l)=min(detr_star(ig,l),1.) |
1306 |
|
|
|
1307 |
|
✗ |
entr_star(ig,l)=max(0.4*detr_star(ig,l)-alim_star(ig,l),0.) |
1308 |
|
|
|
1309 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 447: ig, l', ig, l |
1310 |
|
|
|
1311 |
|
|
|
1312 |
|
|
|
1313 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 440: ig, l', ig, l |
1314 |
|
✗ |
entr_star1(ig,l)=entr_star(ig,l) |
1315 |
|
✗ |
detr_star1(ig,l)=detr_star(ig,l) |
1316 |
|
|
! |
1317 |
|
|
|
1318 |
|
|
|
1319 |
|
|
else !l > 2 |
1320 |
|
✗ |
detr_star(ig,l)=0. |
1321 |
|
✗ |
entr_star(ig,l)=0. |
1322 |
|
|
endif |
1323 |
|
|
|
1324 |
|
✗ |
entr_star2(ig,l)=entr_star(ig,l) |
1325 |
|
✗ |
detr_star2(ig,l)=detr_star(ig,l) |
1326 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 450: ig, l', ig, l |
1327 |
|
|
|
1328 |
|
|
endif ! iflag_thermals_ed==0 |
1329 |
|
|
|
1330 |
|
|
!CR:nvlle def de entr_star et detr_star |
1331 |
|
✗ |
if (iflag_thermals_ed>=1) then |
1332 |
|
|
! if (l.lt.lalim(ig)) then |
1333 |
|
|
! if (l.lt.2) then |
1334 |
|
|
! entr_star(ig,l)=0. |
1335 |
|
|
! detr_star(ig,l)=0. |
1336 |
|
|
! else |
1337 |
|
|
! if (0.001.gt.(RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))/(2.*w_est(ig,l+1)))) then |
1338 |
|
|
! entr_star(ig,l)=0.001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) |
1339 |
|
|
! else |
1340 |
|
|
! entr_star(ig,l)= & |
1341 |
|
|
! & f_star(ig,l)/(2.*w_est(ig,l+1)) & |
1342 |
|
|
! & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)) & |
1343 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) |
1344 |
|
|
|
1345 |
|
|
|
1346 |
|
|
entr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)), & |
1347 |
|
|
& f_star(ig,l)/(2.*w_est(ig,l+1)) & |
1348 |
|
|
& *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1349 |
|
|
& *(zlev(ig,l+1)-zlev(ig,l))) & |
1350 |
|
✗ |
& +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) |
1351 |
|
|
|
1352 |
|
✗ |
if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then |
1353 |
|
✗ |
alim_star_tot(ig)=alim_star_tot(ig)+entr_star(ig,l) |
1354 |
|
✗ |
lalim(ig)=lmix_bis(ig) |
1355 |
|
✗ |
if(prt_level.GE.10) print*,'alim_star_tot',alim_star_tot(ig),entr_star(ig,l) |
1356 |
|
|
endif |
1357 |
|
|
|
1358 |
|
✗ |
if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then |
1359 |
|
|
! c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l)) |
1360 |
|
✗ |
c2(ig,l)=0.001 |
1361 |
|
|
detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)), & |
1362 |
|
|
& c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) & |
1363 |
|
|
& -f_star(ig,l)/(2.*w_est(ig,l+1)) & |
1364 |
|
|
& *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1365 |
|
|
& *(zlev(ig,l+1)-zlev(ig,l))) & |
1366 |
|
✗ |
& +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) |
1367 |
|
|
|
1368 |
|
|
else |
1369 |
|
|
! c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l)) |
1370 |
|
✗ |
c2(ig,l)=0.003 |
1371 |
|
|
|
1372 |
|
|
detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)), & |
1373 |
|
|
& c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) & |
1374 |
|
|
& -f_star(ig,l)/(2.*w_est(ig,l+1)) & |
1375 |
|
|
& *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1376 |
|
|
& *(zlev(ig,l+1)-zlev(ig,l))) & |
1377 |
|
✗ |
& +0.0002*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) |
1378 |
|
|
endif |
1379 |
|
|
|
1380 |
|
|
|
1381 |
|
|
! detr_star(ig,l)=detr_star(ig,l)*3. |
1382 |
|
|
! if (l.lt.lalim(ig)) then |
1383 |
|
|
! entr_star(ig,l)=0. |
1384 |
|
|
! endif |
1385 |
|
|
! if (l.lt.2) then |
1386 |
|
|
! entr_star(ig,l)=0. |
1387 |
|
|
! detr_star(ig,l)=0. |
1388 |
|
|
! endif |
1389 |
|
|
|
1390 |
|
|
|
1391 |
|
|
! endif |
1392 |
|
|
! else if ((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10) then |
1393 |
|
|
! entr_star(ig,l)=MAX(0.,0.8*f_star(ig,l)/(2.*w_est(ig,l+1)) & |
1394 |
|
|
! & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)) & |
1395 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) |
1396 |
|
|
! detr_star(ig,l)=0.002*f_star(ig,l) & |
1397 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) |
1398 |
|
|
! else |
1399 |
|
|
! entr_star(ig,l)=0.001*f_star(ig,l) & |
1400 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) |
1401 |
|
|
! detr_star(ig,l)=MAX(0.,-0.2*f_star(ig,l)/(2.*w_est(ig,l+1)) & |
1402 |
|
|
! & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)) & |
1403 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) & |
1404 |
|
|
! & +0.002*f_star(ig,l) & |
1405 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) |
1406 |
|
|
! endif |
1407 |
|
|
|
1408 |
|
|
endif ! iflag_thermals_ed==1 |
1409 |
|
|
|
1410 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1411 |
|
|
! FH inutile si on conserve comme on l'a fait plus haut entr=detr |
1412 |
|
|
! dans la couche d'alimentation |
1413 |
|
|
!pas d entrainement dans la couche alim |
1414 |
|
|
! if ((l.le.lalim(ig))) then |
1415 |
|
|
! entr_star(ig,l)=0. |
1416 |
|
|
! endif |
1417 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1418 |
|
|
! |
1419 |
|
|
!prise en compte du detrainement et de l entrainement dans le calcul du flux |
1420 |
|
|
|
1421 |
|
|
f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l) & |
1422 |
|
✗ |
& -detr_star(ig,l) |
1423 |
|
|
|
1424 |
|
|
!test sur le signe de f_star |
1425 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 451: ig, l', ig, l |
1426 |
|
✗ |
if (f_star(ig,l+1).gt.1.e-10) then |
1427 |
|
|
!---------------------------------------------------------------------------- |
1428 |
|
|
!calcul de la vitesse verticale en melangeant Tl et qt du thermique |
1429 |
|
|
!--------------------------------------------------------------------------- |
1430 |
|
|
! |
1431 |
|
|
Zsat=.false. |
1432 |
|
|
ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+ & |
1433 |
|
|
& (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l)) & |
1434 |
|
✗ |
& /(f_star(ig,l+1)+detr_star(ig,l)) |
1435 |
|
|
! |
1436 |
|
|
zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+ & |
1437 |
|
|
& (alim_star(ig,l)+entr_star(ig,l))*po(ig,l)) & |
1438 |
|
✗ |
& /(f_star(ig,l+1)+detr_star(ig,l)) |
1439 |
|
|
! |
1440 |
|
✗ |
Tbef=ztla(ig,l)*zpspsk(ig,l) |
1441 |
|
✗ |
zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) |
1442 |
|
✗ |
qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) |
1443 |
|
✗ |
qsatbef=MIN(0.5,qsatbef) |
1444 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
1445 |
|
✗ |
qsatbef=qsatbef*zcor |
1446 |
|
✗ |
Zsat = (max(0.,zqta(ig,l)-qsatbef) .gt. 1.e-10) |
1447 |
|
✗ |
if (Zsat) then |
1448 |
|
|
qlbef=max(0.,zqta(ig,l)-qsatbef) |
1449 |
|
✗ |
DT = 0.5*RLvCp*qlbef |
1450 |
|
✗ |
do while (abs(DT).gt.DDT0) |
1451 |
|
✗ |
Tbef=Tbef+DT |
1452 |
|
✗ |
zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) |
1453 |
|
✗ |
qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) |
1454 |
|
✗ |
qsatbef=MIN(0.5,qsatbef) |
1455 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
1456 |
|
✗ |
qsatbef=qsatbef*zcor |
1457 |
|
✗ |
qlbef=zqta(ig,l)-qsatbef |
1458 |
|
|
|
1459 |
|
|
zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) |
1460 |
|
✗ |
zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta |
1461 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
1462 |
|
✗ |
dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor) |
1463 |
|
✗ |
num=-Tbef+ztla(ig,l)*zpspsk(ig,l)+RLvCp*qlbef |
1464 |
|
✗ |
denom=1.+RLvCp*dqsat_dT |
1465 |
|
✗ |
DT=num/denom |
1466 |
|
|
enddo |
1467 |
|
✗ |
zqla(ig,l) = max(0.,qlbef) |
1468 |
|
|
endif |
1469 |
|
|
! |
1470 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 4512: ig, l', ig, l |
1471 |
|
|
! on ecrit de maniere conservative (sat ou non) |
1472 |
|
|
! T = Tl +Lv/Cp ql |
1473 |
|
✗ |
ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l) |
1474 |
|
✗ |
ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l) |
1475 |
|
|
!on rajoute le calcul de zha pour diagnostiques (temp potentielle) |
1476 |
|
✗ |
zha(ig,l) = ztva(ig,l) |
1477 |
|
|
ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l) & |
1478 |
|
✗ |
& -zqla(ig,l))-zqla(ig,l)) |
1479 |
|
|
|
1480 |
|
|
!on ecrit zqsat |
1481 |
|
✗ |
zqsatth(ig,l)=qsatbef |
1482 |
|
|
!calcul de vitesse |
1483 |
|
|
zw2(ig,l+1)=zw2(ig,l)* & |
1484 |
|
|
& ((f_star(ig,l))**2) & |
1485 |
|
|
! Tests de Catherine |
1486 |
|
|
! & /(f_star(ig,l+1)+detr_star(ig,l))**2+ & |
1487 |
|
|
& /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-fact_epsilon))**2+ & |
1488 |
|
|
& 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1489 |
|
|
& *fact_gamma & |
1490 |
|
✗ |
& *(zlev(ig,l+1)-zlev(ig,l)) |
1491 |
|
|
!prise en compte des forces de pression que qd flottabilit�<0 |
1492 |
|
|
! zw2(ig,l+1)=zw2(ig,l)* & |
1493 |
|
|
! & 1./(1.+2.*entr_star(ig,l)/f_star(ig,l)) + & |
1494 |
|
|
! & (f_star(ig,l))**2 & |
1495 |
|
|
! & /(f_star(ig,l)+entr_star(ig,l))**2+ & |
1496 |
|
|
! & (f_star(ig,l)-2.*entr_star(ig,l))**2/(f_star(ig,l)+2.*entr_star(ig,l))**2+ & |
1497 |
|
|
! & /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-2.))**2+ & |
1498 |
|
|
! & /(f_star(ig,l)**2+2.*2.*detr_star(ig,l)*f_star(ig,l)+2.*entr_star(ig,l)*f_star(ig,l))+ & |
1499 |
|
|
! & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1500 |
|
|
! & *1./3. & |
1501 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) |
1502 |
|
|
|
1503 |
|
|
! write(30,*),l+1,zw2(ig,l+1)-zw2(ig,l), & |
1504 |
|
|
! & -2.*entr_star(ig,l)/f_star(ig,l)*zw2(ig,l), & |
1505 |
|
|
! & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) |
1506 |
|
|
|
1507 |
|
|
|
1508 |
|
|
! zw2(ig,l+1)=zw2(ig,l)* & |
1509 |
|
|
! & (2.-2.*entr_star(ig,l)/f_star(ig,l)) & |
1510 |
|
|
! & -zw2(ig,l-1)+ & |
1511 |
|
|
! & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1512 |
|
|
! & *1./3. & |
1513 |
|
|
! & *(zlev(ig,l+1)-zlev(ig,l)) |
1514 |
|
|
|
1515 |
|
|
endif |
1516 |
|
|
endif |
1517 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l |
1518 |
|
|
! |
1519 |
|
|
!initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max |
1520 |
|
|
|
1521 |
|
✗ |
if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then |
1522 |
|
✗ |
print*,'On tombe sur le cas particulier de thermcell_plume' |
1523 |
|
✗ |
zw2(ig,l+1)=0. |
1524 |
|
✗ |
linter(ig)=l+1 |
1525 |
|
|
endif |
1526 |
|
|
|
1527 |
|
|
! if ((zw2(ig,l).gt.0.).and. (zw2(ig,l+1).le.0.)) then |
1528 |
|
✗ |
if (zw2(ig,l+1).lt.0.) then |
1529 |
|
|
linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l)) & |
1530 |
|
✗ |
& -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l)) |
1531 |
|
✗ |
zw2(ig,l+1)=0. |
1532 |
|
|
endif |
1533 |
|
|
|
1534 |
|
✗ |
wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) |
1535 |
|
|
|
1536 |
|
✗ |
if (wa_moy(ig,l+1).gt.wmaxa(ig)) then |
1537 |
|
|
! lmix est le niveau de la couche ou w (wa_moy) est maximum |
1538 |
|
|
!on rajoute le calcul de lmix_bis |
1539 |
|
✗ |
if (zqla(ig,l).lt.1.e-10) then |
1540 |
|
✗ |
lmix_bis(ig)=l+1 |
1541 |
|
|
endif |
1542 |
|
✗ |
lmix(ig)=l+1 |
1543 |
|
✗ |
wmaxa(ig)=wa_moy(ig,l+1) |
1544 |
|
|
endif |
1545 |
|
|
enddo |
1546 |
|
|
enddo |
1547 |
|
|
|
1548 |
|
|
!on remplace a* par e* ds premiere couche |
1549 |
|
|
! if (iflag_thermals_ed.ge.1) then |
1550 |
|
|
! do ig=1,ngrid |
1551 |
|
|
! do l=2,klev |
1552 |
|
|
! if (l.lt.lalim(ig)) then |
1553 |
|
|
! alim_star(ig,l)=entr_star(ig,l) |
1554 |
|
|
! endif |
1555 |
|
|
! enddo |
1556 |
|
|
! enddo |
1557 |
|
|
! do ig=1,ngrid |
1558 |
|
|
! lalim(ig)=lmix_bis(ig) |
1559 |
|
|
! enddo |
1560 |
|
|
! endif |
1561 |
|
✗ |
if (iflag_thermals_ed.ge.1) then |
1562 |
|
✗ |
do ig=1,ngrid |
1563 |
|
✗ |
do l=2,lalim(ig) |
1564 |
|
✗ |
alim_star(ig,l)=entr_star(ig,l) |
1565 |
|
✗ |
entr_star(ig,l)=0. |
1566 |
|
|
enddo |
1567 |
|
|
enddo |
1568 |
|
|
endif |
1569 |
|
✗ |
if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l |
1570 |
|
|
|
1571 |
|
|
! print*,'thermcell_plume OK' |
1572 |
|
|
|
1573 |
|
✗ |
return |
1574 |
|
|
end |
1575 |
|
|
!============================================================================== |
1576 |
|
✗ |
SUBROUTINE thermcellV0_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, & |
1577 |
|
✗ |
& lalim,lmin,zmax,wmax,lev_out) |
1578 |
|
|
|
1579 |
|
|
!-------------------------------------------------------------------------- |
1580 |
|
|
!thermcell_dry: calcul de zmax et wmax du thermique sec |
1581 |
|
|
!-------------------------------------------------------------------------- |
1582 |
|
|
USE print_control_mod, ONLY: prt_level |
1583 |
|
|
IMPLICIT NONE |
1584 |
|
|
include "YOMCST.h" |
1585 |
|
|
INTEGER l,ig |
1586 |
|
|
|
1587 |
|
|
INTEGER ngrid,nlay |
1588 |
|
|
REAL zlev(ngrid,nlay+1) |
1589 |
|
|
REAL pphi(ngrid,nlay) |
1590 |
|
|
REAl ztv(ngrid,nlay) |
1591 |
|
|
REAL alim_star(ngrid,nlay) |
1592 |
|
|
INTEGER lalim(ngrid) |
1593 |
|
|
integer lev_out ! niveau pour les print |
1594 |
|
|
|
1595 |
|
|
REAL zmax(ngrid) |
1596 |
|
|
REAL wmax(ngrid) |
1597 |
|
|
|
1598 |
|
|
!variables locales |
1599 |
|
✗ |
REAL zw2(ngrid,nlay+1) |
1600 |
|
✗ |
REAL f_star(ngrid,nlay+1) |
1601 |
|
✗ |
REAL ztva(ngrid,nlay+1) |
1602 |
|
✗ |
REAL wmaxa(ngrid) |
1603 |
|
✗ |
REAL wa_moy(ngrid,nlay+1) |
1604 |
|
✗ |
REAL linter(ngrid),zlevinter(ngrid) |
1605 |
|
✗ |
INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid) |
1606 |
|
|
|
1607 |
|
|
!initialisations |
1608 |
|
✗ |
do ig=1,ngrid |
1609 |
|
✗ |
do l=1,nlay+1 |
1610 |
|
✗ |
zw2(ig,l)=0. |
1611 |
|
✗ |
wa_moy(ig,l)=0. |
1612 |
|
|
enddo |
1613 |
|
|
enddo |
1614 |
|
✗ |
do ig=1,ngrid |
1615 |
|
✗ |
do l=1,nlay |
1616 |
|
✗ |
ztva(ig,l)=ztv(ig,l) |
1617 |
|
|
enddo |
1618 |
|
|
enddo |
1619 |
|
✗ |
do ig=1,ngrid |
1620 |
|
✗ |
wmax(ig)=0. |
1621 |
|
✗ |
wmaxa(ig)=0. |
1622 |
|
|
enddo |
1623 |
|
|
!calcul de la vitesse a partir de la CAPE en melangeant thetav |
1624 |
|
|
|
1625 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1626 |
|
|
! A eliminer |
1627 |
|
|
! Ce if complique etait fait pour reperer la premiere couche instable |
1628 |
|
|
! Ici, c'est lmin. |
1629 |
|
|
! |
1630 |
|
|
! do l=1,nlay-2 |
1631 |
|
|
! do ig=1,ngrid |
1632 |
|
|
! if (ztv(ig,l).gt.ztv(ig,l+1) & |
1633 |
|
|
! & .and.alim_star(ig,l).gt.1.e-10 & |
1634 |
|
|
! & .and.zw2(ig,l).lt.1e-10) then |
1635 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1636 |
|
|
|
1637 |
|
|
|
1638 |
|
|
! Calcul des F^*, integrale verticale de E^* |
1639 |
|
✗ |
f_star(:,1)=0. |
1640 |
|
✗ |
do l=1,nlay |
1641 |
|
✗ |
f_star(:,l+1)=f_star(:,l)+alim_star(:,l) |
1642 |
|
|
enddo |
1643 |
|
|
|
1644 |
|
|
! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise |
1645 |
|
✗ |
linter(:)=0. |
1646 |
|
|
|
1647 |
|
|
! couche la plus haute concernee par le thermique. |
1648 |
|
✗ |
lmax(:)=1 |
1649 |
|
|
|
1650 |
|
|
! Le niveau linter est une variable continue qui se trouve dans la couche |
1651 |
|
|
! lmax |
1652 |
|
|
|
1653 |
|
✗ |
do l=1,nlay-2 |
1654 |
|
✗ |
do ig=1,ngrid |
1655 |
|
✗ |
if (l.eq.lmin(ig).and.lalim(ig).gt.1) then |
1656 |
|
|
|
1657 |
|
|
!------------------------------------------------------------------------ |
1658 |
|
|
! Calcul de la vitesse en haut de la premiere couche instable. |
1659 |
|
|
! Premiere couche du panache thermique |
1660 |
|
|
!------------------------------------------------------------------------ |
1661 |
|
|
zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1) & |
1662 |
|
|
& *(zlev(ig,l+1)-zlev(ig,l)) & |
1663 |
|
✗ |
& *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l)) |
1664 |
|
|
|
1665 |
|
|
!------------------------------------------------------------------------ |
1666 |
|
|
! Tant que la vitesse en bas de la couche et la somme du flux de masse |
1667 |
|
|
! et de l'entrainement (c'est a dire le flux de masse en haut) sont |
1668 |
|
|
! positifs, on calcul |
1669 |
|
|
! 1. le flux de masse en haut f_star(ig,l+1) |
1670 |
|
|
! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l) |
1671 |
|
|
! 3. la vitesse au carr� en haut zw2(ig,l+1) |
1672 |
|
|
!------------------------------------------------------------------------ |
1673 |
|
|
|
1674 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1675 |
|
|
! A eliminer : dans cette version, si zw2 est > 0 on a un therique. |
1676 |
|
|
! et donc, au dessus, f_star(ig,l+1) est forcement suffisamment |
1677 |
|
|
! grand puisque on n'a pas de detrainement. |
1678 |
|
|
! f_star est une fonction croissante. |
1679 |
|
|
! c'est donc vraiment sur zw2 uniquement qu'il faut faire le test. |
1680 |
|
|
! else if ((zw2(ig,l).ge.1e-10).and. & |
1681 |
|
|
! & (f_star(ig,l)+alim_star(ig,l).gt.1.e-10)) then |
1682 |
|
|
! f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l) |
1683 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1684 |
|
|
|
1685 |
|
✗ |
else if (zw2(ig,l).ge.1e-10) then |
1686 |
|
|
|
1687 |
|
|
ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l) & |
1688 |
|
✗ |
& *ztv(ig,l))/f_star(ig,l+1) |
1689 |
|
|
zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+ & |
1690 |
|
|
& 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & |
1691 |
|
✗ |
& *(zlev(ig,l+1)-zlev(ig,l)) |
1692 |
|
|
endif |
1693 |
|
|
! determination de zmax continu par interpolation lineaire |
1694 |
|
|
!------------------------------------------------------------------------ |
1695 |
|
|
|
1696 |
|
✗ |
if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then |
1697 |
|
|
! print*,'On tombe sur le cas particulier de thermcell_dry' |
1698 |
|
✗ |
zw2(ig,l+1)=0. |
1699 |
|
✗ |
linter(ig)=l+1 |
1700 |
|
✗ |
lmax(ig)=l |
1701 |
|
|
endif |
1702 |
|
|
|
1703 |
|
✗ |
if (zw2(ig,l+1).lt.0.) then |
1704 |
|
|
linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l)) & |
1705 |
|
✗ |
& -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l)) |
1706 |
|
✗ |
zw2(ig,l+1)=0. |
1707 |
|
✗ |
lmax(ig)=l |
1708 |
|
|
endif |
1709 |
|
|
|
1710 |
|
✗ |
wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) |
1711 |
|
|
|
1712 |
|
✗ |
if (wa_moy(ig,l+1).gt.wmaxa(ig)) then |
1713 |
|
|
! lmix est le niveau de la couche ou w (wa_moy) est maximum |
1714 |
|
✗ |
lmix(ig)=l+1 |
1715 |
|
✗ |
wmaxa(ig)=wa_moy(ig,l+1) |
1716 |
|
|
endif |
1717 |
|
|
enddo |
1718 |
|
|
enddo |
1719 |
|
✗ |
if (prt_level.ge.1) print*,'fin calcul zw2' |
1720 |
|
|
! |
1721 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1722 |
|
|
! A eliminer : |
1723 |
|
|
! Ce calcul de lmax est fait en meme temps que celui de linter, plus haut |
1724 |
|
|
! Calcul de la couche correspondant a la hauteur du thermique |
1725 |
|
|
! do ig=1,ngrid |
1726 |
|
|
! lmax(ig)=lalim(ig) |
1727 |
|
|
! enddo |
1728 |
|
|
! do ig=1,ngrid |
1729 |
|
|
! do l=nlay,lalim(ig)+1,-1 |
1730 |
|
|
! if (zw2(ig,l).le.1.e-10) then |
1731 |
|
|
! lmax(ig)=l-1 |
1732 |
|
|
! endif |
1733 |
|
|
! enddo |
1734 |
|
|
! enddo |
1735 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1736 |
|
|
|
1737 |
|
|
! |
1738 |
|
|
! Determination de zw2 max |
1739 |
|
✗ |
do ig=1,ngrid |
1740 |
|
✗ |
wmax(ig)=0. |
1741 |
|
|
enddo |
1742 |
|
|
|
1743 |
|
✗ |
do l=1,nlay |
1744 |
|
✗ |
do ig=1,ngrid |
1745 |
|
✗ |
if (l.le.lmax(ig)) then |
1746 |
|
✗ |
zw2(ig,l)=sqrt(zw2(ig,l)) |
1747 |
|
✗ |
wmax(ig)=max(wmax(ig),zw2(ig,l)) |
1748 |
|
|
else |
1749 |
|
✗ |
zw2(ig,l)=0. |
1750 |
|
|
endif |
1751 |
|
|
enddo |
1752 |
|
|
enddo |
1753 |
|
|
|
1754 |
|
|
! Longueur caracteristique correspondant a la hauteur des thermiques. |
1755 |
|
✗ |
do ig=1,ngrid |
1756 |
|
✗ |
zmax(ig)=0. |
1757 |
|
✗ |
zlevinter(ig)=zlev(ig,1) |
1758 |
|
|
enddo |
1759 |
|
✗ |
do ig=1,ngrid |
1760 |
|
|
! calcul de zlevinter |
1761 |
|
|
|
1762 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1763 |
|
|
! FH A eliminer |
1764 |
|
|
! Simplification |
1765 |
|
|
! zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))* & |
1766 |
|
|
! & linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1) & |
1767 |
|
|
! & -zlev(ig,lmax(ig))) |
1768 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
1769 |
|
|
|
1770 |
|
|
zlevinter(ig)=zlev(ig,lmax(ig)) + & |
1771 |
|
✗ |
& (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig))) |
1772 |
|
✗ |
zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig))) |
1773 |
|
|
enddo |
1774 |
|
|
|
1775 |
|
|
! Verification que lalim<=lmax |
1776 |
|
✗ |
do ig=1,ngrid |
1777 |
|
✗ |
if(lalim(ig)>lmax(ig)) then |
1778 |
|
✗ |
if ( prt_level > 1 ) THEN |
1779 |
|
✗ |
print*,'WARNING thermcell_dry ig=',ig,' lalim=',lalim(ig),' lmax(ig)=',lmax(ig) |
1780 |
|
|
endif |
1781 |
|
✗ |
lmax(ig)=lalim(ig) |
1782 |
|
|
endif |
1783 |
|
|
enddo |
1784 |
|
|
|
1785 |
|
✗ |
RETURN |
1786 |
|
|
END |
1787 |
|
|
!============================================================================== |
1788 |
|
✗ |
SUBROUTINE thermcellV0_init(ngrid,nlay,ztv,zlay,zlev, & |
1789 |
|
✗ |
& lalim,lmin,alim_star,alim_star_tot,lev_out) |
1790 |
|
|
|
1791 |
|
|
!---------------------------------------------------------------------- |
1792 |
|
|
!thermcell_init: calcul du profil d alimentation du thermique |
1793 |
|
|
!---------------------------------------------------------------------- |
1794 |
|
|
USE print_control_mod, ONLY: prt_level |
1795 |
|
|
IMPLICIT NONE |
1796 |
|
|
include "thermcell.h" |
1797 |
|
|
|
1798 |
|
|
INTEGER l,ig |
1799 |
|
|
!arguments d entree |
1800 |
|
|
INTEGER ngrid,nlay |
1801 |
|
|
REAL ztv(ngrid,nlay) |
1802 |
|
|
REAL zlay(ngrid,nlay) |
1803 |
|
|
REAL zlev(ngrid,nlay+1) |
1804 |
|
|
!arguments de sortie |
1805 |
|
|
INTEGER lalim(ngrid) |
1806 |
|
|
INTEGER lmin(ngrid) |
1807 |
|
|
REAL alim_star(ngrid,nlay) |
1808 |
|
|
REAL alim_star_tot(ngrid) |
1809 |
|
|
integer lev_out ! niveau pour les print |
1810 |
|
|
|
1811 |
|
✗ |
REAL zzalim(ngrid) |
1812 |
|
|
!CR: ponderation entrainement des couches instables |
1813 |
|
|
!def des alim_star tels que alim=f*alim_star |
1814 |
|
|
|
1815 |
|
✗ |
do l=1,nlay |
1816 |
|
✗ |
do ig=1,ngrid |
1817 |
|
✗ |
alim_star(ig,l)=0. |
1818 |
|
|
enddo |
1819 |
|
|
enddo |
1820 |
|
|
! determination de la longueur de la couche d entrainement |
1821 |
|
✗ |
do ig=1,ngrid |
1822 |
|
✗ |
lalim(ig)=1 |
1823 |
|
|
enddo |
1824 |
|
|
|
1825 |
|
✗ |
if (iflag_thermals_ed.ge.1) then |
1826 |
|
|
!si la première couche est instable, on declenche un thermique |
1827 |
|
✗ |
do ig=1,ngrid |
1828 |
|
✗ |
if (ztv(ig,1).gt.ztv(ig,2)) then |
1829 |
|
✗ |
lmin(ig)=1 |
1830 |
|
✗ |
lalim(ig)=2 |
1831 |
|
✗ |
alim_star(ig,1)=1. |
1832 |
|
✗ |
alim_star_tot(ig)=alim_star(ig,1) |
1833 |
|
✗ |
if(prt_level.GE.10) print*,'init',alim_star(ig,1),alim_star_tot(ig) |
1834 |
|
|
else |
1835 |
|
✗ |
lmin(ig)=1 |
1836 |
|
✗ |
lalim(ig)=1 |
1837 |
|
✗ |
alim_star(ig,1)=0. |
1838 |
|
✗ |
alim_star_tot(ig)=0. |
1839 |
|
|
endif |
1840 |
|
|
enddo |
1841 |
|
|
|
1842 |
|
|
else |
1843 |
|
|
!else iflag_thermals_ed=0 ancienne def de l alim |
1844 |
|
|
|
1845 |
|
|
!on ne considere que les premieres couches instables |
1846 |
|
✗ |
do l=nlay-2,1,-1 |
1847 |
|
✗ |
do ig=1,ngrid |
1848 |
|
✗ |
if (ztv(ig,l).gt.ztv(ig,l+1).and. & |
1849 |
|
✗ |
& ztv(ig,l+1).le.ztv(ig,l+2)) then |
1850 |
|
✗ |
lalim(ig)=l+1 |
1851 |
|
|
endif |
1852 |
|
|
enddo |
1853 |
|
|
enddo |
1854 |
|
|
|
1855 |
|
|
! determination du lmin: couche d ou provient le thermique |
1856 |
|
|
|
1857 |
|
✗ |
do ig=1,ngrid |
1858 |
|
|
! FH initialisation de lmin a nlay plutot que 1. |
1859 |
|
|
! lmin(ig)=nlay |
1860 |
|
✗ |
lmin(ig)=1 |
1861 |
|
|
enddo |
1862 |
|
✗ |
do l=nlay,2,-1 |
1863 |
|
✗ |
do ig=1,ngrid |
1864 |
|
✗ |
if (ztv(ig,l-1).gt.ztv(ig,l)) then |
1865 |
|
✗ |
lmin(ig)=l-1 |
1866 |
|
|
endif |
1867 |
|
|
enddo |
1868 |
|
|
enddo |
1869 |
|
|
! |
1870 |
|
✗ |
zzalim(:)=0. |
1871 |
|
✗ |
do l=1,nlay-1 |
1872 |
|
✗ |
do ig=1,ngrid |
1873 |
|
✗ |
if (l<lalim(ig)) then |
1874 |
|
✗ |
zzalim(ig)=zzalim(ig)+zlay(ig,l)*(ztv(ig,l)-ztv(ig,l+1)) |
1875 |
|
|
endif |
1876 |
|
|
enddo |
1877 |
|
|
enddo |
1878 |
|
✗ |
do ig=1,ngrid |
1879 |
|
✗ |
if (lalim(ig)>1) then |
1880 |
|
✗ |
zzalim(ig)=zlay(ig,1)+zzalim(ig)/(ztv(ig,1)-ztv(ig,lalim(ig))) |
1881 |
|
|
else |
1882 |
|
✗ |
zzalim(ig)=zlay(ig,1) |
1883 |
|
|
endif |
1884 |
|
|
enddo |
1885 |
|
|
|
1886 |
|
✗ |
if(prt_level.GE.10) print*,'ZZALIM LALIM ',zzalim,lalim,zlay(1,lalim(1)) |
1887 |
|
|
|
1888 |
|
|
! definition de l'entrainement des couches |
1889 |
|
|
if (1.eq.1) then |
1890 |
|
✗ |
do l=1,nlay-1 |
1891 |
|
✗ |
do ig=1,ngrid |
1892 |
|
|
if (ztv(ig,l).gt.ztv(ig,l+1).and. & |
1893 |
|
✗ |
& l.ge.lmin(ig).and.l.lt.lalim(ig)) then |
1894 |
|
|
!def possibles pour alim_star: zdthetadz, dthetadz, zdtheta |
1895 |
|
|
alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.) & |
1896 |
|
✗ |
& *sqrt(zlev(ig,l+1)) |
1897 |
|
|
endif |
1898 |
|
|
enddo |
1899 |
|
|
enddo |
1900 |
|
|
else |
1901 |
|
|
do l=1,nlay-1 |
1902 |
|
|
do ig=1,ngrid |
1903 |
|
|
if (ztv(ig,l).gt.ztv(ig,l+1).and. & |
1904 |
|
|
& l.ge.lmin(ig).and.l.lt.lalim(ig)) then |
1905 |
|
|
alim_star(ig,l)=max(3.*zzalim(ig)-zlay(ig,l),0.) & |
1906 |
|
|
& *(zlev(ig,l+1)-zlev(ig,l)) |
1907 |
|
|
endif |
1908 |
|
|
enddo |
1909 |
|
|
enddo |
1910 |
|
|
endif |
1911 |
|
|
|
1912 |
|
|
! pas de thermique si couche 1 stable |
1913 |
|
✗ |
do ig=1,ngrid |
1914 |
|
|
!CRnouveau test |
1915 |
|
✗ |
if (alim_star(ig,1).lt.1.e-10) then |
1916 |
|
✗ |
do l=1,nlay |
1917 |
|
✗ |
alim_star(ig,l)=0. |
1918 |
|
|
enddo |
1919 |
|
✗ |
lmin(ig)=1 |
1920 |
|
|
endif |
1921 |
|
|
enddo |
1922 |
|
|
! calcul de l alimentation totale |
1923 |
|
✗ |
do ig=1,ngrid |
1924 |
|
✗ |
alim_star_tot(ig)=0. |
1925 |
|
|
enddo |
1926 |
|
✗ |
do l=1,nlay |
1927 |
|
✗ |
do ig=1,ngrid |
1928 |
|
✗ |
alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l) |
1929 |
|
|
enddo |
1930 |
|
|
enddo |
1931 |
|
|
! |
1932 |
|
|
! Calcul entrainement normalise |
1933 |
|
✗ |
do l=1,nlay |
1934 |
|
✗ |
do ig=1,ngrid |
1935 |
|
✗ |
if (alim_star_tot(ig).gt.1.e-10) then |
1936 |
|
✗ |
alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig) |
1937 |
|
|
endif |
1938 |
|
|
enddo |
1939 |
|
|
enddo |
1940 |
|
|
|
1941 |
|
|
!on remet alim_star_tot a 1 |
1942 |
|
✗ |
do ig=1,ngrid |
1943 |
|
✗ |
alim_star_tot(ig)=1. |
1944 |
|
|
enddo |
1945 |
|
|
|
1946 |
|
|
endif |
1947 |
|
|
!endif iflag_thermals_ed |
1948 |
|
✗ |
return |
1949 |
|
|
end |
1950 |
|
|
!============================================================================== |
1951 |
|
|
|