SUBROUTINE thermcell_init(ngrid,nlay,ztv,zlev,  &
     &                  lalim,lmin,alim_star,alim_star_tot,lev_out)

!----------------------------------------------------------------------
!thermcell_init: calcul du profil d alimentation du thermique
!----------------------------------------------------------------------
      IMPLICIT NONE
      INTEGER l,ig
!arguments d entree
      INTEGER ngrid,nlay
      REAL ztv(ngrid,nlay)
      REAL zlev(ngrid,nlay)
!arguments de sortie
      INTEGER lalim(ngrid)
      INTEGER lmin(ngrid)
      REAL alim_star(ngrid,nlay)
      REAL alim_star_tot(ngrid)
      integer lev_out                           ! niveau pour les print
      
!CR: ponderation entrainement des couches instables
!def des alim_star tels que alim=f*alim_star      

      do l=1,nlay
         do ig=1,ngrid 
            alim_star(ig,l)=0.
         enddo
      enddo
! determination de la longueur de la couche d entrainement
      do ig=1,ngrid
         lalim(ig)=1
      enddo

!on ne considere que les premieres couches instables
      do l=nlay-2,1,-1
         do ig=1,ngrid
            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
     &          ztv(ig,l+1).le.ztv(ig,l+2)) then
               lalim(ig)=l+1
            endif
          enddo
      enddo

! determination du lmin: couche d ou provient le thermique

      do ig=1,ngrid
! FH initialisation de lmin a nlay plutot que 1.
!        lmin(ig)=nlay
         lmin(ig)=1
      enddo
      do l=nlay,2,-1
         do ig=1,ngrid
            if (ztv(ig,l-1).gt.ztv(ig,l)) then
               lmin(ig)=l-1
            endif
         enddo
      enddo
!
! definition de l'entrainement des couches
      do l=1,nlay-1
         do ig=1,ngrid 
            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
!def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
             alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
     &                       *sqrt(zlev(ig,l+1)) 
            endif
         enddo
      enddo
      
! pas de thermique si couche 1 stable
      do ig=1,ngrid
!CRnouveau test
        if (alim_star(ig,1).lt.1.e-10) then 
            do l=1,nlay
                alim_star(ig,l)=0.
            enddo
            lmin(ig)=1
         endif
      enddo 
! calcul de l alimentation totale
      do ig=1,ngrid
         alim_star_tot(ig)=0.
      enddo
      do l=1,nlay
         do ig=1,ngrid
            alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
         enddo
      enddo
!
! Calcul entrainement normalise
      do l=1,nlay 
         do ig=1,ngrid 
            if (alim_star_tot(ig).gt.1.e-10) then
               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
            endif
         enddo
      enddo
       
      return 
      end