source: LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_height.f90 @ 5456

MODULE lmdz_thermcell_height
CONTAINS

      SUBROUTINE thermcell_height(ngrid,nlay,lalim,lmin,linter,lcong,lintercong,lmix,  &
     &           zw2,zlev,lmax,zmax,zmax0,zmix,wmax,zcong)
      IMPLICIT NONE

!-----------------------------------------------------------------------------
!thermcell_height: calcul des caracteristiques du thermique: zmax,wmax,zmix
!-----------------------------------------------------------------------------

! arguments

! Entree
      integer, intent(in) :: ngrid,nlay
      real, intent(in), dimension(ngrid) :: linter,lintercong
      real, intent(in), dimension(ngrid,nlay+1) :: zlev
! Sortie
      real, intent(out), dimension(ngrid) :: wmax,zmax,zmax0,zmix,zcong
      integer, intent(out), dimension(ngrid) :: lmax,lcong
! Les deux
     integer, intent(inout), dimension(ngrid) :: lmix,lalim,lmin
     real, intent(inout), dimension(ngrid,nlay+1) :: zw2

! local
     real, dimension(ngrid) :: num,denom,zlevinter,zlevintercong
     integer ig,l

!calcul de la hauteur max du thermique
      do ig=1,ngrid
         lmax(ig)=lalim(ig)
      enddo
      do ig=1,ngrid
         do l=nlay,lalim(ig)+1,-1
            if (zw2(ig,l).le.1.e-10) then
               lmax(ig)=l-1
            endif
         enddo
      enddo

! On traite le cas particulier qu'il faudrait eviter ou le thermique
! atteind le haut du modele ...
      do ig=1,ngrid
      if ( zw2(ig,nlay) > 1.e-10 ) then
          print*,'WARNING !!!!! W2 thermiques non nul derniere couche '
          lmax(ig)=nlay
      endif
      enddo

! pas de thermique si couche 1 stable
      do ig=1,ngrid
         if (lmin(ig).gt.1) then
             lmax(ig)=1
             lmin(ig)=1
             lalim(ig)=1
         endif
      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
                if (zw2(ig,l).lt.0.)then
                  print*,'pb2 zw2<0'
                endif
                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

!     if (iflag_thermals_ed.ge.1) then
      if (1==0) then
!CR:date de quand le calcul du zmax continu etait buggue 
         num(:)=0.
         denom(:)=0.
         do ig=1,ngrid
          do l=1,nlay
             num(ig)=num(ig)+zw2(ig,l)*zlev(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
             denom(ig)=denom(ig)+zw2(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
          enddo
       enddo
       do ig=1,ngrid
       if (denom(ig).gt.1.e-10) then
          zmax(ig)=2.*num(ig)/denom(ig)
          zmax0(ig)=zmax(ig)
       endif 
       enddo
 
      else
!CR:Calcul de zmax continu via le linter      
      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)))
!pour le cas ou on prend tjs lmin=1
!       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,1))
       zmax0(ig)=zmax(ig)
      enddo

!CR:calcul du zcong
      do  ig=1,ngrid
! calcul de zlevintercong
         zlevintercong(ig)=(zlev(ig,lcong(ig)+1)-zlev(ig,lcong(ig)))*  &
     &    lintercong(ig)+zlev(ig,lcong(ig))-lcong(ig)*(zlev(ig,lcong(ig)+1)  &
     &    -zlev(ig,lcong(ig)))
         zcong(ig)=zlevintercong(ig)-zlev(ig,1)
!         print*,"calcul zcong",lcong(ig),lintercong(ig),zlevintercong(ig),zcong(ig)
      enddo

      endif
!endif iflag_thermals_ed
!
! def de  zmix continu (profil parabolique des vitesses)
      do ig=1,ngrid
           if (lmix(ig).gt.1) then
! test 
              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)  &
     &        then
!             
            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
     &        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)  &
     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
     &        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))  &
     &        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
              else
              zmix(ig)=zlev(ig,lmix(ig))
              print*,'pb zmix'
              endif
          else 
              zmix(ig)=0.
          endif
!test
         if ((zmax(ig)-zmix(ig)).le.0.) then
            zmix(ig)=0.9*zmax(ig)
!            print*,'pb zmix>zmax'
         endif
      enddo
!
! calcul du nouveau lmix correspondant
      do ig=1,ngrid
         do l=1,nlay
            if (zmix(ig).ge.zlev(ig,l).and.  &
     &          zmix(ig).lt.zlev(ig,l+1)) then
              lmix(ig)=l
             endif
          enddo
      enddo
!
 RETURN
      END SUBROUTINE thermcell_height
END MODULE lmdz_thermcell_height