SUBROUTINE thermcell_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz, & & zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot, & & lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva, & & ztla,zqla,zqta,zha,zw2,w_est,zqsatth,lmix,lmix_bis,linter & & ,lev_out,lunout1,igout) !-------------------------------------------------------------------------- !thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance !-------------------------------------------------------------------------- IMPLICIT NONE #include "YOMCST.h" #include "YOETHF.h" #include "FCTTRE.h" #include "iniprint.h" #include "thermcell.h" INTEGER itap INTEGER lunout1,igout INTEGER ngrid,klev REAL ptimestep REAL ztv(ngrid,klev) REAL zthl(ngrid,klev) REAL po(ngrid,klev) REAL zl(ngrid,klev) REAL rhobarz(ngrid,klev) REAL zlev(ngrid,klev+1) REAL pplev(ngrid,klev+1) REAL pphi(ngrid,klev) REAL zpspsk(ngrid,klev) REAL alim_star(ngrid,klev) REAL zmax_sec(ngrid) REAL f0(ngrid) REAL l_mix REAL r_aspect INTEGER lalim(ngrid) integer lev_out ! niveau pour les print real zcon2(ngrid) real alim_star_tot(ngrid) REAL ztva(ngrid,klev) REAL ztla(ngrid,klev) REAL zqla(ngrid,klev) REAL zqla0(ngrid,klev) REAL zqta(ngrid,klev) REAL zha(ngrid,klev) REAL detr_star(ngrid,klev) REAL coefc REAL detr_stara(ngrid,klev) REAL detr_starb(ngrid,klev) REAL detr_starc(ngrid,klev) REAL detr_star0(ngrid,klev) REAL detr_star1(ngrid,klev) REAL detr_star2(ngrid,klev) REAL entr_star(ngrid,klev) REAL entr_star1(ngrid,klev) REAL entr_star2(ngrid,klev) REAL detr(ngrid,klev) REAL entr(ngrid,klev) REAL zw2(ngrid,klev+1) REAL w_est(ngrid,klev+1) REAL f_star(ngrid,klev+1) REAL wa_moy(ngrid,klev+1) REAL ztva_est(ngrid,klev) REAL zqla_est(ngrid,klev) REAL zqsatth(ngrid,klev) REAL zta_est(ngrid,klev) REAL linter(ngrid) INTEGER lmix(ngrid) INTEGER lmix_bis(ngrid) REAL wmaxa(ngrid) INTEGER ig,l,k real zcor,zdelta,zcvm5,qlbef real Tbef,qsatbef real dqsat_dT,DT,num,denom REAL REPS,RLvCp,DDT0 PARAMETER (DDT0=.01) logical Zsat REAL fact_gamma,fact_epsilon REAL c2(ngrid,klev) Zsat=.false. ! Initialisation RLvCp = RLVTT/RCPD if (iflag_thermals_ed==0) then fact_gamma=1. fact_epsilon=1. else if (iflag_thermals_ed==1) then fact_gamma=1. fact_epsilon=1. else if (iflag_thermals_ed==2) then fact_gamma=1. fact_epsilon=2. endif do l=1,klev do ig=1,ngrid zqla_est(ig,l)=0. ztva_est(ig,l)=ztva(ig,l) zqsatth(ig,l)=0. enddo enddo !CR: attention test couche alim ! do l=2,klev ! do ig=1,ngrid ! alim_star(ig,l)=0. ! enddo ! enddo !AM:initialisations du thermique do k=1,klev do ig=1,ngrid ztva(ig,k)=ztv(ig,k) ztla(ig,k)=zthl(ig,k) zqla(ig,k)=0. zqta(ig,k)=po(ig,k) ! ztva(ig,k) = ztla(ig,k)*zpspsk(ig,k)+RLvCp*zqla(ig,k) ztva(ig,k) = ztva(ig,k)/zpspsk(ig,k) zha(ig,k) = ztva(ig,k) ! enddo enddo do k=1,klev do ig=1,ngrid detr_star(ig,k)=0. entr_star(ig,k)=0. detr_stara(ig,k)=0. detr_starb(ig,k)=0. detr_starc(ig,k)=0. detr_star0(ig,k)=0. zqla0(ig,k)=0. detr_star1(ig,k)=0. detr_star2(ig,k)=0. entr_star1(ig,k)=0. entr_star2(ig,k)=0. detr(ig,k)=0. entr(ig,k)=0. enddo enddo if (prt_level.ge.1) print*,'7 OK convect8' do k=1,klev+1 do ig=1,ngrid zw2(ig,k)=0. w_est(ig,k)=0. f_star(ig,k)=0. wa_moy(ig,k)=0. enddo enddo if (prt_level.ge.1) print*,'8 OK convect8' do ig=1,ngrid linter(ig)=1. lmix(ig)=1 lmix_bis(ig)=2 wmaxa(ig)=0. enddo !----------------------------------------------------------------------------------- !boucle de calcul de la vitesse verticale dans le thermique !----------------------------------------------------------------------------------- do l=1,klev-1 do ig=1,ngrid ! Calcul dans la premiere couche active du thermique (ce qu'on teste ! en disant que la couche est instable et que w2 en bas de la couche ! est nulle. if (ztv(ig,l).gt.ztv(ig,l+1) & & .and.alim_star(ig,l).gt.1.e-10 & & .and.zw2(ig,l).lt.1e-10) then ! Le panache va prendre au debut les caracteristiques de l'air contenu ! dans cette couche. ztla(ig,l)=zthl(ig,l) zqta(ig,l)=po(ig,l) zqla(ig,l)=zl(ig,l) f_star(ig,l+1)=alim_star(ig,l) zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1) & & *(zlev(ig,l+1)-zlev(ig,l)) & & *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l)) w_est(ig,l+1)=zw2(ig,l+1) ! else if ((zw2(ig,l).ge.1e-10).and. & & (f_star(ig,l)+alim_star(ig,l)).gt.1.e-10) then !estimation du detrainement a partir de la geometrie du pas precedent !tests sur la definition du detr !calcul de detr_star et entr_star !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! FH le test miraculeux de Catherine ? Le bout du tunel ? ! w_est(ig,3)=zw2(ig,2)* & ! & ((f_star(ig,2))**2) & ! & /(f_star(ig,2)+alim_star(ig,2))**2+ & ! & 2.*RG*(ztva(ig,1)-ztv(ig,2))/ztv(ig,2) & ! & *(zlev(ig,3)-zlev(ig,2)) ! if (l.gt.2) then !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Premier calcul de la vitesse verticale a partir de la temperature ! potentielle virtuelle ! FH CESTQUOI CA ???? #define int1d2 !#undef int1d2 #ifdef int1d2 if (l.ge.2) then #else if (l.gt.2) then #endif if (1.eq.1) then w_est(ig,3)=zw2(ig,2)* & & ((f_star(ig,2))**2) & & /(f_star(ig,2)+alim_star(ig,2))**2+ & & 2.*RG*(ztva(ig,2)-ztv(ig,2))/ztv(ig,2) & ! & *1./3. & & *(zlev(ig,3)-zlev(ig,2)) endif !--------------------------------------------------------------------------- !calcul de l entrainement et du detrainement lateral !--------------------------------------------------------------------------- ! !test:estimation de ztva_new_est sans entrainement Tbef=ztla(ig,l-1)*zpspsk(ig,l) zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) qsatbef=MIN(0.5,qsatbef) zcor=1./(1.-retv*qsatbef) qsatbef=qsatbef*zcor Zsat = (max(0.,zqta(ig,l-1)-qsatbef) .gt. 1.e-10) if (Zsat) then qlbef=max(0.,zqta(ig,l-1)-qsatbef) DT = 0.5*RLvCp*qlbef do while (abs(DT).gt.DDT0) Tbef=Tbef+DT zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) qsatbef=MIN(0.5,qsatbef) zcor=1./(1.-retv*qsatbef) qsatbef=qsatbef*zcor qlbef=zqta(ig,l-1)-qsatbef zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta zcor=1./(1.-retv*qsatbef) dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor) num=-Tbef+ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*qlbef denom=1.+RLvCp*dqsat_dT DT=num/denom enddo zqla_est(ig,l) = max(0.,zqta(ig,l-1)-qsatbef) endif ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l) ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l) zta_est(ig,l)=ztva_est(ig,l) ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1) & & -zqla_est(ig,l))-zqla_est(ig,l)) w_est(ig,l+1)=zw2(ig,l)* & & ((f_star(ig,l))**2) & & /(f_star(ig,l)+alim_star(ig,l))**2+ & & 2.*RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & ! & *1./3. & & *(zlev(ig,l+1)-zlev(ig,l)) if (w_est(ig,l+1).lt.0.) then w_est(ig,l+1)=zw2(ig,l) endif ! !calcul du detrainement !======================= !CR:on vire les modifs if (iflag_thermals_ed==0) then ! Modifications du calcul du detrainement. ! Dans la version de la these de Catherine, on passe brusquement ! de la version seche a la version nuageuse pour le detrainement ! ce qui peut occasioner des oscillations. ! dans la nouvelle version, on commence par calculer un detrainement sec. ! Puis un autre en cas de nuages. ! Puis on combine les deux lineairement en fonction de la quantite d'eau. #define int1d3 !#undef int1d3 #define RIO_TH #ifdef RIO_TH !1. Cas non nuageux ! 1.1 on est sous le zmax_sec et w croit if ((w_est(ig,l+1).gt.w_est(ig,l)).and. & & (zlev(ig,l+1).lt.zmax_sec(ig)).and. & #ifdef int1d3 & (zqla_est(ig,l).lt.1.e-10)) then #else & (zqla(ig,l-1).lt.1.e-10)) then #endif detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1) & & *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1)) & & -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l))) & & /(r_aspect*zmax_sec(ig))) detr_stara(ig,l)=detr_star(ig,l) if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l',ig,l ! 1.2 on est sous le zmax_sec et w decroit else if ((zlev(ig,l+1).lt.zmax_sec(ig)).and. & #ifdef int1d3 & (zqla_est(ig,l).lt.1.e-10)) then #else & (zqla(ig,l-1).lt.1.e-10)) then #endif detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig)) & & /(rhobarz(ig,lmix(ig))*wmaxa(ig))* & & (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1)) & & *((zmax_sec(ig)-zlev(ig,l+1))/ & & ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2. & & -rhobarz(ig,l)*sqrt(w_est(ig,l)) & & *((zmax_sec(ig)-zlev(ig,l))/ & & ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.) detr_starb(ig,l)=detr_star(ig,l) if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l',ig,l else ! 1.3 dans les autres cas detr_star(ig,l)=0.002*f0(ig)*f_star(ig,l) & & *(zlev(ig,l+1)-zlev(ig,l)) detr_starc(ig,l)=detr_star(ig,l) if (prt_level.ge.20) print*,'coucou calcul detr 3 n: ig, l',ig, l endif #else ! 1.1 on est sous le zmax_sec et w croit if ((w_est(ig,l+1).gt.w_est(ig,l)).and. & & (zlev(ig,l+1).lt.zmax_sec(ig)) ) then detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1) & & *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1)) & & -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l))) & & /(r_aspect*zmax_sec(ig))) if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l ! 1.2 on est sous le zmax_sec et w decroit else if ((zlev(ig,l+1).lt.zmax_sec(ig)) ) then detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig)) & & /(rhobarz(ig,lmix(ig))*wmaxa(ig))* & & (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1)) & & *((zmax_sec(ig)-zlev(ig,l+1))/ & & ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2. & & -rhobarz(ig,l)*sqrt(w_est(ig,l)) & & *((zmax_sec(ig)-zlev(ig,l))/ & & ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.) if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l else detr_star=0. endif ! 1.3 dans les autres cas detr_starc(ig,l)=0.002*f0(ig)*f_star(ig,l) & & *(zlev(ig,l+1)-zlev(ig,l)) coefc=min(zqla(ig,l-1)/1.e-3,1.) if (zlev(ig,l+1).ge.zmax_sec(ig)) coefc=1. coefc=1. ! il semble qu'il soit important de baser le calcul sur ! zqla_est(ig,l-1) plutot que sur zqla_est(ig,l) detr_star(ig,l)=detr_starc(ig,l)*coefc+detr_star(ig,l)*(1.-coefc) if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l', ig, l #endif if (prt_level.ge.20) print*,'coucou calcul detr 444: ig, l', ig, l !IM 730508 beg ! if(itap.GE.7200) THEN ! print*,'th_plume ig,l,itap,zqla_est=',ig,l,itap,zqla_est(ig,l) ! endif !IM 730508 end zqla0(ig,l)=zqla_est(ig,l) detr_star0(ig,l)=detr_star(ig,l) !IM 060508 beg ! if(detr_star(ig,l).GT.1.) THEN ! print*,'th_plumeBEF ig l detr_star detr_starc coefc',ig,l,detr_star(ig,l) & ! & ,detr_starc(ig,l),coefc ! endif !IM 060508 end !IM 160508 beg !IM 160508 IF (f0(ig).NE.0.) THEN detr_star(ig,l)=detr_star(ig,l)/f0(ig) !IM 160508 ELSE IF(detr_star(ig,l).EQ.0.) THEN !IM 160508 print*,'WARNING1 : th_plume f0=0, detr_star=0: ig, l, itap',ig,l,itap !IM 160508 ELSE !IM 160508 print*,'WARNING2 : th_plume f0=0, ig, l, itap, detr_star',ig,l,itap,detr_star(ig,l) !IM 160508 ENDIF !IM 160508 end !IM 060508 beg ! if(detr_star(ig,l).GT.1.) THEN ! print*,'th_plumeAFT ig l detr_star f0 1/f0',ig,l,detr_star(ig,l),f0(ig), & ! & float(1)/f0(ig) ! endif !IM 060508 end if (prt_level.ge.20) print*,'coucou calcul detr 445: ig, l', ig, l ! !calcul de entr_star ! #undef test2 ! #ifdef test2 ! La version test2 destabilise beaucoup le modele. ! Il semble donc que ca aide d'avoir un entrainement important sous ! le nuage. ! if (zqla_est(ig,l-1).ge.1.e-10.and.l.gt.lalim(ig)) then ! entr_star(ig,l)=0.4*detr_star(ig,l) ! else ! entr_star(ig,l)=0. ! endif ! #else ! ! Deplacement du calcul de entr_star pour eviter d'avoir aussi ! entr_star > fstar. ! Redeplacer suite a la transformation du cas detr>f ! FH if (prt_level.ge.20) print*,'coucou calcul detr 446: ig, l', ig, l #define int1d !FH 070508 #define int1d4 !#undef int1d4 ! L'option int1d4 correspond au choix dans le cas ou le detrainement ! devient trop grand. #ifdef int1d #ifdef int1d4 #else detr_star(ig,l)=min(detr_star(ig,l),f_star(ig,l)) !FH 070508 plus detr_star(ig,l)=min(detr_star(ig,l),1.) #endif entr_star(ig,l)=max(0.4*detr_star(ig,l)-alim_star(ig,l),0.) if (prt_level.ge.20) print*,'coucou calcul detr 447: ig, l', ig, l #ifdef int1d4 ! Si le detrainement excede le flux en bas + l'entrainement, le thermique ! doit disparaitre. if (detr_star(ig,l)>f_star(ig,l)+entr_star(ig,l)) then detr_star(ig,l)=f_star(ig,l)+entr_star(ig,l) f_star(ig,l+1)=0. linter(ig)=l+1 zw2(ig,l+1)=-1.e-10 endif #endif #else if (prt_level.ge.20) print*,'coucou calcul detr 448: ig, l', ig, l if(l.gt.lalim(ig)) then entr_star(ig,l)=0.4*detr_star(ig,l) else ! FH : ! Cette ligne doit permettre de garantir qu'on a toujours un flux = 1 ! en haut de la couche d'alimentation. ! A remettre en questoin a la premiere occasion mais ca peut aider a ! ecrire un code robuste. ! Que ce soit avec ca ou avec l'ancienne facon de faire (e* = 0 mais ! d* non nul) on a une discontinuité de e* ou d* en haut de la couche ! d'alimentation, ce qui n'est pas forcement heureux. if (prt_level.ge.20) print*,'coucou calcul detr 449: ig, l', ig, l #undef pre_int1c #ifdef pre_int1c entr_star(ig,l)=max(detr_star(ig,l)-alim_star(ig,l),0.) detr_star(ig,l)=entr_star(ig,l) #else entr_star(ig,l)=0. #endif endif #endif if (prt_level.ge.20) print*,'coucou calcul detr 440: ig, l', ig, l entr_star1(ig,l)=entr_star(ig,l) detr_star1(ig,l)=detr_star(ig,l) ! #ifdef int1d #else if (detr_star(ig,l).gt.f_star(ig,l)) then ! Ce test est là entre autres parce qu'on passe par des valeurs ! delirantes de detr_star. ! ca vaut sans doute le coup de verifier pourquoi. detr_star(ig,l)=f_star(ig,l) #ifdef pre_int1c if (l.gt.lalim(ig)+1) then entr_star(ig,l)=0. alim_star(ig,l)=0. ! FH ajout pour forcer a stoper le thermique juste sous le sommet ! de la couche (voir calcul de finter) zw2(ig,l+1)=-1.e-10 linter(ig)=l+1 else entr_star(ig,l)=0.4*detr_star(ig,l) endif #else entr_star(ig,l)=0.4*detr_star(ig,l) #endif endif #endif else !l > 2 detr_star(ig,l)=0. entr_star(ig,l)=0. endif entr_star2(ig,l)=entr_star(ig,l) detr_star2(ig,l)=detr_star(ig,l) if (prt_level.ge.20) print*,'coucou calcul detr 450: ig, l', ig, l endif ! iflag_thermals_ed==0 !CR:nvlle def de entr_star et detr_star if (iflag_thermals_ed>=1) then ! if (l.lt.lalim(ig)) then ! if (l.lt.2) then ! entr_star(ig,l)=0. ! detr_star(ig,l)=0. ! else ! if (0.001.gt.(RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))/(2.*w_est(ig,l+1)))) then ! entr_star(ig,l)=0.001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) ! else ! entr_star(ig,l)= & ! & f_star(ig,l)/(2.*w_est(ig,l+1)) & ! & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)) & ! & *(zlev(ig,l+1)-zlev(ig,l)) entr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)), & & f_star(ig,l)/(2.*w_est(ig,l+1)) & & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & & *(zlev(ig,l+1)-zlev(ig,l))) & & +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then alim_star_tot(ig)=alim_star_tot(ig)+entr_star(ig,l) lalim(ig)=lmix_bis(ig) if(prt_level.GE.10) print*,'alim_star_tot',alim_star_tot(ig),entr_star(ig,l) endif if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then ! c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l)) c2(ig,l)=0.001 detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)), & & c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) & & -f_star(ig,l)/(2.*w_est(ig,l+1)) & & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & & *(zlev(ig,l+1)-zlev(ig,l))) & & +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) else ! c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l)) c2(ig,l)=0.003 detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)), & & c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) & & -f_star(ig,l)/(2.*w_est(ig,l+1)) & & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & & *(zlev(ig,l+1)-zlev(ig,l))) & & +0.0002*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) endif ! detr_star(ig,l)=detr_star(ig,l)*3. ! if (l.lt.lalim(ig)) then ! entr_star(ig,l)=0. ! endif ! if (l.lt.2) then ! entr_star(ig,l)=0. ! detr_star(ig,l)=0. ! endif ! endif ! else if ((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10) then ! entr_star(ig,l)=MAX(0.,0.8*f_star(ig,l)/(2.*w_est(ig,l+1)) & ! & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)) & ! & *(zlev(ig,l+1)-zlev(ig,l)) ! detr_star(ig,l)=0.002*f_star(ig,l) & ! & *(zlev(ig,l+1)-zlev(ig,l)) ! else ! entr_star(ig,l)=0.001*f_star(ig,l) & ! & *(zlev(ig,l+1)-zlev(ig,l)) ! detr_star(ig,l)=MAX(0.,-0.2*f_star(ig,l)/(2.*w_est(ig,l+1)) & ! & *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)) & ! & *(zlev(ig,l+1)-zlev(ig,l)) & ! & +0.002*f_star(ig,l) & ! & *(zlev(ig,l+1)-zlev(ig,l)) ! endif endif ! iflag_thermals_ed==1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! FH inutile si on conserve comme on l'a fait plus haut entr=detr ! dans la couche d'alimentation !pas d entrainement dans la couche alim ! if ((l.le.lalim(ig))) then ! entr_star(ig,l)=0. ! endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !prise en compte du detrainement et de l entrainement dans le calcul du flux f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l) & & -detr_star(ig,l) !test sur le signe de f_star if (prt_level.ge.20) print*,'coucou calcul detr 451: ig, l', ig, l if (f_star(ig,l+1).gt.1.e-10) then !---------------------------------------------------------------------------- !calcul de la vitesse verticale en melangeant Tl et qt du thermique !--------------------------------------------------------------------------- ! Zsat=.false. ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+ & & (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l)) & & /(f_star(ig,l+1)+detr_star(ig,l)) ! zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+ & & (alim_star(ig,l)+entr_star(ig,l))*po(ig,l)) & & /(f_star(ig,l+1)+detr_star(ig,l)) ! Tbef=ztla(ig,l)*zpspsk(ig,l) zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) qsatbef=MIN(0.5,qsatbef) zcor=1./(1.-retv*qsatbef) qsatbef=qsatbef*zcor Zsat = (max(0.,zqta(ig,l)-qsatbef) .gt. 1.e-10) if (Zsat) then qlbef=max(0.,zqta(ig,l)-qsatbef) DT = 0.5*RLvCp*qlbef do while (abs(DT).gt.DDT0) Tbef=Tbef+DT zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l) qsatbef=MIN(0.5,qsatbef) zcor=1./(1.-retv*qsatbef) qsatbef=qsatbef*zcor qlbef=zqta(ig,l)-qsatbef zdelta=MAX(0.,SIGN(1.,RTT-Tbef)) zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta zcor=1./(1.-retv*qsatbef) dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor) num=-Tbef+ztla(ig,l)*zpspsk(ig,l)+RLvCp*qlbef denom=1.+RLvCp*dqsat_dT DT=num/denom enddo zqla(ig,l) = max(0.,qlbef) endif ! if (prt_level.ge.20) print*,'coucou calcul detr 4512: ig, l', ig, l ! on ecrit de maniere conservative (sat ou non) ! T = Tl +Lv/Cp ql ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l) ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l) !on rajoute le calcul de zha pour diagnostiques (temp potentielle) zha(ig,l) = ztva(ig,l) ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l) & & -zqla(ig,l))-zqla(ig,l)) !on ecrit zqsat zqsatth(ig,l)=qsatbef !calcul de vitesse zw2(ig,l+1)=zw2(ig,l)* & & ((f_star(ig,l))**2) & ! Tests de Catherine ! & /(f_star(ig,l+1)+detr_star(ig,l))**2+ & & /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-fact_epsilon))**2+ & & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & & *fact_gamma & & *(zlev(ig,l+1)-zlev(ig,l)) !prise en compte des forces de pression que qd flottabilité<0 ! zw2(ig,l+1)=zw2(ig,l)* & ! & 1./(1.+2.*entr_star(ig,l)/f_star(ig,l)) + & ! & (f_star(ig,l))**2 & ! & /(f_star(ig,l)+entr_star(ig,l))**2+ & ! & (f_star(ig,l)-2.*entr_star(ig,l))**2/(f_star(ig,l)+2.*entr_star(ig,l))**2+ & ! & /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-2.))**2+ & ! & /(f_star(ig,l)**2+2.*2.*detr_star(ig,l)*f_star(ig,l)+2.*entr_star(ig,l)*f_star(ig,l))+ & ! & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & ! & *1./3. & ! & *(zlev(ig,l+1)-zlev(ig,l)) ! write(30,*),l+1,zw2(ig,l+1)-zw2(ig,l), & ! & -2.*entr_star(ig,l)/f_star(ig,l)*zw2(ig,l), & ! & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) ! zw2(ig,l+1)=zw2(ig,l)* & ! & (2.-2.*entr_star(ig,l)/f_star(ig,l)) & ! & -zw2(ig,l-1)+ & ! & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & ! & *1./3. & ! & *(zlev(ig,l+1)-zlev(ig,l)) endif endif if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l ! !initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then ! stop'On tombe sur le cas particulier de thermcell_dry' print*,'On tombe sur le cas particulier de thermcell_plume' zw2(ig,l+1)=0. linter(ig)=l+1 endif ! if ((zw2(ig,l).gt.0.).and. (zw2(ig,l+1).le.0.)) then if (zw2(ig,l+1).lt.0.) then linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l)) & & -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l)) zw2(ig,l+1)=0. endif wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) if (wa_moy(ig,l+1).gt.wmaxa(ig)) then ! lmix est le niveau de la couche ou w (wa_moy) est maximum !on rajoute le calcul de lmix_bis if (zqla(ig,l).lt.1.e-10) then lmix_bis(ig)=l+1 endif lmix(ig)=l+1 wmaxa(ig)=wa_moy(ig,l+1) endif enddo enddo !on remplace a* par e* ds premiere couche ! if (iflag_thermals_ed.ge.1) then ! do ig=1,ngrid ! do l=2,klev ! if (l.lt.lalim(ig)) then ! alim_star(ig,l)=entr_star(ig,l) ! endif ! enddo ! enddo ! do ig=1,ngrid ! lalim(ig)=lmix_bis(ig) ! enddo ! endif if (iflag_thermals_ed.ge.1) then do ig=1,ngrid do l=2,lalim(ig) alim_star(ig,l)=entr_star(ig,l) entr_star(ig,l)=0. enddo enddo endif if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l ! print*,'thermcell_plume OK' return end