SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,entr_star, & & lentr,lmin,zmax,wmax,lev_out) !-------------------------------------------------------------------------- !thermcell_dry: calcul de zmax et wmax du thermique sec !-------------------------------------------------------------------------- IMPLICIT NONE #include "YOMCST.h" INTEGER l,ig INTEGER ngrid,nlay REAL zlev(ngrid,nlay+1) REAL pphi(ngrid,nlay) REAl ztv(ngrid,nlay) REAL entr_star(ngrid,nlay) INTEGER lentr(ngrid) integer lev_out ! niveau pour les print REAL zmax(ngrid) REAL wmax(ngrid) !variables locales REAL zw2(ngrid,nlay+1) REAL f_star(ngrid,nlay+1) REAL ztva(ngrid,nlay+1) REAL wmaxa(ngrid) REAL wa_moy(ngrid,nlay+1) REAL linter(ngrid),zlevinter(ngrid) INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid) !initialisations do ig=1,ngrid do l=1,nlay+1 zw2(ig,l)=0. f_star(ig,l)=0. wa_moy(ig,l)=0. enddo enddo do ig=1,ngrid do l=1,nlay ztva(ig,l)=ztv(ig,l) enddo enddo do ig=1,ngrid wmax(ig)=0. wmaxa(ig)=0. enddo !calcul de la vitesse a partir de la CAPE en melangeant thetav do l=1,nlay-2 do ig=1,ngrid if (ztv(ig,l).gt.ztv(ig,l+1) & & .and.entr_star(ig,l).gt.1.e-10 & & .and.zw2(ig,l).lt.1e-10) then f_star(ig,l+1)=entr_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)) else if ((zw2(ig,l).ge.1e-10).and. & & (f_star(ig,l)+entr_star(ig,l).gt.1.e-10)) then f_star(ig,l+1)=f_star(ig,l)+entr_star(ig,l) ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l) & & *ztv(ig,l))/f_star(ig,l+1) zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+ & & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & & *(zlev(ig,l+1)-zlev(ig,l)) endif ! determination de zmax continu par interpolation lineaire 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. else wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) endif if (wa_moy(ig,l+1).gt.wmaxa(ig)) then ! lmix est le niveau de la couche ou w (wa_moy) est maximum lmix(ig)=l+1 wmaxa(ig)=wa_moy(ig,l+1) endif enddo enddo if (lev_out.ge.1) print*,'fin calcul zw2' ! ! Calcul de la couche correspondant a la hauteur du thermique do ig=1,ngrid lmax(ig)=lentr(ig) enddo do ig=1,ngrid do l=nlay,lentr(ig)+1,-1 if (zw2(ig,l).le.1.e-10) then lmax(ig)=l-1 endif enddo enddo ! ! Determination de zw2 max do ig=1,ngrid wmax(ig)=0. enddo do l=1,nlay do ig=1,ngrid if (l.le.lmax(ig)) then zw2(ig,l)=sqrt(zw2(ig,l)) wmax(ig)=max(wmax(ig),zw2(ig,l)) else zw2(ig,l)=0. endif enddo enddo ! Longueur caracteristique correspondant a la hauteur des thermiques. do ig=1,ngrid zmax(ig)=0. zlevinter(ig)=zlev(ig,1) enddo do ig=1,ngrid ! calcul de zlevinter zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))* & & linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1) & & -zlev(ig,lmax(ig))) zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig))) enddo !on stoppe après les calculs de zmax et wmax RETURN END