| 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 |
|
|
|