Index: LMDZ4/trunk/libf/phylmd/ajsec.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/ajsec.F	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/ajsec.F	(revision 878)
@@ -2,5 +2,159 @@
 ! $Header$
 !
-      SUBROUTINE ajsec(paprs, pplay, t,q, d_t,d_q)
+      SUBROUTINE ajsec(paprs, pplay, t,q,limbas,d_t,d_q)
+      USE dimphy
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: ajustement sec (adaptation du GCM du LMD)
+c======================================================================
+c Arguments:
+c t-------input-R- Temperature
+c
+c d_t-----output-R-Incrementation de la temperature
+c======================================================================
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev), q(klon,klev)
+      REAL d_t(klon,klev), d_q(klon,klev)
+c
+      INTEGER limbas(klon), limhau ! les couches a ajuster
+c
+      LOGICAL mixq
+ccc      PARAMETER (mixq=.TRUE.)
+      PARAMETER (mixq=.FALSE.)
+c
+      REAL zh(klon,klev)
+      REAL zho(klon,klev)
+      REAL zq(klon,klev)
+      REAL zpk(klon,klev)
+      REAL zpkdp(klon,klev)
+      REAL hm, sm, qm
+      LOGICAL modif(klon), down
+      INTEGER i, k, k1, k2
+c
+c Initialisation:
+c
+cym
+      limhau=klev
+  
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_q(i,k) = 0.0
+      ENDDO
+      ENDDO
+c------------------------------------- detection des profils a modifier
+      DO k = 1, limhau
+      DO i = 1, klon
+         zpk(i,k) = pplay(i,k)**RKAPPA
+         zh(i,k) = RCPD * t(i,k)/ zpk(i,k)
+         zho(i,k) = zh(i,k)
+         zq(i,k) = q(i,k)
+      ENDDO
+      ENDDO
+c
+      DO k = 1, limhau
+      DO i = 1, klon
+         zpkdp(i,k) = zpk(i,k) * (paprs(i,k)-paprs(i,k+1))
+      ENDDO
+      ENDDO
+c
+      DO i = 1, klon
+         modif(i) = .FALSE.
+      ENDDO
+      DO k = 2, limhau
+      DO i = 1, klon
+      IF (.NOT.modif(i).and.k-1>limbas(i)) THEN
+         IF ( zh(i,k).LT.zh(i,k-1) ) modif(i) = .TRUE.
+      ENDIF
+      ENDDO
+      ENDDO
+c------------------------------------- correction des profils instables
+      DO 1080 i = 1, klon
+      IF (modif(i)) THEN
+          k2 = limbas(i)
+ 8000     CONTINUE
+            k2 = k2 + 1
+            IF (k2 .GT. limhau) goto 8001
+            IF (zh(i,k2) .LT. zh(i,k2-1)) THEN
+              k1 = k2 - 1
+              k = k1
+              sm = zpkdp(i,k2)
+              hm = zh(i,k2)
+              qm = zq(i,k2)
+ 8020         CONTINUE
+                sm = sm +zpkdp(i,k)
+                hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm
+                qm = qm +zpkdp(i,k) * (zq(i,k)-qm) / sm
+                down = .FALSE.
+                IF (k1 .ne. limbas(i)) THEN
+                  IF (hm .LT. zh(i,k1-1)) down = .TRUE.
+                ENDIF
+                IF (down) THEN
+                  k1 = k1 - 1
+                  k = k1
+                ELSE
+                  IF ((k2 .EQ. limhau)) GOTO 8021
+                  IF ((zh(i,k2+1).GE.hm)) GOTO 8021
+                  k2 = k2 + 1
+                  k = k2
+                ENDIF
+              GOTO 8020
+ 8021         CONTINUE
+c------------ nouveau profil : constant (valeur moyenne)
+              DO k = k1, k2
+                zh(i,k) = hm
+                zq(i,k) = qm
+              ENDDO
+              k2 = k2 + 1
+            ENDIF
+          GOTO 8000
+ 8001     CONTINUE
+      ENDIF
+ 1080 CONTINUE
+c
+      DO k = 1, limhau
+      DO i = 1, klon
+         d_t(i,k) = (zh(i,k)-zho(i,k))*zpk(i,k)/RCPD
+         d_q(i,k) = zq(i,k) - q(i,k)
+      ENDDO
+      ENDDO
+c
+! FH : les d_q et d_t sont maintenant calcules de facon a valoir
+! effectivement 0. si on ne fait rien.
+!
+!     IF (limbas.GT.1) THEN
+!     DO k = 1, limbas-1
+!     DO i = 1, klon
+!        d_t(i,k) = 0.0
+!        d_q(i,k) = 0.0
+!     ENDDO
+!     ENDDO
+!     ENDIF
+c
+!     IF (limhau.LT.klev) THEN
+!     DO k = limhau+1, klev
+!     DO i = 1, klon
+!        d_t(i,k) = 0.0
+!        d_q(i,k) = 0.0
+!     ENDDO
+!     ENDDO
+!     ENDIF
+c
+      IF (.NOT.mixq) THEN
+      DO k = 1, klev
+      DO i = 1, klon
+         d_q(i,k) = 0.0
+      ENDDO
+      ENDDO
+      ENDIF
+c
+      RETURN
+      END
+
+      SUBROUTINE ajsec_convV2(paprs, pplay, t,q, d_t,d_q)
       USE dimphy
       IMPLICIT none
Index: LMDZ4/trunk/libf/phylmd/calltherm.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/calltherm.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/calltherm.F90	(revision 878)
@@ -0,0 +1,291 @@
+!
+! $Header$
+!
+      subroutine calltherm(dtime  &
+     &      ,pplay,paprs,pphi,weak_inversion  &
+     &      ,u_seri,v_seri,t_seri,q_seri,zqsat,debut  &
+     &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  &
+     &      ,fm_therm,entr_therm,zqasc,clwcon0,lmax,ratqscth,  &
+     &       ratqsdiff,zqsatth)
+
+      implicit none
+#include "dimensions.h"
+#include "dimphy.h"
+#include "thermcell.h"
+
+!  A inclure eventuellement dans les fichiers de configuration
+      data r_aspect_thermals,l_mix_thermals,tho_thermals/2.,30.,0./
+      data w2di_thermals/0/
+
+      REAL dtime
+      LOGICAL debut
+      REAL u_seri(klon,klev),v_seri(klon,klev)
+      REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev)
+      REAL weak_inversion(klon)
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL pphi(klon,klev)
+      real zlev(klon,klev+1) 
+
+!FH Update Thermiques
+      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
+      REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
+      real fm_therm(klon,klev+1),entr_therm(klon,klev)
+
+!********************************************************
+!     declarations
+      real fmc_therm(klon,klev+1),zqasc(klon,klev)
+      real zqla(klon,klev)
+      real wmax_sec(klon)
+      real zmax_sec(klon)
+      real f_sec(klon)
+      real detrc_therm(klon,klev)
+      save fmc_therm, detrc_therm
+      real clwcon0(klon,klev)
+      real zqsat(klon,klev)
+      real zw_sec(klon,klev+1)
+      integer lmix_sec(klon)
+      integer lmax(klon)
+      real ratqscth(klon,klev)
+      real ratqsdiff(klon,klev)
+      real zqsatth(klon,klev)  
+!********************************************************
+
+
+! variables locales
+      REAL d_t_the(klon,klev), d_q_the(klon,klev)
+      REAL d_u_the(klon,klev),d_v_the(klon,klev)
+!
+      real zfm_therm(klon,klev+1),zentr_therm(klon,klev),zdt
+      save zentr_therm,zfm_therm
+
+      integer i,k
+
+!********************************************************
+
+!  Modele du thermique
+!  ===================
+!         print*,'thermiques: WARNING on passe t au lieu de t_seri'
+
+
+         fm_therm(:,:)=0.
+         entr_therm(:,:)=0.
+       print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
+
+
+!   tests sur les valeurs negatives de l'eau
+         do k=1,klev
+            do i=1,klon
+               if (.not.q_seri(i,k).ge.0.) then
+                   print*,'WARN eau<0 avant therm i=',i,'  k=',k  &
+     &         ,' dq,q',d_q_the(i,k),q_seri(i,k)
+                  q_seri(i,k)=1.e-15
+               endif
+            enddo
+         enddo
+
+
+         zdt=dtime/float(nsplit_thermals)
+         do isplit=1,nsplit_thermals
+
+          if (iflag_thermals.eq.1) then
+            CALL thermcell_2002(klon,klev,zdt   &
+     &      ,pplay,paprs,pphi  &
+     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+     &      ,zfm_therm,zentr_therm  &
+     &      ,r_aspect_thermals,30.,w2di_thermals  &
+     &      ,tho_thermals,3)
+          else if (iflag_thermals.eq.2) then
+            CALL thermcell_sec(klon,klev,zdt  &
+     &      ,pplay,paprs,pphi,zlev  &
+     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+     &      ,zfm_therm,zentr_therm  &
+     &      ,r_aspect_thermals,30.,w2di_thermals  &
+     &      ,tho_thermals,3)
+          else if (iflag_thermals.eq.3) then
+            CALL thermcell(klon,klev,zdt  &
+     &      ,pplay,paprs,pphi  &
+     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+     &      ,zfm_therm,zentr_therm  &
+     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
+     &      ,tho_thermals,3)
+          else if (iflag_thermals.eq.10) then
+            CALL thermcell_eau(klon,klev,zdt  &
+     &      ,pplay,paprs,pphi  &
+     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+     &      ,zfm_therm,zentr_therm  &
+     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
+     &      ,tho_thermals,3)
+          else if (iflag_thermals.eq.11) then
+            stop'cas non prevu dans calltherm'
+!           CALL thermcell_pluie(klon,klev,zdt  &
+!   &      ,pplay,paprs,pphi,zlev  &
+!    &      ,u_seri,v_seri,t_seri,q_seri  &
+!    &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+!    &      ,zfm_therm,zentr_therm,zqla  &
+!    &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
+!    &      ,tho_thermals,3)
+          else if (iflag_thermals.eq.12) then
+            CALL calcul_sec(klon,klev,zdt  &
+     &      ,pplay,paprs,pphi,zlev  &
+     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,zmax_sec,wmax_sec,zw_sec,lmix_sec  &
+     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
+     &      ,tho_thermals)
+!            CALL calcul_sec_entr(klon,klev,zdt
+!     s      ,pplay,paprs,pphi,zlev,debut
+!     s      ,u_seri,v_seri,t_seri,q_seri                
+!     s      ,zmax_sec,wmax_sec,zw_sec,lmix_sec
+!     s      ,r_aspect_thermals,l_mix_thermals,w2di_thermals
+!     s      ,tho_thermals,3)
+!           CALL thermcell_pluie_detr(klon,klev,zdt  &
+!    &      ,pplay,paprs,pphi,zlev,debut  &
+!    &      ,u_seri,v_seri,t_seri,q_seri  &
+!    &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+!    &      ,zfm_therm,zentr_therm,zqla,lmax  &
+!    &      ,zmax_sec,wmax_sec,zw_sec,lmix_sec  &
+!    &      ,ratqscth,ratqsdiff,zqsatth  &
+!    &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
+!    &      ,tho_thermals)
+          else if (iflag_thermals.ge.13) then
+            CALL thermcell_main(klon,klev,zdt  &
+     &      ,pplay,paprs,pphi,debut  &
+     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+     &      ,zfm_therm,zentr_therm,zqla,lmax  &
+     &      ,ratqscth,ratqsdiff,zqsatth  &
+     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
+     &      ,tho_thermals)
+         endif
+
+
+      DO i=1,klon
+      DO k=1,klev
+            IF(iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5) THEN
+
+!  transformation de la derivee en tendance
+            d_t_the(i,k)=d_t_the(i,k)*dtime/float(nsplit_thermals)
+            d_u_the(i,k)=d_u_the(i,k)*dtime/float(nsplit_thermals)
+            d_v_the(i,k)=d_v_the(i,k)*dtime/float(nsplit_thermals)
+            d_q_the(i,k)=d_q_the(i,k)*dtime/float(nsplit_thermals)
+            fm_therm(i,k)=fm_therm(i,k)  &
+     &      +zfm_therm(i,k)/float(nsplit_thermals)
+            entr_therm(i,k)=entr_therm(i,k)  &
+     &       +zentr_therm(i,k)/float(nsplit_thermals)
+            fm_therm(:,klev+1)=0.
+
+
+
+!  accumulation de la tendance
+            d_t_ajs(i,k)=d_t_ajs(i,k)+d_t_the(i,k)
+            d_u_ajs(i,k)=d_u_ajs(i,k)+d_u_the(i,k)
+            d_v_ajs(i,k)=d_v_ajs(i,k)+d_v_the(i,k)
+            d_q_ajs(i,k)=d_q_ajs(i,k)+d_q_the(i,k)
+
+!  incrementation des variables meteo
+            t_seri(i,k) = t_seri(i,k) + d_t_the(i,k)
+            u_seri(i,k) = u_seri(i,k) + d_u_the(i,k)
+            v_seri(i,k) = v_seri(i,k) + d_v_the(i,k)
+            qmemoire(i,k)=q_seri(i,k)
+            q_seri(i,k) = q_seri(i,k) + d_q_the(i,k)
+           ENDIF
+       ENDDO
+       ENDDO
+
+!   tests sur les valeurs negatives de l'eau
+            DO k = 1, klev
+            DO i = 1, klon
+               if (.not.q_seri(i,k).ge.0.) then
+                   print*,'WARN eau<0 apres therm i=',i,'  k=',k  &
+     &         ,' dq,q',d_q_the(i,k),q_seri(i,k),  &
+     &         'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k)
+                  q_seri(i,k)=1.e-15
+!       stop
+               endif
+            ENDDO
+            ENDDO
+! tests sur les valeurs de la temperature
+            DO k = 1, klev
+            DO i = 1, klon
+               if ((t_seri(i,k).lt.50.) .or.  &
+     &              (t_seri(i,k).gt.370.)) then
+                  print*,'WARN temp apres therm i=',i,'  k=',k  &
+     &         ,' t_seri',t_seri(i,k)
+!              CALL abort
+               endif
+            ENDDO
+            ENDDO
+
+         enddo ! isplit
+
+!
+!***************************************************************
+!     calcul du flux ascencant conservatif
+!            print*,'<<<<calcul flux ascendant conservatif'
+
+      fmc_therm=0.
+               do k=1,klev
+            do i=1,klon
+                  if (entr_therm(i,k).gt.0.) then
+                     fmc_therm(i,k+1)=fmc_therm(i,k)+entr_therm(i,k)
+                  else
+                     fmc_therm(i,k+1)=fmc_therm(i,k)
+                  endif
+                  detrc_therm(i,k)=(fmc_therm(i,k+1)-fm_therm(i,k+1))  &
+     &                 -(fmc_therm(i,k)-fm_therm(i,k))
+               enddo
+            enddo
+      
+     
+!****************************************************************
+!     calcul de l'humidite dans l'ascendance
+!      print*,'<<<<calcul de lhumidite dans thermique'
+!CR:on ne le calcule que pour le cas sec
+      if (iflag_thermals.le.11) then      
+      do i=1,klon
+         zqasc(i,1)=q_seri(i,1)
+         do k=2,klev
+            if (fmc_therm(i,k+1).gt.1.e-6) then
+               zqasc(i,k)=(fmc_therm(i,k)*zqasc(i,k-1)  &
+     &              +entr_therm(i,k)*q_seri(i,k))/fmc_therm(i,k+1)
+!CR:test on asseche le thermique
+!               zqasc(i,k)=zqasc(i,k)/2.
+!            else
+!               zqasc(i,k)=q_seri(i,k)
+            endif
+         enddo
+       enddo
+      
+
+!     calcul de l'eau condensee dans l'ascendance
+!             print*,'<<<<calcul de leau condensee dans thermique'
+             do i=1,klon
+                do k=1,klev
+                   clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
+                   if (clwcon0(i,k).lt.0. .or.   &
+     &             (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
+                      clwcon0(i,k)=0.
+                   endif
+                enddo
+             enddo
+       else
+              do i=1,klon
+                do k=1,klev
+                   clwcon0(i,k)=zqla(i,k)  
+                   if (clwcon0(i,k).lt.0. .or.   &
+     &             (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
+                   clwcon0(i,k)=0. 
+                   endif
+                enddo
+             enddo
+       endif
+!*******************************************************************    
+
+
+      return
+
+      end
Index: LMDZ4/trunk/libf/phylmd/clouds_gno.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/clouds_gno.F	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/clouds_gno.F	(revision 878)
@@ -219,5 +219,17 @@
 c -- test numerical convergence:
 
-c         print*,'avant test ',i,k,lconv(i),u(i),v(i)
+          if (beta(i).lt.1.e-10) then
+              print*,'avant test ',i,k,lconv(i),u(i),v(i),beta(i)
+              stop
+          endif
+          if (abs(fprime(i)).lt.1.e-11) then
+              print*,'avant test fprime<.e-11 '
+     s        ,i,k,lconv(i),u(i),v(i),beta(i),fprime(i)
+              print*,'klon,ND,R,RS,QSUB',
+     s        klon,ND,R(i,k),rs(i,k),qsub(i,k)
+              fprime(i)=sign(1.e-11,fprime(i))
+          endif
+
+
           if ( ABS(dist(i)/beta(i)) .LT. epsilon ) then 
 c           print*,'v-u **2',(v(i)-u(i))**2
Index: LMDZ4/trunk/libf/phylmd/coef_diff_turb_mod.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/coef_diff_turb_mod.F90	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/coef_diff_turb_mod.F90	(revision 878)
@@ -18,5 +18,5 @@
   SUBROUTINE coef_diff_turb(dtime, nsrf, knon, ni, &
        ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, &
-       ycoefm, ycoefh)
+       ycoefm, ycoefh ,yq2)
 ! 
 ! Calculate coefficients(ycoefm, ycoefh) for turbulent diffusion in the 
@@ -35,4 +35,5 @@
     REAL, DIMENSION(klon,klev), INTENT(IN)     :: yq, yt
     REAL, DIMENSION(klon), INTENT(IN)          :: yts, yrugos, yqsurf
+    REAL, DIMENSION(klon,klev+1)               :: yq2
   
 ! Output arguments
@@ -41,16 +42,9 @@
     REAL, DIMENSION(klon,klev), INTENT(OUT)    :: ycoefm
 
-! Local variables with attribute SAVE
-!****************************************************************************************
-    REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: q2save
-    !$OMP THREADPRIVATE(q2save)
-    LOGICAL, SAVE                              :: first_call=.TRUE.
-    !$OMP THREADPRIVATE(first_call)    
-
 ! Other local variables
 !****************************************************************************************
     INTEGER                                    :: k, i, j
     REAL, DIMENSION(klon,klev)                 :: ycoefm0, ycoefh0, yzlay, yteta
-    REAL, DIMENSION(klon,klev+1)               :: yzlev, yq2, q2diag, ykmm, ykmn, ykmq
+    REAL, DIMENSION(klon,klev+1)               :: yzlev, q2diag, ykmm, ykmn, ykmq
     REAL, DIMENSION(klon)                      :: y_cd_h, y_cd_m
     REAL, DIMENSION(klon)                      :: yustar
@@ -94,5 +88,5 @@
             ycoefm0, ycoefh0)
 
-       DO k = 1, klev
+       DO k = 2, klev
           DO i = 1, knon
              ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
@@ -121,5 +115,5 @@
             ycoefm0,ycoefh0)
        
-       DO k = 1, klev
+       DO k = 2, klev
           DO i = 1, knon
              ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
@@ -137,12 +131,4 @@
 
     IF (iflag_pbl.GE.3) THEN
-
-       IF (first_call) THEN
-          PRINT*, "Using method MELLOR&YAMADA"
-          ! NB! q2save could/should be read and written from (re)startphy.nc
-          ALLOCATE(q2save(klon,klev+1,nbsrf))
-          q2save(:,:,:) = 1.e-8
-          first_call=.FALSE.
-       END IF
 
        yzlay(1:knon,1)= &
@@ -173,21 +159,13 @@
        END DO
 
-! Compresse q2save
-       DO k = 1, klev+1
-          DO j = 1, knon
-             i = ni(j)
-             yq2(j,k)=q2save(i,k,nsrf)
-          ENDDO
-       ENDDO
-         
-!   Bug introduit volontairement pour converger avec les resultats
-!   du papier sur les thermiques.
-       IF (1.EQ.1) THEN
-          y_cd_m(1:knon) = ycoefm(1:knon,1)
-          y_cd_h(1:knon) = ycoefh(1:knon,1)
-       ELSE
-          y_cd_h(1:knon) = ycoefm(1:knon,1)
-          y_cd_m(1:knon) = ycoefh(1:knon,1)
-       ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Pour memoire, le papier Hourdin et al. 2002 a ete obtenur avec un
+! bug sur les coefficients de surface :
+!          y_cd_h(1:knon) = ycoefm(1:knon,1)
+!          y_cd_m(1:knon) = ycoefh(1:knon,1)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+       y_cd_m(1:knon) = ycoefm(1:knon,1)
+       y_cd_h(1:knon) = ycoefh(1:knon,1)
        
        CALL ustarhb(knon,yu,yv,y_cd_m, yustar)
@@ -215,12 +193,4 @@
        ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
                 
-! update q2save with yq2
-       DO j=1,knon
-          DO k=1,klev+1
-             i=ni(j)
-             q2save(i,k,nsrf) = yq2(j,k)
-          END DO
-       END DO
-       
     ENDIF !(iflag_pbl.ge.3)
 
Index: LMDZ4/trunk/libf/phylmd/conf_phys.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/conf_phys.F90	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/conf_phys.F90	(revision 878)
@@ -6,7 +6,7 @@
 
   subroutine conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, ok_hf, &
+ &                     seuil_inversion, &
  &                     fact_cldcon, facttemps,ok_newmicro,iflag_cldcon, &
-!IM&                   ratqsbas,ratqshaut,ip_ebil_phy, &
- &                     ratqsbas,ratqshaut, &
+ &                     iflag_ratqs,ratqsbas,ratqshaut, &
  &		       ok_ade, ok_aie, &
  &                     bl95_b0, bl95_b1,&
@@ -51,4 +51,5 @@
   real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut
   integer              :: iflag_cldcon
+  integer              :: iflag_ratqs
 
   character (len = 6),SAVE  :: ocean_omp
@@ -61,8 +62,12 @@
   real,SAVE           :: ratqshaut_omp
   integer,SAVE        :: iflag_cldcon_omp, ip_ebil_phy_omp
+  integer,SAVE        :: iflag_ratqs_omp
 
 ! Local
   integer              :: numout = 6
   real                 :: zzz
+
+  real :: seuil_inversion
+  real,save :: seuil_inversion_omp
 
   integer :: iflag_thermals,nsplit_thermals
@@ -82,5 +87,5 @@
   REAL,SAVE :: cdmmax_omp,cdhmax_omp,ksta_omp,ksta_ter_omp
   LOGICAL,SAVE :: ok_kzmin_omp
-  REAL, SAVE ::  fmagic_omp
+  REAL, SAVE :: fmagic_omp
   INTEGER,SAVE :: iflag_pbl_omp,lev_histhf_omp,lev_histday_omp,lev_histmth_omp
   CHARACTER*4, SAVE :: type_run_omp
@@ -207,7 +212,15 @@
 !Config Help = 
 !               
-!
   ip_ebil_phy_omp = 0
   call getin('ip_ebil_phy', ip_ebil_phy_omp)
+!
+!Config Key  = seuil_inversion
+!Config Desc = Seuil ur dTh pour le choix entre les schemas de CL
+!Config Def  = -0.1
+!Config Help = 
+!               
+  seuil_inversion_omp = -0.1
+  call getin('seuil_inversion', seuil_inversion_omp)
+
 !!
 !! Constante solaire & Parametres orbitaux & taux gaz effet de serre BEG
@@ -438,4 +451,13 @@
   reevap_ice_omp = .false.
   call getin('reevap_ice',reevap_ice_omp)
+
+!Config Key  = iflag_ratqs
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  iflag_ratqs_omp = 1
+  call getin('iflag_ratqs',iflag_ratqs_omp)
+
 !
 !Config Key  = iflag_cldcon 
@@ -835,4 +857,5 @@
     ratqshaut = ratqshaut_omp
     iflag_cldcon = iflag_cldcon_omp
+    iflag_ratqs = iflag_ratqs_omp
     ip_ebil_phy = ip_ebil_phy_omp
     iflag_thermals = iflag_thermals_omp
@@ -840,4 +863,5 @@
     type_run = type_run_omp
     ok_isccp = ok_isccp_omp
+    seuil_inversion=seuil_inversion_omp
     lonmin_ins = lonmin_ins_omp
     lonmax_ins = lonmax_ins_omp
@@ -891,4 +915,6 @@
   write(numout,*)' iflag_pdf = ', iflag_pdf
   write(numout,*)' iflag_cldcon = ', iflag_cldcon
+  write(numout,*)' iflag_ratqs = ', iflag_ratqs
+  write(numout,*)' seuil_inversion = ', seuil_inversion
   write(numout,*)' fact_cldcon = ', fact_cldcon
   write(numout,*)' facttemps = ', facttemps
Index: LMDZ4/trunk/libf/phylmd/dimphy.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/dimphy.h	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/dimphy.h	(revision 878)
@@ -2,12 +2,12 @@
 ! $Header$
 !
-c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
       INTEGER KIDIA, KFDIA, KLON, KLEV
-      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2-1/jjm,
-     .           KLON=KFDIA-KIDIA+1,KLEV=llm)
-c-----------------------------------------------------------------------
+      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2-1/jjm)
+      PARAMETER (KLON=KFDIA-KIDIA+1,KLEV=llm)
+!-----------------------------------------------------------------------
       INTEGER nbtr ! nombre de vrais traceurs
       PARAMETER (nbtr=nqmx-2+1/(nqmx-1))
-c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
       REAL zmasq(KLON)
       COMMON/terreoce/zmasq
Index: LMDZ4/trunk/libf/phylmd/ini_histday.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/ini_histday.h	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/ini_histday.h	(revision 878)
@@ -53,4 +53,13 @@
 c Champs 2D:
 c
+         CALL histdef(nid_day, "weakinv", "Weak inversion", "",
+     s           iim,jjmp1,nhori, 1,1,1, -99, 32,
+     s           "ave(X)", zstophy,zout)
+
+         CALL histdef(nid_day, "dthmin", "dTheta mini", "K/m",
+     s           iim,jjmp1,nhori, 1,1,1, -99, 32,
+     s           "ave(X)", zstophy,zout)
+
+
          CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
      .                iim,jj_nb,nhori, 1,1,1, -99, 32, 
@@ -538,4 +547,20 @@
      $         "ave(X)", zstophy,zout)
 C
+
+
+! FH Sorties specifiques pour Mellor et Yamada
+      if (iflag_pbl>1 .and. lev_histday.gt.10 ) then
+           call histdef(nid_day, "tke_"//clnsurf(nsrf), 
+     $         "Max Turb. Kinetic Energy "//clnsurf(nsrf), "-",  
+     $         iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     $         "ave(X)", zstophy,zout)
+
+           call histdef(nid_day, "tke_max_"//clnsurf(nsrf), 
+     $         "Max Turb. Kinetic Energy "//clnsurf(nsrf), "-",  
+     $         iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     $         "t_max(X)", zstophy,zout)
+      endif	
+
+C
          END DO 
 C           
Index: LMDZ4/trunk/libf/phylmd/ini_histmth.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/ini_histmth.h	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/ini_histmth.h	(revision 878)
@@ -700,4 +700,24 @@
       IF(lev_histmth.GE.4) THEN
 c
+!FH Sorties pour la couche limite
+      if (iflag_pbl>1) then
+         CALL histdef(nid_mth, "tke","TKE","m2/s2",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+c
+         CALL histdef(nid_mth, "tke_max","TKE max","m2/s2",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "t_max(X)", zstophy,zout)
+      endif
+c
+         CALL histdef(nid_mth, "kz","Kz melange","m2/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+c
+         CALL histdef(nid_mth, "kz_max","Kz melange max","m2/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "t_max(X)", zstophy,zout)
+
+
          CALL histdef(nid_mth, "clwcon", 
      .                "Convective Cloud Liquid water content"
@@ -730,4 +750,7 @@
      .                "ave(X)", zstophy,zout)
 c
+
+
+c
 c        CALL histdef(nid_mth, "ducon", "Convection du", "m/s2",
 c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
@@ -774,4 +797,12 @@
      .                "ave(X)", zstophy,zout)
 
+c
+         CALL histdef(nid_mth, "dtthe", "Dry adjust. dT", "K/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+
+         CALL histdef(nid_mth,"dqthe","Dry adjust. dQ","(kg/kg)/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
 c
          CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
@@ -879,10 +910,10 @@
          if (nqmax.GE.3) THEN
            DO iq=3,nqmax
-           iiq=niadv(iq)
+             iiq=niadv(iq)
              CALL histdef(nid_mth, tnom(iq), ttext(iiq), "-",
      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zstophy,zout)
-           ENDDO
-         ENDIF
+             ENDDO
+           ENDIF
 #endif
 c
@@ -960,4 +991,12 @@
 c
           CALL histdef(nid_mth, "dtcon","dtcon","K/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+c
+         CALL histdef(nid_mth, "dtthe", "Dry adjust. dT", "K/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+
+         CALL histdef(nid_mth,"dqthe","Dry adjust. dQ","(kg/kg)/s",
      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zstophy,zout)
@@ -1668,4 +1707,26 @@
       IF(lev_histmth.GE.4) THEN
 c
+!FH Sorties pour la couche limite
+      if (iflag_pbl>1) then
+         CALL histdef(nid_mth, "tke","TKE","m2/s2",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+c
+         CALL histdef(nid_mth, "tke_max","TKE max","m2/s2",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "t_max(X)", zstophy,zout)
+      endif
+c
+         CALL histdef(nid_mth, "kz","Kz melange","m2/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+c
+         CALL histdef(nid_mth, "kz_max","Kz melange max","m2/s",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "t_max(X)", zstophy,zout)
+
+
+
+
          CALL histdef(nid_mth, "clwcon", 
      .                "Convective Cloud Liquid water content"
@@ -1831,11 +1892,11 @@
 #ifndef INCA
          if (nqmax.GE.3) THEN
-           DO iq=3,nqmax
-             iiq=niadv(iq)
-             CALL histdef(nid_mth, tnom(iq), ttext(iiq), "-",
-     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zstophy,zout)
-             ENDDO
-           ENDIF
+         DO iq=3,nqmax
+         iiq=niadv(iq)
+         CALL histdef(nid_mth, tnom(iq), ttext(iiq), "-",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zstophy,zout)
+         ENDDO
+         ENDIF
 #endif
 
Index: LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90	(revision 878)
@@ -197,5 +197,5 @@
        wfbils,    wfbilo,    flux_t,   flux_u, flux_v,&
        dflux_t,   dflux_q,   zxsnow,                  &
-       zxfluxt,   zxfluxq,   q2m,      flux_q )
+       zxfluxt,   zxfluxq,   q2m,      flux_q, tke    )
 !****************************************************************************************
 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
@@ -240,4 +240,5 @@
 ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
 !                    (orientation positive vers le bas)
+! tke---input/output-R- tke (kg/m**2/s)
 ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
 ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
@@ -348,4 +349,7 @@
     REAL, DIMENSION(klon, nbsrf),INTENT(OUT)        :: q2m
     REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q
+
+! Input/output
+    REAL, DIMENSION(klon, klev+1, nbsrf), INTENT(INOUT) :: tke
 
 
@@ -421,4 +425,5 @@
     REAL, DIMENSION(klon,klev)         :: delp
     REAL, DIMENSION(klon,klev+1)       :: ypaprs
+    REAL, DIMENSION(klon,klev+1)       :: ytke
     REAL, DIMENSION(klon,nsoilmx)      :: ytsoil
     REAL, DIMENSION(klon,nbsrf)        :: pctsrf_pot
@@ -451,4 +456,9 @@
 
 
+!jg+ temporary test
+    REAL, DIMENSION(klon,klev)         :: y_flux_u_old, y_flux_v_old
+    REAL, DIMENSION(klon,klev)         :: y_d_u_old, y_d_v_old
+!jg-
+    
 !****************************************************************************************
 ! End of declarations
@@ -514,5 +524,5 @@
     flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0      
     d_u = 0.0     ; d_v = 0.0        ; zcoefh = 0.0    ; yqsol = 0.0    
-    ytherm = 0.0
+    ytherm = 0.0  ; ytke=0.
      
     ytsoil = 999999. 
@@ -657,4 +667,5 @@
              ypplay(j,k) = pplay(i,k)
              ydelp(j,k) = delp(i,k)
+             ytke(j,k)=tke(i,k,nsrf)
              yu(j,k) = u(i,k)
              yv(j,k) = v(i,k)
@@ -687,5 +698,5 @@
        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
             ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf,  &
-            ycoefm, ycoefh)
+            ycoefm, ycoefh,ytke)
        
 !****************************************************************************************
@@ -839,4 +850,5 @@
 !****************************************************************************************
 
+       tke(:,:,nsrf)=0.
        DO k = 1, klev
           DO j = 1, knon
@@ -853,4 +865,7 @@
              flux_u(i,k,nsrf) = y_flux_u(j,k)
              flux_v(i,k,nsrf) = y_flux_v(j,k)
+
+             tke(i,k,nsrf)=ytke(j,k)
+
           ENDDO
        ENDDO
Index: LMDZ4/trunk/libf/phylmd/phyetat0.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/phyetat0.F	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/phyetat0.F	(revision 878)
@@ -13,5 +13,5 @@
      .           rugsrel_p,tabcntr0,
      .           t_ancien_p,q_ancien_p,ancien_ok_p, rnebcon_p, ratqs_p,
-     .           clwcon_p)
+     .           clwcon_p,pbl_tke_p)
 
       USE dimphy
@@ -37,4 +37,6 @@
 #include "clesphys.h"
 #include "temps.h"
+#include "thermcell.h"
+#include "compbl.h"
 c======================================================================
       CHARACTER*(*) fichnom
@@ -45,4 +47,5 @@
       REAL solaire_etat0
       REAL tsol_p(klon,nbsrf)
+      REAL pbl_tke_p(klon,klev,nbsrf)
       REAL tsoil_p(klon,nsoilmx,nbsrf)
       REAL tslab_p(klon), seaice_p(klon)
@@ -83,4 +86,5 @@
       REAL rlat(klon_glo), rlon(klon_glo)
       REAL tsol(klon_glo,nbsrf)
+      REAL pbl_tke(klon_glo,klev,nbsrf)
       REAL tsoil(klon_glo,nsoilmx,nbsrf)
 cIM "slab" ocean
@@ -127,5 +131,5 @@
 c
       INTEGER nid, nvarid
-      INTEGER ierr, i, nsrf, isoil 
+      INTEGER ierr, i, nsrf, isoil ,k
       INTEGER length
       PARAMETER (length=100)
@@ -1492,4 +1496,46 @@
       xmax = MAXval(run_off_lic_0)
       PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax
+
+
+c Lecture de l'energie cinetique turbulente
+c
+
+      IF (iflag_pbl>1) then
+         PRINT*, 'phyetat0: Le champ <TKE> est absent'
+         PRINT*, '          Mais je vais essayer de lire TKE**'
+         DO nsrf = 1, nbsrf
+           IF (nsrf.GT.99) THEN
+             PRINT*, "Trop de sous-mailles"
+             CALL abort
+           ENDIF
+           WRITE(str2,'(i2.2)') nsrf
+           ierr = NF_INQ_VARID (nid, "TKE"//str2, nvarid)
+           IF (ierr.NE.NF_NOERR) THEN
+              PRINT*, "WARNING phyetat0: <TKE"//str2//"> est absent"
+              pbl_tke(:,:,nsrf)=1.e-8
+           ELSE
+#ifdef NC_DOUBLE
+              ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pbl_tke(1,1,nsrf))
+#else
+              ierr = NF_GET_VAR_REAL(nid, nvarid, pbl_tke(1,1,nsrf))
+#endif
+              IF (ierr.NE.NF_NOERR) THEN
+                PRINT*, "WARNING phyetat0: echec lect <TKE"//str2//">"
+                CALL abort
+              ENDIF
+           ENDIF
+
+           xmin = 1.0E+20
+           xmax = -1.0E+20
+           DO k = 1, klev
+           DO i = 1, klon_glo
+              xmin = MIN(pbl_tke(i,k,nsrf),xmin)
+              xmax = MAX(pbl_tke(i,k,nsrf),xmax)
+           ENDDO
+           ENDDO
+           PRINT*,'Temperature du sol TKE**:', nsrf, xmin, xmax
+         ENDDO
+      ENDIF
+
 c
 c Fermer le fichier:
@@ -1516,4 +1562,7 @@
       call Scatter( rlon,rlon_p)
       call Scatter( tsol,tsol_p)
+      IF (iflag_pbl>1) then
+         call Scatter( pbl_tke,pbl_tke_p)
+      endif
       call Scatter( tsoil,tsoil_p)
       call Scatter( tslab,tslab_p)
Index: LMDZ4/trunk/libf/phylmd/phyredem.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/phyredem.F	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/phyredem.F	(revision 878)
@@ -9,5 +9,6 @@
      .           radsol_p,zmea_p,zstd_p,zsig_p,
      .           zgam_p,zthe_p,zpic_p,zval_p,rugsrel_p,
-     .           t_ancien_p, q_ancien_p, rnebcon_p, ratqs_p, clwcon_p)
+     .           t_ancien_p, q_ancien_p, rnebcon_p, ratqs_p, clwcon_p,
+     .           pbl_tke_p)
 
       USE dimphy
@@ -29,4 +30,6 @@
 #include "control.h"
 #include "temps.h"
+#include "thermcell.h"
+#include "compbl.h"
 c======================================================================
       CHARACTER*(*) fichnom
@@ -35,4 +38,5 @@
       REAL rlat_p(klon), rlon_p(klon)
       REAL tsol_p(klon,nbsrf)
+      REAL pbl_tke_p(klon,klev,nbsrf)
       REAL tsoil_p(klon,nsoilmx,nbsrf)
       CHARACTER*6 ocean
@@ -70,4 +74,5 @@
       REAL rlat(klon_glo), rlon(klon_glo)
       REAL tsol(klon_glo,nbsrf)
+      REAL pbl_tke(klon_glo,klev,nbsrf)
       REAL tsoil(klon_glo,nsoilmx,nbsrf)
       REAL tslab(klon_glo), seaice(klon_glo)
@@ -135,4 +140,5 @@
       call Gather( rlon_p,rlon)
       call Gather( tsol_p,tsol)
+      call Gather( pbl_tke_p,pbl_tke)
       call Gather( tsoil_p,tsoil)
       call Gather( tslab_p,tslab)
@@ -899,4 +905,35 @@
 c
 c
+!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
+c
+      IF (iflag_pbl>1) then
+      DO nsrf = 1, nbsrf
+        IF (nsrf.LE.99) THEN
+            WRITE(str2,'(i2.2)') nsrf
+            ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+            ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_DOUBLE,1,idim3
+     $          ,nvarid)
+#else
+            ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_FLOAT,1,idim3
+     $          ,nvarid)
+#endif
+            ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
+     .                        "Energ. Cineti. Turb."//str2)
+            ierr = NF_ENDDEF(nid)
+        ELSE
+            PRINT*, "Trop de sous-mailles"
+            CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pbl_tke(:,:,nsrf))
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pbl_tke(:,:,nsrf))
+#endif
+      ENDDO
+      ENDIF
+
+!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
+c
       ierr = NF_CLOSE(nid)
 c
Index: LMDZ4/trunk/libf/phylmd/physiq.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/physiq.F	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/physiq.F	(revision 878)
@@ -177,4 +177,21 @@
       REAL fm_therm(klon,klev+1)
       REAL entr_therm(klon,klev)
+      real,allocatable,save :: clwcon0th(:,:),rnebcon0th(:,:)
+c$OMP THREADPRIVATE(clwcon0th,rnebcon0th)
+
+      real weak_inversion(klon),dthmin(klon)
+      real seuil_inversion
+      save seuil_inversion
+c$OMP THREADPRIVATE(seuil_inversion)
+      integer iflag_ratqs
+      save iflag_ratqs
+c$OMP THREADPRIVATE(iflag_ratqs)
+
+      integer lmax_th(klon)
+      integer limbas(klon)
+      real ratqscth(klon,klev)
+      real ratqsdiff(klon,klev)
+      real zqsatth(klon,klev)
+
 c======================================================================
 c
@@ -929,4 +946,8 @@
       REAL fluxu(klon,klev, nbsrf)   ! flux turbulent de vitesse u
       REAL fluxv(klon,klev, nbsrf)   ! flux turbulent de vitesse v
+
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: pbl_tke ! turb kinetic energy
+c   !$OMP THREADPRIVATE(pbl_tke)
+
 c
       REAL zxfluxt(klon, klev)
@@ -1050,4 +1071,5 @@
 c$OMP THREADPRIVATE(d_u_con,d_v_con)
       REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
+      REAL d_t_ajsb(klon,klev), d_q_ajsb(klon,klev)
       REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
       REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
@@ -1471,4 +1493,5 @@
 #endif
       allocate( clwcon0(klon,klev),rnebcon0(klon,klev))
+      allocate( clwcon0th(klon,klev),rnebcon0th(klon,klev))
       allocate( tau_ae(klon,klev,2), piz_ae(klon,klev,2))
       allocate( cg_ae(klon,klev,2))
@@ -1507,4 +1530,6 @@
          CALL suphec ! initialiser constantes et parametres phys.
       ENDIF
+
+      print*,'CONVERGENCE PHYSIQUE THERM 1 '
 
 
@@ -1567,8 +1592,7 @@
 c
          call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel,
-     .                  ok_instan, ok_hf,
+     .                  ok_instan, ok_hf, seuil_inversion,
      .                  fact_cldcon, facttemps,ok_newmicro,
-cIM  .                  iflag_cldcon,ratqsbas,ratqshaut, if_ebil,
-     .                  iflag_cldcon,ratqsbas,ratqshaut,
+     .                  iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,
      .                  ok_ade, ok_aie, 
      .                  bl95_b0, bl95_b1,
@@ -1581,4 +1605,16 @@
          itap    = 0
          itaprad = 0
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Un petit travail à faire ici.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+         if (iflag_pbl>1) then
+             PRINT*, "Using method MELLOR&YAMADA" 
+         endif
+          ! NB! pbl_tke could/should be read and written from (re)startphy.nc
+          ALLOCATE(pbl_tke(klon,klev+1,nbsrf))  
+          pbl_tke(:,:,:) = 1.e-8 
+
 
          CALL phyetat0 ("startphy.nc",dtime,co2_ppm_etat0,solaire_etat0,
@@ -1589,5 +1625,12 @@
      .       radsol,clesphy0,
      .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
-     .       t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon)
+     .       t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon,
+     .       pbl_tke)
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 
        DO i=1,klon
@@ -1620,5 +1663,6 @@
      .                        pdtphys
             abort_message='Pas physique n est pas correct '
-            call abort_gcm(modname,abort_message,1)
+!           call abort_gcm(modname,abort_message,1)
+            dtime=pdtphys
          ENDIF
          IF (nlon .NE. klon) THEN
@@ -1670,9 +1714,20 @@
          ENDIF
 
+           rugoro=0.
 c34EK
          IF (ok_orodr) THEN
-           DO i=1,klon
-             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
-           ENDDO
+
+           rugoro=0.
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH sans doute a enlever de finitivement ou, si on le garde, l'activer
+! justement quand ok_orodr = false.
+! ce rugoro est utilise par la couche limite et fait double emploi
+! avec les paramétrisations spécifiques de Francois Lott.
+!           DO i=1,klon
+!             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
+!           ENDDO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
            CALL SUGWD(klon,klev,paprs,pplay)
            DO i=1,klon
@@ -2088,5 +2143,5 @@
      d     wfbils,    wfbilo,    fluxt,   fluxu,  fluxv,
      -     dsens,     devap,     zxsnow,
-     -     zxfluxt,   zxfluxq,   q2m,     fluxq )
+     -     zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
 c
 c
@@ -2260,4 +2315,8 @@
           DO i = 1, klon
             ema_pct(i)  = paprs(i,itop_con(i))
+            if (itop_con(i).gt.klev-3) then
+               print*,'La convection monte trop haut '
+               print*,'itop_con(,',i,',)=',itop_con(i)
+            endif
           ENDDO
           DO i = 1, klon
@@ -2343,8 +2402,16 @@
 c===================================================================
 c
+       call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri
+     s ,seuil_inversion,weak_inversion,dthmin)
+
+
+
+      d_t_ajsb(:,:)=0.
+      d_q_ajsb(:,:)=0.
       d_t_ajs(:,:)=0.
       d_u_ajs(:,:)=0.
       d_v_ajs(:,:)=0.
       d_q_ajs(:,:)=0.
+      clwcon0th(:,:)=0.
       fm_therm(:,:)=0.
       entr_therm(:,:)=0.
@@ -2357,22 +2424,68 @@
 c  ====
          IF(prt_level>9)WRITE(lunout,*)'pas de convection'
-      else if(iflag_thermals.eq.0) then
-
-c  Ajustement sec
-c  ==============
-         IF(prt_level>9)WRITE(lunout,*)'ajsec'
-         CALL ajsec(paprs, pplay, t_seri,q_seri, d_t_ajs, d_q_ajs)
-         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
-         q_seri(:,:) = q_seri(:,:) + d_q_ajs(:,:)
+
+
       else
+
 c  Thermiques
 c  ==========
          IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals='
      s   ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
+         print*,'JUSTE AVANT , iflag_thermals='
+     s   ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
+
+
+         if (iflag_thermals.gt.1) then
          call calltherm(pdtphys
-     s      ,pplay,paprs,pphi
-     s      ,u_seri,v_seri,t_seri,q_seri
+     s      ,pplay,paprs,pphi,weak_inversion
+     s      ,u_seri,v_seri,t_seri,q_seri,zqsat,debut
      s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
-     s      ,fm_therm,entr_therm)
+     s      ,fm_therm,entr_therm,zqasc,clwcon0th,lmax_th,ratqscth,
+     s       ratqsdiff,zqsatth)
+         endif
+
+!        call calltherm(pdtphys
+!    s      ,pplay,paprs,pphi
+!    s      ,u_seri,v_seri,t_seri,q_seri
+!    s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
+!    s      ,fm_therm,entr_therm)
+
+c  Ajustement sec
+c  ==============
+
+! Dans le cas où on active les thermiques, on fait partir l'ajustement
+! a partir du sommet des thermiques.
+! Dans le cas contraire, on demarre au niveau 1.
+
+         if (iflag_thermals.ge.13.or.iflag_thermals.eq.0) then
+
+         if(iflag_thermals.eq.0) then
+            IF(prt_level>9)WRITE(lunout,*)'ajsec'
+            limbas(:)=1
+         else
+            limbas(:)=lmax_th(:)
+         endif
+  
+! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
+! pour des test de convergence numerique.
+! Le nouveau ajsec est a priori mieux, meme pour le cas 
+! iflag_thermals = 0 (l'ancienne version peut faire des tendances
+! non nulles numeriquement pour des mailles non concernees.
+
+         if (iflag_thermals.eq.0) then
+            CALL ajsec_convV2(paprs, pplay, t_seri,q_seri
+     s      , d_t_ajsb, d_q_ajsb)
+         else
+            CALL ajsec(paprs, pplay, t_seri,q_seri,limbas
+     s      , d_t_ajsb, d_q_ajsb)
+         endif
+
+         t_seri(:,:) = t_seri(:,:) + d_t_ajsb(:,:)
+         q_seri(:,:) = q_seri(:,:) + d_q_ajsb(:,:)
+         d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
+         d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
+
+         endif
+
       endif
 c
@@ -2406,34 +2519,99 @@
          enddo
          enddo
+      else if (iflag_cldcon.eq.4) then
+         ptconvth(:,:)=.false.
+         ratqsc(:,:)=0.
+         print*,'avant clouds_gno thermique'
+         call clouds_gno
+     s   (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
+         print*,' CLOUDS_GNO OK'
       endif
 
 c   ratqs stables
 c   -------------
-      do k=1,klev
-cIM RAJOUT boucle do=i
-       do i=1, klon
-cIM         ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas)*
-cIM     s   min((paprs(:,1)-pplay(:,k))/(paprs(:,1)-30000.),1.) 
-         ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*
-     s   min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) 
-cIM      print*,' IMratqs STABLE i, k',i,k,ratqss(i,k)
-       enddo 
-      enddo
+
+      if (iflag_ratqs.eq.0) then
+
+! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
+         do k=1,klev
+            do i=1, klon
+               ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*
+     s         min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) 
+            enddo 
+         enddo
+
+! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de 
+! 300 hPa (ratqshaut), varie lineariement en fonction de la pression
+! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1
+! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2
+! Il s'agit de differents tests dans la phase de reglage du modele
+! avec thermiques.
+
+      else if (iflag_ratqs.eq.1) then
+
+         do k=1,klev
+            do i=1, klon
+               if (pplay(i,k).ge.60000.) then
+                  ratqss(i,k)=ratqsbas
+               else if ((pplay(i,k).ge.30000.).and.
+     s            (pplay(i,k).lt.60000.)) then
+                  ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*
+     s            (60000.-pplay(i,k))/(60000.-30000.)
+               else
+                  ratqss(i,k)=ratqshaut
+               endif
+            enddo
+         enddo
+
+      else
+
+         do k=1,klev
+            do i=1, klon
+               if (pplay(i,k).ge.60000.) then
+                  ratqss(i,k)=ratqsbas
+     s            *(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
+               else if ((pplay(i,k).ge.30000.).and.
+     s             (pplay(i,k).lt.60000.)) then
+                    ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*
+     s              (60000.-pplay(i,k))/(60000.-30000.)
+               else
+                    ratqss(i,k)=ratqshaut
+               endif
+            enddo
+         enddo
+      endif
+
+
 
 
 c  ratqs final
 c  -----------
-      if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2) then
-c   les ratqs sont une conbinaison de ratqss et ratqsc
-c   ratqs final
-c   1e4 (en gros 3 heures), en dur pour le moment, est le temps de
-c   relaxation des ratqs
-c         facttemps=exp(-pdtphys/1.e4)
-         facteur=exp(-pdtphys*facttemps)
-         ratqs(:,:)=max(ratqs(:,:)*facteur,ratqss(:,:))
-         ratqs(:,:)=max(ratqs(:,:),ratqsc(:,:))
-c         print*,'calcul des ratqs fini'
+
+      if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2
+     s    .or.iflag_cldcon.eq.4) then
+
+! On ajoute une constante au ratqsc*2 pour tenir compte de 
+! fluctuations turbulentes de petite echelle
+
+         do k=1,klev
+            do i=1,klon
+               if ((fm_therm(i,k).gt.1.e-10)) then
+                  ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
+               endif
+            enddo
+         enddo
+
+!   les ratqs sont une conbinaison de ratqss et ratqsc
+!   1800s, en dur pour le moment, est le temps de
+!   relaxation des ratqs
+
+         facteur=exp(-pdtphys/1800.)
+
+         print*,'WARNING ratqs a revoir '
+         ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur
+         ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
+
       else
-c   on ne prend que le ratqs stable pour fisrtilp
+!   on ne prend que le ratqs stable pour fisrtilp
          ratqs(:,:)=ratqss(:,:)
       endif
@@ -2505,5 +2683,5 @@
 cIM cf FH
 c     IF (iflag_cldcon.eq.-1) THEN ! seulement pour Tiedtke
-       IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
+      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
        snow_tiedtke=0.
 c     print*,'avant calcul de la pseudo precip '
@@ -2542,9 +2720,8 @@
       ENDDO
 
-      ELSE IF (iflag_cldcon.eq.3) THEN
+      ELSE IF (iflag_cldcon.ge.3) THEN
 c  On prend pour les nuages convectifs le max du calcul de la
 c  convection et du calcul du pas de temps precedent diminue d'un facteur
 c  facttemps
-c      facttemps=pdtphys/1.e4
       facteur = pdtphys *facttemps
       do k=1,klev
@@ -3314,5 +3491,6 @@
      .      radsol,
      .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
-     .      t_ancien, q_ancien, rnebcon, ratqs, clwcon)
+     .      t_ancien, q_ancien, rnebcon, ratqs, clwcon,
+     .      pbl_tke)
       ENDIF
       
Index: LMDZ4/trunk/libf/phylmd/stratocu_if.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/stratocu_if.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/stratocu_if.F90	(revision 878)
@@ -0,0 +1,78 @@
+  SUBROUTINE stratocu_if(klon,klev,pctsrf,paprs, pplay,t &
+,seuil_inversion,weak_inversion,dthmin)
+implicit none
+
+!======================================================================
+! J'introduit un peu de diffusion sauf dans les endroits
+! ou une forte inversion est presente
+! On peut dire qu'il represente la convection peu profonde
+!
+! Arguments:
+! klon-----input-I- nombre de points a traiter
+! paprs----input-R- pression a chaque intercouche (en Pa)
+! pplay----input-R- pression au milieu de chaque couche (en Pa)
+! t--------input-R- temperature (K)
+!
+! weak_inversion-----logical
+!======================================================================
+!
+! Arguments:
+!
+    INTEGER, INTENT(IN)                       :: klon,klev
+    REAL, DIMENSION(klon, klev+1), INTENT(IN) ::  paprs
+    REAL, DIMENSION(klon, klev), INTENT(IN)   ::  pplay
+    REAL, DIMENSION(klon, 4), INTENT(IN)   ::  pctsrf
+    REAL, DIMENSION(klon, klev), INTENT(IN)   :: t
+    
+    REAL, DIMENSION(klon), INTENT(OUT)  :: weak_inversion
+!
+! Quelques constantes et options:
+!
+    REAL seuil_inversion ! au-dela l'inversion est consideree trop faible
+!    PARAMETER (seuil=-0.1)
+
+!
+! Variables locales:
+!
+    INTEGER i, k, invb(klon)
+    REAL zl2(klon)
+    REAL dthmin(klon), zdthdp
+
+    INCLUDE "indicesol.h"
+    INCLUDE "YOMCST.h"
+
+!
+! Chercher la zone d'inversion forte
+!
+
+    DO i = 1, klon
+       invb(i) = klev
+       dthmin(i)=0.0
+    ENDDO
+    DO k = 2, klev/2-1
+       DO i = 1, klon
+          zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1)) &
+               - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)
+          zdthdp = zdthdp * 100.0
+          IF (pplay(i,k).GT.0.8*paprs(i,1) .AND. &
+               zdthdp.LT.dthmin(i) ) THEN
+             dthmin(i) = zdthdp
+             invb(i) = k
+          ENDIF
+       ENDDO
+    ENDDO
+
+
+!
+! Introduire une diffusion:
+!
+    DO i = 1, klon
+       IF ( (pctsrf(i,is_oce) < 0.5) .OR. &
+          (invb(i) == klev) .OR. (dthmin(i) > seuil_inversion) ) THEN 
+          weak_inversion(i)=1.
+       ELSE
+          weak_inversion(i)=0.
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE stratocu_if
Index: LMDZ4/trunk/libf/phylmd/thermcell.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell.F	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/thermcell.F	(revision 878)
@@ -1,14 +1,9 @@
-!
-! $Header$
-!
-
-      SUBROUTINE thermcell(ngrid,nlay,ptimestep
-     s                  ,pplay,pplev,pphi
+      SUBROUTINE calcul_sec(ngrid,nlay,ptimestep
+     s                  ,pplay,pplev,pphi,zlev
      s                  ,pu,pv,pt,po
-     s                  ,pduadj,pdvadj,pdtadj,pdoadj
-     s                  ,fm0,entr0
+     s                  ,zmax,wmax,zw2,lmix
 c    s                  ,pu_therm,pv_therm
      s                  ,r_aspect,l_mix,w2di,tho)
-      USE dimphy
+
       IMPLICIT NONE
 
@@ -18,11 +13,11 @@
 c   de "thermiques" explicitement representes
 c
-c   Reecriture a partir d'un listing papier à Habas, le 14/02/00
-c
-c   le thermique est suppose homogene et dissipe par melange avec
-c   son environnement. la longueur l_mix controle l'efficacite du
-c   melange
-c
-c   Le calcul du transport des differentes especes se fait en prenant
+c   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+c
+c   le thermique est supposé homogène et dissipé par mélange avec
+c   son environnement. la longueur l_mix contrôle l'efficacité du
+c   mélange
+c
+c   Le calcul du transport des différentes espèces se fait en prenant
 c   en compte:
 c     1. un flux de masse montant
@@ -37,6 +32,6 @@
 c   -------------
 
-cym#include "dimensions.h"
-cym#include "dimphy.h"
+#include "dimensions.h"
+#include "dimphy.h"
 #include "YOMCST.h"
 
@@ -56,5 +51,5 @@
       save idetr
       data idetr/3/
-c$OMP THREADPRIVATE(idetr)
+
 c   local:
 c   ------
@@ -89,7 +84,6 @@
       real fracc(klon,klev+1)
       real zf,zf2
-      real,allocatable,save :: thetath2(:,:),wth2(:,:)
-c$OMP THREADPRIVATE(thetath2,wth2)
-cym      common/comtherm/thetath2,wth2
+      real thetath2(klon,klev),wth2(klon,klev)
+      common/comtherm/thetath2,wth2
 
       real count_time
@@ -98,5 +92,5 @@
       data isplit/0/
       save isplit
-c$OMP THREADPRIVATE(isplit)
+
       logical sorties
       real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
@@ -116,14 +110,17 @@
       real fm(klon,klev+1),entr(klon,klev)
       real fmc(klon,klev+1)
-
+ 
 cCR:nouvelles variables
       real f_star(klon,klev+1),entr_star(klon,klev)
       real entr_star_tot(klon),entr_star2(klon)
+      real zalim(klon)
+      integer lalim(klon)
+      real norme(klon)
       real f(klon), f0(klon)
       real zlevinter(klon)
+      logical therm
       logical first
       data first /.false./
       save first
-c$OMP THREADPRIVATE(first)
 cRC
 
@@ -138,7 +135,5 @@
       save ncorrec
       data ncorrec/0/
-c$OMP THREADPRIVATE(ncorrec)
-      logical,save :: firstCall=.true.
-c$OMP THREADPRIVATE(firstCall)
+      
 c
 c-----------------------------------------------------------------------
@@ -146,11 +141,4 @@
 c   ---------------
 c
-      if (firstcall) then
-        allocate(thetath2(klon,klev),wth2(klon,klev))
-	thetath2(:,:)=0.
-	wth2(:,:)=0.
-	firstcall=.false.
-      endif
-      
        sorties=.true.
       IF(ngrid.NE.klon) THEN
@@ -165,5 +153,5 @@
 c   ---------------------------------------------------
 
-       print*,'0 OK convect8'
+c       print*,'0 OK convect8'
 
       DO 1010 l=1,nlay
@@ -178,5 +166,5 @@
 1010  CONTINUE
 
-       print*,'1 OK convect8'
+c       print*,'1 OK convect8'
 c                       --------------------
 c
@@ -291,13 +279,18 @@
 
 con ne considere que les premieres couches instables
+      therm=.false.
       do k=nlay-2,1,-1
          do ig=1,ngrid
             if (ztv(ig,k).gt.ztv(ig,k+1).and.
      s          ztv(ig,k+1).le.ztv(ig,k+2)) then
-               lentr(ig)=k
+               lentr(ig)=k+1
+               therm=.true.
             endif
           enddo
       enddo
-    
+climitation de la valeur du lentr
+c      do ig=1,ngrid
+c         lentr(ig)=min(5,lentr(ig))
+c      enddo
 c determination du lmin: couche d ou provient le thermique
       do ig=1,ngrid
@@ -309,4 +302,35 @@
                lmin(ig)=l-1
             endif
+         enddo
+      enddo
+cinitialisations
+      do ig=1,ngrid
+         zalim(ig)=0.
+         norme(ig)=0.
+         lalim(ig)=1
+      enddo
+      do k=1,klev-1
+         do ig=1,ngrid
+       zalim(ig)=zalim(ig)+zlev(ig,k)*MAX(0.,(ztv(ig,k)-ztv(ig,k+1))
+     s          /(zlev(ig,k+1)-zlev(ig,k)))
+c     s         *(zlev(ig,k+1)-zlev(ig,k))
+       norme(ig)=norme(ig)+MAX(0.,(ztv(ig,k)-ztv(ig,k+1))
+     s          /(zlev(ig,k+1)-zlev(ig,k)))
+c    s          *(zlev(ig,k+1)-zlev(ig,k))
+         enddo
+       enddo
+       do ig=1,ngrid
+          if (norme(ig).gt.1.e-10) then
+             zalim(ig)=max(10.*zalim(ig)/norme(ig),zlev(ig,2))
+c             zalim(ig)=min(zalim(ig),zlev(ig,lentr(ig)))
+          endif
+       enddo
+cdétermination du lalim correspondant
+      do k=1,klev-1
+         do ig=1,ngrid
+      if ((zalim(ig).gt.zlev(ig,k)).and.(zalim(ig).le.zlev(ig,k+1))) 
+     s   then
+         lalim(ig)=k
+      endif
          enddo
       enddo
@@ -316,11 +340,30 @@
          do ig=1,ngrid 
             if (ztv(ig,l).gt.ztv(ig,l+1).and.
-     s          l.ge.lmin(ig).and.l.le.lentr(ig)) then 
-                 entr_star(ig,l)=(ztv(ig,l)-ztv(ig,l+1))*
-     s                           (zlev(ig,l+1)-zlev(ig,l))
-            endif
-         enddo
-      enddo
-c pas de thermique si couches 1->5 stables
+     s          l.ge.lmin(ig).and.l.lt.lentr(ig)) then 
+                 entr_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)
+c     s                           *(zlev(ig,l+1)-zlev(ig,l))
+     s                           *sqrt(zlev(ig,l+1))
+cautre def
+c                entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
+c     s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
+            endif
+         enddo
+      enddo
+cnouveau test
+c      if (therm) then
+      do l=1,klev-1
+         do ig=1,ngrid 
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.
+     s          l.ge.lmin(ig).and.l.le.lalim(ig)
+     s          .and.zalim(ig).gt.1.e-10) then 
+c            if (l.le.lentr(ig)) then 
+c               entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
+c     s                         /zalim(ig)))**(3./2.)
+c               write(10,*)zlev(ig,l),entr_star(ig,l)
+            endif
+         enddo
+      enddo
+c      endif
+c pas de thermique si couche 1 stable
       do ig=1,ngrid
          if (lmin(ig).gt.5) then
@@ -339,6 +382,16 @@
          enddo
       enddo
-c
-      print*,'fin calcul entr_star'
+c Calcul entrainement normalise
+      do ig=1,ngrid 
+         if (entr_star_tot(ig).gt.1.e-10) then
+c         do l=1,lentr(ig)
+          do l=1,klev
+cdef possibles pour entr_star: zdthetadz, dthetadz, zdtheta 
+            entr_star(ig,l)=entr_star(ig,l)/entr_star_tot(ig)
+         enddo
+         endif
+      enddo
+c
+c      print*,'fin calcul entr_star'
       do k=1,klev
          do ig=1,ngrid 
@@ -394,5 +447,5 @@
 ctest
                if (abs(zw2(ig,l+1)-zw2(ig,l)).lt.1e-10) then
-                  print*,'pb linter'
+c                  print*,'pb linter'
                endif
                linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))
@@ -402,5 +455,5 @@
             else
                if (zw2(ig,l+1).lt.0.) then
-                  print*,'pb1 zw2<0'
+c                  print*,'pb1 zw2<0'
                endif
                wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
@@ -413,12 +466,14 @@
          enddo
       enddo
-      print*,'fin calcul zw2'
+c      print*,'fin calcul zw2'
 c
 c Calcul de la couche correspondant a la hauteur du thermique
       do ig=1,ngrid
          lmax(ig)=lentr(ig)
+c         lmax(ig)=lalim(ig)
       enddo
       do ig=1,ngrid
          do l=nlay,lentr(ig)+1,-1
+c         do l=nlay,lalim(ig)+1,-1
             if (zw2(ig,l).le.1.e-10) then
                lmax(ig)=l-1
@@ -426,9 +481,11 @@
          enddo
       enddo
-c pas de thermique si couches 1->5 stables
+c pas de thermique si couche 1 stable
       do ig=1,ngrid
          if (lmin(ig).gt.5) then
             lmax(ig)=1
             lmin(ig)=1
+            lentr(ig)=1
+            lalim(ig)=1
          endif
       enddo 
@@ -443,5 +500,5 @@
             if (l.le.lmax(ig)) then
                 if (zw2(ig,l).lt.0.)then
-                  print*,'pb2 zw2<0'
+c                  print*,'pb2 zw2<0'
                 endif
                 zw2(ig,l)=sqrt(zw2(ig,l))
@@ -465,7 +522,13 @@
        zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
       enddo
-
-      print*,'avant fermeture'
+      do ig=1,ngrid
+c      write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
+      enddo
+con stoppe après les calculs de zmax et wmax
+      RETURN
+
+c      print*,'avant fermeture'
 c Fermeture,determination de f
+cAttention! entrainement normalisé ou pas?
       do ig=1,ngrid
          entr_star2(ig)=0.
@@ -476,4 +539,5 @@
          else
              do k=lmin(ig),lentr(ig)
+c             do k=lmin(ig),lalim(ig) 
                 entr_star2(ig)=entr_star2(ig)+entr_star(ig,k)**2
      s                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
@@ -481,16 +545,18 @@
 c Nouvelle fermeture
              f(ig)=wmax(ig)/(max(500.,zmax(ig))*r_aspect
-     s             *entr_star2(ig))*entr_star_tot(ig)
+     s             *entr_star2(ig))
+c     s            *entr_star_tot(ig)
 ctest
 c             if (first) then
-c             f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
-c     s             *wmax(ig))
+             f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
+     s             *wmax(ig))
 c             endif
          endif
-c         f0(ig)=f(ig)
+         f0(ig)=f(ig)
 c         first=.true.
       enddo
-      print*,'apres fermeture'
-
+c      print*,'apres fermeture'
+con stoppe après la fermeture
+      RETURN
 c Calcul de l'entrainement
        do k=1,klev
@@ -499,4 +565,17 @@
          enddo
       enddo
+con stoppe après le calcul de entr
+c      RETURN
+cCR:test pour entrainer moins que la masse
+c       do ig=1,ngrid
+c          do l=1,lentr(ig)
+c             if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
+c                entr(ig,l+1)=entr(ig,l+1)+entr(ig,l)
+c     s                       -0.9*masse(ig,l)/ptimestep
+c                entr(ig,l)=0.9*masse(ig,l)/ptimestep
+c             endif
+c          enddo
+c       enddo
+cCR: fin test
 c Calcul des flux
       do ig=1,ngrid
@@ -516,5 +595,5 @@
 c   calcul de la largeur de chaque ascendance dans le cas conservatif.
 c   dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-c   d'une couche est egale a la hauteur de la couche alimentante.
+c   d'une couche est égale à la hauteur de la couche alimentante.
 c   La vitesse maximale dans l'ascendance est aussi prise comme estimation
 c   de la vitesse d'entrainement horizontal dans la couche alimentante.
@@ -536,7 +615,14 @@
 c  cette option est finalement en dur.
                   if ((l_mix*zlev(ig,l)).lt.0.)then
-                   print*,'pb l_mix*zlev<0'
+c                   print*,'pb l_mix*zlev<0'
                   endif
+cCR: test: nouvelle def de lambda
+c                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+                  if (zw2(ig,l).gt.1.e-10) then
+                  larg_detr(ig,l)=sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
+                  else
                   larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+                  endif
+cRC
 c              else if (idetr.eq.1) then
 c                 larg_detr(ig,l)=larg_cons(ig,l)
@@ -555,5 +641,5 @@
 c      print*,'10 OK convect8'
 c     print*,'WA2 ',wa_moy
-c   calcul de la fraction de la maille concerne  par l'ascendance en tenant
+c   calcul de la fraction de la maille concernée par l'ascendance en tenant
 c   compte de l'epluchage du thermique.
 c
@@ -578,5 +664,5 @@
             else
             zmix(ig)=zlev(ig,lmix(ig))
-            print*,'pb zmix'
+c            print*,'pb zmix'
             endif
          else 
@@ -657,5 +743,5 @@
       enddo
       
-      print*,'fin calcul fraca'
+c      print*,'fin calcul fraca'
 c      print*,'11 OK convect8'
 c     print*,'Ea3 ',wa_moy
@@ -700,5 +786,5 @@
       enddo
 
-      print*,'12 OK convect8'
+c      print*,'12 OK convect8'
 c     print*,'WA4 ',wa_moy
 cc------------------------------------------------------------------
@@ -760,5 +846,6 @@
             detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
             if (detr(ig,l).lt.0.) then
-                entr(ig,l)=entr(ig,l)-detr(ig,l)
+c                entr(ig,l)=entr(ig,l)-detr(ig,l)
+                fm(ig,l+1)=fm(ig,l)+entr(ig,l)
                 detr(ig,l)=0.
 c     print*,'WARNING !!! detrainement negatif ',ig,l
@@ -831,5 +918,5 @@
 c      enddo
 
-      print*,'14 OK convect8'
+c      print*,'14 OK convect8'
 c------------------------------------------------------------------
 c   Calculs pour les sorties
@@ -901,5 +988,5 @@
 #endif
 123   continue
-c#define troisD
+#define troisD
 #ifdef troisD
 c       if (sorties) then
@@ -988,407 +1075,185 @@
 c     if(wa_moy(1,4).gt.1.e-10) stop
 
-      print*,'19 OK convect8'
+c      print*,'19 OK convect8'
       return
       end
 
-      subroutine dqthermcell(ngrid,nlay,ptimestep,fm,entr,masse
-     .    ,q,dq,qa)
-      use dimphy
-      implicit none
-
-c=======================================================================
-c
-c   Calcul du transport verticale dans la couche limite en presence
-c   de "thermiques" explicitement representes
-c   calcul du dq/dt une fois qu'on connait les ascendances
-c
-c=======================================================================
-
-cym#include "dimensions.h"
-cym#include "dimphy.h"
-
-      integer ngrid,nlay
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay)
-      real q(ngrid,nlay)
-      real dq(ngrid,nlay)
-
-      real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
-
-      integer ig,k
-
-c   calcul du detrainement
-
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-         enddo
-      enddo
-
-c   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
-     s         1.e-5*masse(ig,k)) then
-               qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))
-     s         /(fm(ig,k+1)+detr(ig,k))
+      SUBROUTINE fermeture_seche(ngrid,nlay
+     s                ,pplay,pplev,pphi,zlev,rhobarz,f0,zpspsk
+     s                ,alim_star,zh,zo,lentr,lmin,nu_min,nu_max,r_aspect
+     s                ,zmax,wmax)
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+
+      INTEGER ngrid,nlay
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+      real zlev(klon,klev+1)
+      real alim_star(klon,klev)
+      real f0(klon)
+      integer lentr(klon)
+      integer lmin(klon)
+      real zmax(klon)
+      real wmax(klon)
+      real nu_min
+      real nu_max
+      real r_aspect
+      real rhobarz(klon,klev+1)
+      REAL zh(klon,klev)
+      real zo(klon,klev)
+      real zpspsk(klon,klev)
+
+      integer ig,l
+
+      real f_star(klon,klev+1)
+      real detr_star(klon,klev)
+      real entr_star(klon,klev)
+      real zw2(klon,klev+1)
+      real linter(klon)
+      integer lmix(klon)
+      integer lmax(klon)
+      real zlevinter(klon)
+      real wa_moy(klon,klev+1)
+      real wmaxa(klon)
+      REAL ztv(klon,klev)
+      REAL ztva(klon,klev)
+      real nu(klon,klev)
+      real zmax0_sec(klon)
+      save zmax0_sec
+
+      do l=1,nlay
+         do ig=1,ngrid
+      ztv(ig,l)=zh(ig,l)/zpspsk(ig,l)
+      ztv(ig,l)=ztv(ig,l)*(1.+RETV*zo(ig,l))
+         enddo
+      enddo
+      do l=1,nlay-2
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1)
+     s         .and.alim_star(ig,l).gt.1.e-10
+     s         .and.zw2(ig,l).lt.1e-10) then
+               f_star(ig,l+1)=alim_star(ig,l)
+ctest:calcul de dteta
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+     s                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+            else if ((zw2(ig,l).ge.1e-10).and.
+     s         (f_star(ig,l)+alim_star(ig,l)).gt.1.e-10) then
+cestimation du detrainement a partir de la geometrie du pas precedent
+ctests sur la definition du detr
+             nu(ig,l)=(nu_min+nu_max)/2.
+     s         *(1.-(nu_max-nu_min)/(nu_max+nu_min)
+     s  *tanh((((ztva(ig,l-1)-ztv(ig,l))/ztv(ig,l))/0.0005)))
+         
+             detr_star(ig,l)=rhobarz(ig,l)
+     s                      *sqrt(zw2(ig,l)) 
+     s                       /(r_aspect*zmax0_sec(ig))*
+c     s                       /(r_aspect*zmax0(ig))*
+     s                      (sqrt(nu(ig,l)*zlev(ig,l+1)
+     s                /sqrt(zw2(ig,l)))
+     s                     -sqrt(nu(ig,l)*zlev(ig,l)
+     s                /sqrt(zw2(ig,l))))
+         detr_star(ig,l)=detr_star(ig,l)/f0(ig)
+         if ((detr_star(ig,l)).gt.f_star(ig,l)) then
+              detr_star(ig,l)=f_star(ig,l)
+         endif
+         entr_star(ig,l)=0.9*detr_star(ig,l)
+             if ((l.lt.lentr(ig))) then
+                 entr_star(ig,l)=0.
+c                 detr_star(ig,l)=0.
+             endif 
+            print*,'ok detr_star'
+cprise en compte du detrainement dans le calcul du flux
+             f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)
+     s                      -detr_star(ig,l)
+ctest sur le signe de f_star
+       if ((f_star(ig,l+1)+detr_star(ig,l)).gt.1.e-10) then 
+cAM on melange Tl et qt du thermique
+          ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+(entr_star(ig,l)
+     s                    +alim_star(ig,l))
+     s                    *ztv(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
+               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)
+     s                     /(f_star(ig,l+1)+detr_star(ig,l)))**2+
+     s                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+        endif
+c
+            if (zw2(ig,l+1).lt.0.) then 
+               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))
+     s           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+               print*,'linter=',linter(ig)
             else
-               qa(ig,k)=q(ig,k)
-            endif
-         enddo
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-c             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-            wqd(ig,k)=fm(ig,k)*q(ig,k)
-         enddo
-      enddo
-      do ig=1,ngrid
-         wqd(ig,1)=0.
-         wqd(ig,nlay+1)=0.
-      enddo
-
-      do k=1,nlay
-         do ig=1,ngrid
-            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)
-     s               -wqd(ig,k)+wqd(ig,k+1))
-     s               /masse(ig,k)
-         enddo
-      enddo
-
-      return
-      end
-      subroutine dvthermcell(ngrid,nlay,ptimestep,fm,entr,masse
-     .    ,fraca,larga
-     .    ,u,v,du,dv,ua,va)
-       use dimphy
-      implicit none
-
-c=======================================================================
-c
-c   Calcul du transport verticale dans la couche limite en presence
-c   de "thermiques" explicitement representes
-c   calcul du dq/dt une fois qu'on connait les ascendances
-c
-c=======================================================================
-
-cym#include "dimensions.h"
-cym#include "dimphy.h"
-
-      integer ngrid,nlay
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real fraca(ngrid,nlay+1)
-      real larga(ngrid)
-      real entr(ngrid,nlay)
-      real u(ngrid,nlay)
-      real ua(ngrid,nlay)
-      real du(ngrid,nlay)
-      real v(ngrid,nlay)
-      real va(ngrid,nlay)
-      real dv(ngrid,nlay)
-
-      real qa(klon,klev),detr(klon,klev)
-      real wvd(klon,klev+1),wud(klon,klev+1)
-      real gamma0,gamma(klon,klev+1)
-      real dua,dva
-      integer iter
-
-      integer ig,k
-
-c   calcul du detrainement
-
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-         enddo
-      enddo
-
-c   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         ua(ig,1)=u(ig,1)
-         va(ig,1)=v(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
-     s         1.e-5*masse(ig,k)) then
-c   On itere sur la valeur du coeff de freinage.
-c              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
-               gamma0=masse(ig,k)
-     s         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )
-     s         *0.5/larga(ig)
-c              gamma0=0.
-c   la premiere fois on multiplie le coefficient de freinage
-c   par le module du vent dans la couche en dessous.
-               dua=ua(ig,k-1)-u(ig,k-1)
-               dva=va(ig,k-1)-v(ig,k-1)
-               do iter=1,5
-                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
-                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)
-     s               +(entr(ig,k)+gamma(ig,k))*u(ig,k))
-     s               /(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
-                  va(ig,k)=(fm(ig,k)*va(ig,k-1)
-     s               +(entr(ig,k)+gamma(ig,k))*v(ig,k))
-     s               /(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
-c                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
-                  dua=ua(ig,k)-u(ig,k)
-                  dva=va(ig,k)-v(ig,k)
-               enddo
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+            endif
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+c   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
+      print*,'fin calcul zw2'
+c
+c 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
+c pas de thermique si couche 1 stable
+      do ig=1,ngrid
+         if (lmin(ig).gt.1) then
+            lmax(ig)=1
+             lmin(ig)=1
+             lentr(ig)=1
+         endif
+      enddo 
+c    
+c 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
-               ua(ig,k)=u(ig,k)
-               va(ig,k)=v(ig,k)
-               gamma(ig,k)=0.
-            endif
-         enddo
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            wud(ig,k)=fm(ig,k)*u(ig,k)
-            wvd(ig,k)=fm(ig,k)*v(ig,k)
-         enddo
-      enddo
-      do ig=1,ngrid
-         wud(ig,1)=0.
-         wud(ig,nlay+1)=0.
-         wvd(ig,1)=0.
-         wvd(ig,nlay+1)=0.
-      enddo
-
-      do k=1,nlay
-         do ig=1,ngrid
-            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)
-     s               -(entr(ig,k)+gamma(ig,k))*u(ig,k)
-     s               -wud(ig,k)+wud(ig,k+1))
-     s               /masse(ig,k)
-            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)
-     s               -(entr(ig,k)+gamma(ig,k))*v(ig,k)
-     s               -wvd(ig,k)+wvd(ig,k+1))
-     s               /masse(ig,k)
-         enddo
-      enddo
-
-      return
-      end
-      subroutine dqthermcell2(ngrid,nlay,ptimestep,fm,entr,masse,frac
-     .    ,q,dq,qa)
-      use dimphy
-      implicit none
-
-c=======================================================================
-c
-c   Calcul du transport verticale dans la couche limite en presence
-c   de "thermiques" explicitement representes
-c   calcul du dq/dt une fois qu'on connait les ascendances
-c
-c=======================================================================
-
-cym#include "dimensions.h"
-cym#include "dimphy.h"
-
-      integer ngrid,nlay
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay),frac(ngrid,nlay)
-      real q(ngrid,nlay)
-      real dq(ngrid,nlay)
-
-      real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
-      real qe(klon,klev),zf,zf2
-
-      integer ig,k
-
-c   calcul du detrainement
-
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-         enddo
-      enddo
-
-c   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-         qe(ig,1)=q(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
-     s         1.e-5*masse(ig,k)) then
-               zf=0.5*(frac(ig,k)+frac(ig,k+1))
-               zf2=1./(1.-zf)
-               qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+zf2*entr(ig,k)*q(ig,k))
-     s         /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2)
-               qe(ig,k)=(q(ig,k)-zf*qa(ig,k))*zf2
-            else
-               qa(ig,k)=q(ig,k)
-               qe(ig,k)=q(ig,k)
-            endif
-         enddo
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-c             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-            wqd(ig,k)=fm(ig,k)*qe(ig,k)
-         enddo
-      enddo
-      do ig=1,ngrid
-         wqd(ig,1)=0.
-         wqd(ig,nlay+1)=0.
-      enddo
-
-      do k=1,nlay
-         do ig=1,ngrid
-            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*qe(ig,k)
-     s               -wqd(ig,k)+wqd(ig,k+1))
-     s               /masse(ig,k)
-         enddo
-      enddo
-
-      return
-      end
-      subroutine dvthermcell2(ngrid,nlay,ptimestep,fm,entr,masse
-     .    ,fraca,larga
-     .    ,u,v,du,dv,ua,va)
-      use dimphy
-      implicit none
-
-c=======================================================================
-c
-c   Calcul du transport verticale dans la couche limite en presence
-c   de "thermiques" explicitement representes
-c   calcul du dq/dt une fois qu'on connait les ascendances
-c
-c=======================================================================
-
-cym#include "dimensions.h"
-cym#include "dimphy.h"
-
-      integer ngrid,nlay
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real fraca(ngrid,nlay+1)
-      real larga(ngrid)
-      real entr(ngrid,nlay)
-      real u(ngrid,nlay)
-      real ua(ngrid,nlay)
-      real du(ngrid,nlay)
-      real v(ngrid,nlay)
-      real va(ngrid,nlay)
-      real dv(ngrid,nlay)
-
-      real qa(klon,klev),detr(klon,klev),zf,zf2
-      real wvd(klon,klev+1),wud(klon,klev+1)
-      real gamma0,gamma(klon,klev+1)
-      real ue(klon,klev),ve(klon,klev)
-      real dua,dva
-      integer iter
-
-      integer ig,k
-
-c   calcul du detrainement
-
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-         enddo
-      enddo
-
-c   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         ua(ig,1)=u(ig,1)
-         va(ig,1)=v(ig,1)
-         ue(ig,1)=u(ig,1)
-         ve(ig,1)=v(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
-     s         1.e-5*masse(ig,k)) then
-c   On itere sur la valeur du coeff de freinage.
-c              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
-               gamma0=masse(ig,k)
-     s         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )
-     s         *0.5/larga(ig)
-     s         *1.
-c    s         *0.5
-c              gamma0=0.
-               zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
-               zf=0.
-               zf2=1./(1.-zf)
-c   la premiere fois on multiplie le coefficient de freinage
-c   par le module du vent dans la couche en dessous.
-               dua=ua(ig,k-1)-u(ig,k-1)
-               dva=va(ig,k-1)-v(ig,k-1)
-               do iter=1,5
-c   On choisit une relaxation lineaire.
-                  gamma(ig,k)=gamma0
-c   On choisit une relaxation quadratique.
-                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
-                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)
-     s               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))
-     s               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2
-     s                 +gamma(ig,k))
-                  va(ig,k)=(fm(ig,k)*va(ig,k-1)
-     s               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))
-     s               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2
-     s                 +gamma(ig,k))
-c                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
-                  dua=ua(ig,k)-u(ig,k)
-                  dva=va(ig,k)-v(ig,k)
-                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
-                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
-               enddo
-            else
-               ua(ig,k)=u(ig,k)
-               va(ig,k)=v(ig,k)
-               ue(ig,k)=u(ig,k)
-               ve(ig,k)=v(ig,k)
-               gamma(ig,k)=0.
-            endif
-         enddo
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            wud(ig,k)=fm(ig,k)*ue(ig,k)
-            wvd(ig,k)=fm(ig,k)*ve(ig,k)
-         enddo
-      enddo
-      do ig=1,ngrid
-         wud(ig,1)=0.
-         wud(ig,nlay+1)=0.
-         wvd(ig,1)=0.
-         wvd(ig,nlay+1)=0.
-      enddo
-
-      do k=1,nlay
-         do ig=1,ngrid
-            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)
-     s               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)
-     s               -wud(ig,k)+wud(ig,k+1))
-     s               /masse(ig,k)
-            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)
-     s               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)
-     s               -wvd(ig,k)+wvd(ig,k+1))
-     s               /masse(ig,k)
-         enddo
-      enddo
-
-      return
-      end
+                 zw2(ig,l)=0.
+            endif
+          enddo
+      enddo
+
+c   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
+c calcul de zlevinter
+          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*
+     s    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)
+     s    -zlev(ig,lmax(ig)))
+cpour le cas ou on prend tjs lmin=1
+c       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,1))
+       zmax0_sec(ig)=zmax(ig)
+      enddo
+       
+      RETURN
+      END
Index: LMDZ4/trunk/libf/phylmd/thermcell.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell.h	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/thermcell.h	(revision 878)
@@ -1,13 +1,8 @@
-!
-! $Header$
-!
-
       integer iflag_thermals,nsplit_thermals
       real r_aspect_thermals,l_mix_thermals,tho_thermals
       integer w2di_thermals,isplit
 
-      common/ctherm/iflag_thermals,nsplit_thermals
-     s              ,r_aspect_thermals,l_mix_thermals,tho_thermals
-     s              ,w2di_thermals
+      common/ctherm1/iflag_thermals,nsplit_thermals
+      common/ctherm2/r_aspect_thermals,l_mix_thermals,tho_thermals
+      common/ctherm3/w2di_thermals
 
-c$OMP THREADPRIVATE(/ctherm/)
Index: LMDZ4/trunk/libf/phylmd/thermcell_closure.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_closure.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_closure.F90	(revision 878)
@@ -0,0 +1,67 @@
+      SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
+     &   zlev,lalim,alim_star,zmax_sec,wmax_sec,zmax,wmax,f,f0,lev_out)
+
+!-------------------------------------------------------------------------
+!thermcell_closure: fermeture, determination de f
+!-------------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER ngrid,nlay
+      INTEGER ig,k       
+      REAL r_aspect,ptimestep
+      integer lev_out                           ! niveau pour les print
+
+      INTEGER lalim(ngrid)
+      REAL alim_star(ngrid,nlay)
+      REAL rho(ngrid,nlay)
+      REAL zlev(ngrid,nlay)
+      REAL zmax(ngrid),zmax_sec(ngrid)
+      REAL wmax(ngrid),wmax_sec(ngrid)
+      real zdenom
+
+      REAL alim_star2(ngrid)
+
+      REAL f(ngrid)
+      REAL f0(ngrid)
+
+      do ig=1,ngrid
+         alim_star2(ig)=0.
+      enddo
+      do ig=1,ngrid
+         if (alim_star(ig,1).LT.1.e-10) then
+            f(ig)=0.
+         else   
+             do k=1,lalim(ig)
+                alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
+     &                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+             enddo
+             zdenom=max(500.,zmax(ig))*r_aspect*alim_star2(ig)
+             if (zdenom<1.e-14) then
+                print*,'ig=',ig
+                print*,'alim_star2',alim_star2(ig)
+                print*,'zmax',zmax(ig)
+                print*,'r_aspect',r_aspect
+                print*,'zdenom',zdenom
+                print*,'alim_star',alim_star(ig,:)
+                print*,'zmax_sec',zmax_sec(ig)
+                print*,'wmax_sec',wmax_sec(ig)
+                stop
+             endif
+             if ((zmax_sec(ig).gt.1.e-10).and.(1.eq.1)) then 
+             f(ig)=wmax_sec(ig)/(max(500.,zmax_sec(ig))*r_aspect  &
+     &             *alim_star2(ig))
+             f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
+     &                     zmax_sec(ig))*wmax_sec(ig))
+             else
+             f(ig)=wmax(ig)/zdenom
+            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
+     &                     zmax(ig))*wmax(ig))
+             endif
+         endif
+         f0(ig)=f(ig)
+      enddo
+      if (lev_out.ge.1) print*,'apres fermeture'
+
+!
+      return
+      end
Index: LMDZ4/trunk/libf/phylmd/thermcell_dq.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_dq.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_dq.F90	(revision 878)
@@ -0,0 +1,99 @@
+      subroutine thermcell_dq(ngrid,nlay,ptimestep,fm,entr,  &
+     &           masse,q,dq,qa,lev_out)
+      implicit none
+
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+!=======================================================================
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay)
+      real q(ngrid,nlay)
+      real dq(ngrid,nlay)
+      integer lev_out                           ! niveau pour les print
+
+      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
+
+      integer ig,k
+
+!   calcul du detrainement
+
+      if (lev_out.ge.1) print*,'Q2 THERMCEL_DQ 0'
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+!           print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
+!test
+            if (detr(ig,k).lt.0.) then
+               entr(ig,k)=entr(ig,k)-detr(ig,k)
+               detr(ig,k)=0.
+!               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
+!     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
+            endif
+            if (fm(ig,k+1).lt.0.) then
+!               print*,'fm2<0!!!'
+            endif
+            if (entr(ig,k).lt.0.) then
+!               print*,'entr2<0!!!'
+            endif
+         enddo
+      enddo
+
+!   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
+     &         1.e-5*masse(ig,k)) then
+         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
+     &         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+            if (qa(ig,k).lt.0.) then
+!               print*,'qa<0!!!'
+            endif
+            if (q(ig,k).lt.0.) then
+!               print*,'q<0!!!'
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+!             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+            wqd(ig,k)=fm(ig,k)*q(ig,k)
+            if (wqd(ig,k).lt.0.) then
+!               print*,'wqd<0!!!'
+            endif
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+     
+      do k=1,nlay
+         do ig=1,ngrid
+            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
+     &               -wqd(ig,k)+wqd(ig,k+1))  &
+     &               /masse(ig,k)
+!            if (dq(ig,k).lt.0.) then
+!               print*,'dq<0!!!'
+!            endif
+         enddo
+      enddo
+
+      return
+      end
Index: LMDZ4/trunk/libf/phylmd/thermcell_dry.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_dry.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_dry.F90	(revision 878)
@@ -0,0 +1,209 @@
+       SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
+     &                            lalim,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 alim_star(ngrid,nlay)
+       INTEGER lalim(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.
+             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
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! A eliminer
+! Ce if complique etait fait pour reperer la premiere couche instable
+! Ici, c'est lmin.
+!
+!       do l=1,nlay-2
+!         do ig=1,ngrid
+!            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
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+! Calcul des F^*, integrale verticale de E^*
+       f_star(:,1)=0.
+       do l=1,nlay
+          f_star(:,l+1)=f_star(:,l)+alim_star(:,l)
+       enddo
+
+! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise
+       linter(:)=0.
+
+! couche la plus haute concernee par le thermique. 
+       lmax(:)=1
+
+! Le niveau linter est une variable continue qui se trouve dans la couche
+! lmax
+
+       do l=1,nlay-2
+         do ig=1,ngrid
+            if (l.eq.lmin(ig).and.lalim(ig).gt.1) then
+
+!------------------------------------------------------------------------
+!  Calcul de la vitesse en haut de la premiere couche instable.
+!  Premiere couche du panache thermique
+!------------------------------------------------------------------------
+               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))
+
+!------------------------------------------------------------------------
+! Tant que la vitesse en bas de la couche et la somme du flux de masse
+! et de l'entrainement (c'est a dire le flux de masse en haut) sont
+! positifs, on calcul
+! 1. le flux de masse en haut  f_star(ig,l+1)
+! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l)
+! 3. la vitesse au carré en haut zw2(ig,l+1)
+!------------------------------------------------------------------------
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  A eliminer : dans cette version, si zw2 est > 0 on a un therique.
+!  et donc, au dessus, f_star(ig,l+1) est forcement suffisamment 
+!  grand puisque on n'a pas de detrainement.
+!  f_star est une fonction croissante.
+!  c'est donc vraiment sur zw2 uniquement qu'il faut faire le test.
+!           else if ((zw2(ig,l).ge.1e-10).and.  &
+!    &               (f_star(ig,l)+alim_star(ig,l).gt.1.e-10)) then
+!              f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+            else if (zw2(ig,l).ge.1e-10) then
+
+               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_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)>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_dry'
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+                lmax(ig)=l
+            endif
+
+            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.
+               lmax(ig)=l
+            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
+               lmix(ig)=l+1
+               wmaxa(ig)=wa_moy(ig,l+1)
+            endif
+         enddo
+      enddo
+       if (lev_out.ge.1) print*,'fin calcul zw2'
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! A eliminer :
+! Ce calcul de lmax est fait en meme temps que celui de linter, plus haut
+! Calcul de la couche correspondant a la hauteur 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
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!    
+! 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
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH A eliminer
+! Simplification
+!          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)))
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+          zlevinter(ig)=zlev(ig,lmax(ig)) + &
+     &    (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+           zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+      enddo
+
+! Verification que lalim<=lmax
+      do ig=1,ngrid
+         if(lalim(ig)>lmax(ig)) then
+            print*,'WARNING thermcell_dry ig=',ig,'  lalim=',lalim(ig),'  lmax(ig)=',lmax(ig)
+            lmax(ig)=lalim(ig)
+         endif
+      enddo
+      
+      RETURN
+      END
Index: LMDZ4/trunk/libf/phylmd/thermcell_dv2.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_dv2.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_dv2.F90	(revision 878)
@@ -0,0 +1,130 @@
+      subroutine thermcell_dv2(ngrid,nlay,ptimestep,fm,entr,masse  &
+     &    ,fraca,larga  &
+     &    ,u,v,du,dv,ua,va,lev_out)
+      implicit none
+
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+!=======================================================================
+
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real fraca(ngrid,nlay+1)
+      real larga(ngrid)
+      real entr(ngrid,nlay)
+      real u(ngrid,nlay)
+      real ua(ngrid,nlay)
+      real du(ngrid,nlay)
+      real v(ngrid,nlay)
+      real va(ngrid,nlay)
+      real dv(ngrid,nlay)
+      integer lev_out                           ! niveau pour les print
+
+      real qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
+      real wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
+      real gamma0,gamma(ngrid,nlay+1)
+      real ue(ngrid,nlay),ve(ngrid,nlay)
+      real dua,dva
+      integer iter
+
+      integer ig,k
+
+!   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+!   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         ua(ig,1)=u(ig,1)
+         va(ig,1)=v(ig,1)
+         ue(ig,1)=u(ig,1)
+         ve(ig,1)=v(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
+     &         1.e-5*masse(ig,k)) then
+!   On itère sur la valeur du coeff de freinage.
+!              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+               gamma0=masse(ig,k)  &
+     &         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )  &
+     &         *0.5/larga(ig)  &
+     &         *1.
+!    s         *0.5
+!              gamma0=0.
+               zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
+               zf=0.
+               zf2=1./(1.-zf)
+!   la première fois on multiplie le coefficient de freinage
+!   par le module du vent dans la couche en dessous.
+               dua=ua(ig,k-1)-u(ig,k-1)
+               dva=va(ig,k-1)-v(ig,k-1)
+               do iter=1,5
+!   On choisit une relaxation lineaire.
+                  gamma(ig,k)=gamma0
+!   On choisit une relaxation quadratique.
+                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
+                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)  &
+     &               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))  &
+     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
+     &                 +gamma(ig,k))
+                  va(ig,k)=(fm(ig,k)*va(ig,k-1)  &
+     &               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))  &
+     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
+     &                 +gamma(ig,k))
+!                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
+                  dua=ua(ig,k)-u(ig,k)
+                  dva=va(ig,k)-v(ig,k)
+                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
+                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
+               enddo
+            else
+               ua(ig,k)=u(ig,k)
+               va(ig,k)=v(ig,k)
+               ue(ig,k)=u(ig,k)
+               ve(ig,k)=v(ig,k)
+               gamma(ig,k)=0.
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wud(ig,k)=fm(ig,k)*ue(ig,k)
+            wvd(ig,k)=fm(ig,k)*ve(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wud(ig,1)=0.
+         wud(ig,nlay+1)=0.
+         wvd(ig,1)=0.
+         wvd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)  &
+     &               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)  &
+     &               -wud(ig,k)+wud(ig,k+1))  &
+     &               /masse(ig,k)
+            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)  &
+     &               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)  &
+     &               -wvd(ig,k)+wvd(ig,k+1))  &
+     &               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
Index: LMDZ4/trunk/libf/phylmd/thermcell_env.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_env.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_env.F90	(revision 878)
@@ -0,0 +1,136 @@
+      SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
+     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
+
+!--------------------------------------------------------------
+!thermcell_env: calcule les caracteristiques de l environnement
+!necessaires au calcul des proprietes dans le thermique
+!--------------------------------------------------------------
+
+      IMPLICIT NONE
+
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"      
+
+      INTEGER ngrid,nlay
+      REAL po(ngrid,nlay)
+      REAL pt(ngrid,nlay)
+      REAL pu(ngrid,nlay)
+      REAL pv(ngrid,nlay)
+      REAL pplay(ngrid,nlay)
+      REAL pplev(ngrid,nlay+1)
+      integer lev_out                           ! niveau pour les print
+
+      REAL zo(ngrid,nlay)
+      REAL zl(ngrid,nlay)
+      REAL zh(ngrid,nlay)
+      REAL ztv(ngrid,nlay)
+      REAL zthl(ngrid,nlay)
+      REAL zpspsk(ngrid,nlay)
+      REAL zu(ngrid,nlay)
+      REAL zv(ngrid,nlay)
+      REAL zqsat(ngrid,nlay)
+
+      INTEGER ig,l,ll
+
+      real zcor,zdelta,zcvm5,qlbef
+      real Tbef,qsatbef
+      real dqsat_dT,DT,num,denom
+      REAL RLvCp,DDT0
+      PARAMETER (DDT0=.01)
+      LOGICAL Zsat
+
+      Zsat=.false.
+!
+! Pr Tprec=Tl calcul de qsat 
+! Si qsat>qT T=Tl, q=qT
+! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt) 
+! On cherche DDT < DDT0
+!
+! calcul des caracteristiques de l environnement
+       DO  ll=1,nlay
+         DO ig=1,ngrid
+            zo(ig,ll)=po(ig,ll)
+            zl(ig,ll)=0.
+            zh(ig,ll)=pt(ig,ll)
+            zqsat(ig,ll)=0.
+         EndDO
+       EndDO
+!
+!
+!recherche de saturation dans l environnement
+       DO ll=1,nlay
+! les points insatures sont definitifs
+         DO ig=1,ngrid
+            Tbef=pt(ig,ll)
+            zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+            qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,ll)
+            qsatbef=MIN(0.5,qsatbef)
+            zcor=1./(1.-retv*qsatbef)
+            qsatbef=qsatbef*zcor
+            Zsat = (max(0.,po(ig,ll)-qsatbef) .gt. 1.e-10)
+            if (Zsat) then
+            qlbef=max(0.,po(ig,ll)-qsatbef)
+! si sature: ql est surestime, d'ou la sous-relax
+            DT = 0.5*RLvCp*qlbef
+! on pourra enchainer 2 ou 3 calculs sans Do while
+            do while (abs(DT).gt.DDT0)
+! il faut verifier si c,a conserve quand on repasse en insature ...
+              Tbef=Tbef+DT
+              zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+              qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,ll)
+              qsatbef=MIN(0.5,qsatbef)
+              zcor=1./(1.-retv*qsatbef)
+              qsatbef=qsatbef*zcor
+! on veut le signe de qlbef
+              qlbef=po(ig,ll)-qsatbef
+!          dqsat_dT
+              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+pt(ig,ll)+RLvCp*qlbef
+              denom=1.+RLvCp*dqsat_dT
+              if (denom.lt.1.e-10) then
+                  print*,'pb denom'
+              endif
+              DT=num/denom
+            enddo
+! on ecrit de maniere conservative (sat ou non)
+            zl(ig,ll) = max(0.,qlbef)
+!          T = Tl +Lv/Cp ql
+            zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)
+            zo(ig,ll) = po(ig,ll)-zl(ig,ll)
+           endif
+!on ecrit zqsat 
+            zqsat(ig,ll)=qsatbef     
+         EndDO
+       EndDO
+!
+!
+!-----------------------------------------------------------------------
+!   incrementation eventuelle de tendances precedentes:
+!   ---------------------------------------------------
+
+      if (lev_out.ge.1) print*,'0 OK convect8'
+
+      DO 1010 l=1,nlay
+         DO 1015 ig=1,ngrid
+             zpspsk(ig,l)=(pplay(ig,l)/100000.)**RKAPPA
+             zu(ig,l)=pu(ig,l)
+             zv(ig,l)=pv(ig,l)
+!attention zh est maintenant le profil de T et plus le profil de theta !
+!
+!   T-> Theta
+            ztv(ig,l)=zh(ig,l)/zpspsk(ig,l)
+!Theta_v
+            ztv(ig,l)=ztv(ig,l)*(1.+RETV*(zo(ig,l))  &
+     &           -zl(ig,l))
+!Thetal
+            zthl(ig,l)=pt(ig,l)/zpspsk(ig,l)
+!            
+1015     CONTINUE
+1010  CONTINUE
+ 
+      RETURN
+      END
Index: LMDZ4/trunk/libf/phylmd/thermcell_flux.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_flux.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_flux.F90	(revision 878)
@@ -0,0 +1,503 @@
+!
+! $Header$
+!
+
+
+      SUBROUTINE thermcell_flux(ngrid,klev,ptimestep,masse, &
+     &       lalim,lmax,alim_star,  &
+     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
+     &       detr,zqla,zmax,lev_out,lunout,igout)
+
+
+!---------------------------------------------------------------------------
+!thermcell_flux: deduction des flux
+!---------------------------------------------------------------------------
+
+      IMPLICIT NONE
+      
+      INTEGER ig,l
+      INTEGER ngrid,klev
+      
+      REAL alim_star(ngrid,klev),entr_star(ngrid,klev)
+      REAL detr_star(ngrid,klev)
+      REAL zw2(ngrid,klev+1)
+      REAL zlev(ngrid,klev+1)
+      REAL masse(ngrid,klev)
+      REAL ptimestep
+      REAL rhobarz(ngrid,klev)
+      REAL f(ngrid)
+      INTEGER lmax(ngrid)
+      INTEGER lalim(ngrid)
+      REAL zqla(ngrid,klev)
+      REAL zmax(ngrid)
+
+      integer ncorecfm1,ncorecfm2,ncorecfm3,ncorecalpha
+      integer ncorecfm4,ncorecfm5,ncorecfm6,ncorecfm7,ncorecfm8
+      
+
+      REAL entr(ngrid,klev),detr(ngrid,klev)
+      REAL fm(ngrid,klev+1)
+      REAL zfm
+
+      integer igout
+      integer lev_out
+      integer lunout
+
+      REAL f_old,ddd0,eee0,ddd,eee,zzz
+
+      REAL fomass_max,alphamax
+      save fomass_max,alphamax
+
+      fomass_max=0.5
+      alphamax=0.7
+
+      ncorecfm1=0
+      ncorecfm2=0
+      ncorecfm3=0
+      ncorecfm4=0
+      ncorecfm5=0
+      ncorecfm6=0
+      ncorecfm7=0
+      ncorecfm8=0
+      ncorecalpha=0
+
+!initialisation
+      fm(:,:)=0.
+      
+      if (lev_out.ge.10) then
+         write(lunout,*) 'Dans thermcell_flux 0'
+         write(lunout,*) 'flux base ',f(igout)
+         write(lunout,*) 'lmax ',lmax(igout)
+         write(lunout,*) 'lalim ',lalim(igout)
+         write(lunout,*) 'ig= ',igout
+         write(lunout,*) ' l E*    A*     D*  '
+         write(lunout,'(i4,3e15.5)') (l,entr_star(igout,l),alim_star(igout,l),detr_star(igout,l) &
+     &    ,l=1,lmax(igout))
+      endif
+
+
+!-------------------------------------------------------------------------
+! Verification de la nullite des entrainement et detrainement au dessus
+! de lmax(ig)
+!-------------------------------------------------------------------------
+
+      do l=1,klev
+         do ig=1,ngrid
+            if (l.le.lmax(ig)) then
+               if (entr_star(ig,l).gt.1.) then
+                    print*,'WARNING thermcell_flux 1 ig,l,lmax(ig)',ig,l,lmax(ig)
+                    print*,'entr_star(ig,l)',entr_star(ig,l)
+                    print*,'alim_star(ig,l)',alim_star(ig,l)
+                    print*,'detr_star(ig,l)',detr_star(ig,l)
+!                   stop
+               endif
+            else
+               if (abs(entr_star(ig,l))+abs(alim_star(ig,l))+abs(detr_star(ig,l)).gt.0.) then
+                    print*,'cas 1 : ig,l,lmax(ig)',ig,l,lmax(ig)
+                    print*,'entr_star(ig,l)',entr_star(ig,l)
+                    print*,'alim_star(ig,l)',alim_star(ig,l)
+                    print*,'detr_star(ig,l)',detr_star(ig,l)
+                    stop
+               endif
+            endif
+         enddo
+      enddo
+
+!-------------------------------------------------------------------------
+! Multiplication par le flux de masse issu de la femreture
+!-------------------------------------------------------------------------
+
+      do l=1,klev
+         entr(:,l)=f(:)*(entr_star(:,l)+alim_star(:,l))
+         detr(:,l)=f(:)*detr_star(:,l)
+      enddo
+
+      if (lev_out.ge.10) then
+         write(lunout,*) 'Dans thermcell_flux 1'
+         write(lunout,*) 'flux base ',f(igout)
+         write(lunout,*) 'lmax ',lmax(igout)
+         write(lunout,*) 'lalim ',lalim(igout)
+         write(lunout,*) 'ig= ',igout
+         write(lunout,*) ' l   E    D     W2'
+         write(lunout,'(i4,3e15.5)') (l,entr(igout,l),detr(igout,l) &
+     &    ,zw2(igout,l+1),l=1,lmax(igout))
+      endif
+
+      fm(:,1)=0.
+      do l=1,klev
+         do ig=1,ngrid
+            if (l.lt.lmax(ig)) then
+               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
+            elseif(l.eq.lmax(ig)) then
+               fm(ig,l+1)=0.
+               detr(ig,l)=fm(ig,l)+entr(ig,l)
+            else
+               fm(ig,l+1)=0.
+            endif
+         enddo
+      enddo
+
+
+
+! Test provisoire : pour comprendre pourquoi on corrige plein de fois 
+! le cas fm6, on commence par regarder une premiere fois avant les
+! autres corrections.
+
+      do l=1,klev
+         do ig=1,ngrid
+            if (detr(ig,l).gt.fm(ig,l)) then
+               ncorecfm8=ncorecfm8+1
+!              igout=ig
+            endif
+         enddo
+      enddo
+
+      if (lev_out.ge.10) &
+    &    call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
+    &    ptimestep,masse,entr,detr,fm,'2  ')
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH Version en cours de test;
+! par rapport a thermcell_flux, on fait une grande boucle sur "l"
+! et on modifie le flux avec tous les contrôles appliques d'affilee
+! pour la meme couche
+! Momentanement, on duplique le calcule du flux pour pouvoir comparer
+! les flux avant et apres modif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      do l=1,klev
+
+         do ig=1,ngrid
+            if (l.lt.lmax(ig)) then
+               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
+            elseif(l.eq.lmax(ig)) then
+               fm(ig,l+1)=0.
+               detr(ig,l)=fm(ig,l)+entr(ig,l)
+            else
+               fm(ig,l+1)=0.
+            endif
+         enddo
+
+
+!-------------------------------------------------------------------------
+! Verification de la positivite des flux de masse
+!-------------------------------------------------------------------------
+
+!     do l=1,klev
+         do ig=1,ngrid
+            if (fm(ig,l+1).lt.0.) then
+!              print*,'fm1<0',l+1,lmax(ig),fm(ig,l+1)
+                ncorecfm1=ncorecfm1+1
+               fm(ig,l+1)=fm(ig,l)
+               detr(ig,l)=entr(ig,l)
+            endif
+         enddo
+!     enddo
+
+      if (lev_out.ge.10) &
+     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!-------------------------------------------------------------------------
+!Test sur fraca croissant
+!-------------------------------------------------------------------------
+
+
+      if (1.eq.0) then
+!     do l=1,klev
+         do ig=1,ngrid
+          if (l.ge.lalim(ig).and.l.le.lmax(ig) &
+     &    .and.(zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10) ) then
+!  zzz est le flux en l+1 a frac constant
+             zzz=fm(ig,l)*rhobarz(ig,l+1)*zw2(ig,l+1)  &
+     &                          /(rhobarz(ig,l)*zw2(ig,l))
+             if (fm(ig,l+1).gt.zzz) then
+                detr(ig,l)=detr(ig,l)+fm(ig,l+1)-zzz
+                fm(ig,l+1)=zzz
+                ncorecfm4=ncorecfm4+1
+             endif
+          endif
+        enddo
+!     enddo
+
+      if (lev_out.ge.10) &
+     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+      else
+         print*,'Test sur les fractions croissantes inhibe dans thermcell_flux2'
+      endif
+
+
+!-------------------------------------------------------------------------
+!test sur flux de masse croissant
+!-------------------------------------------------------------------------
+
+!     do l=1,klev
+         do ig=1,ngrid
+            if ((fm(ig,l+1).gt.fm(ig,l)).and.(l.gt.lalim(ig))) then
+              f_old=fm(ig,l+1)
+              fm(ig,l+1)=fm(ig,l)
+              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
+               ncorecfm5=ncorecfm5+1
+            endif
+         enddo
+!     enddo
+
+      if (lev_out.ge.10) &
+     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!-------------------------------------------------------------------------
+!detr ne peut pas etre superieur a fm
+!-------------------------------------------------------------------------
+
+      if(1.eq.1) then
+
+!     do l=1,klev
+         do ig=1,ngrid
+            if (entr(ig,l)<0.) then
+               print*,'N1 ig,l,entr',ig,l,entr(ig,l)
+               stop'entr negatif'
+            endif
+            if (detr(ig,l).gt.fm(ig,l)) then
+               ncorecfm6=ncorecfm6+1
+               detr(ig,l)=fm(ig,l)
+!              entr(ig,l)=fm(ig,l+1)
+
+! Dans le cas ou on est au dessus de la couche d'alimentation et que le
+! detrainement est plus fort que le flux de masse, on stope le thermique.
+               if (l.gt.lalim(ig)) then
+                  lmax(ig)=l
+                  fm(ig,l+1)=0.
+                  entr(ig,l)=0.
+               else
+                  ncorecfm7=ncorecfm7+1
+               endif
+            endif
+
+            if(l.gt.lmax(ig)) then
+               detr(ig,l)=0.
+               fm(ig,l+1)=0.
+               entr(ig,l)=0.
+            endif
+
+            if (entr(ig,l).lt.0.) then
+               print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
+               print*,'entr(ig,l)',entr(ig,l)
+               print*,'fm(ig,l)',fm(ig,l)
+               stop'probleme dans thermcell flux'
+            endif
+         enddo
+!     enddo
+      endif
+
+
+      if (lev_out.ge.10) &
+     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!-------------------------------------------------------------------------
+!fm ne peut pas etre negatif
+!-------------------------------------------------------------------------
+
+!     do l=1,klev
+         do ig=1,ngrid
+            if (fm(ig,l+1).lt.0.) then
+               detr(ig,l)=detr(ig,l)+fm(ig,l+1)
+               fm(ig,l+1)=0.
+!              print*,'fm2<0',l+1,lmax(ig)
+               ncorecfm2=ncorecfm2+1
+            endif
+            if (detr(ig,l).lt.0.) then
+               print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig)
+               print*,'detr(ig,l)',detr(ig,l)
+               print*,'fm(ig,l)',fm(ig,l)
+               stop'probleme dans thermcell flux'
+            endif
+        enddo
+!    enddo
+
+      if (lev_out.ge.10) &
+     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!-----------------------------------------------------------------------
+!la fraction couverte ne peut pas etre superieure a 1            
+!-----------------------------------------------------------------------
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH Partie a revisiter.
+! Il semble qu'etaient codees ici deux optiques dans le cas
+! F/ (rho *w) > 1
+! soit limiter la hauteur du thermique en considerant que c'est 
+! la derniere chouche, soit limiter F a rho w.
+! Dans le second cas, il faut en fait limiter a un peu moins
+! que ca parce qu'on a des 1 / ( 1 -alpha) un peu plus loin
+! dans thermcell_main et qu'il semble de toutes facons deraisonable
+! d'avoir des fractions de 1..
+! Ci dessous, et dans l'etat actuel, le premier des  deux if est
+! sans doute inutile.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!    do l=1,klev
+        do ig=1,ngrid
+           if (zw2(ig,l+1).gt.1.e-10) then
+           zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*alphamax
+           if ( fm(ig,l+1) .gt. zfm) then
+              f_old=fm(ig,l+1)
+              fm(ig,l+1)=zfm
+!             zw2(ig,l+1)=0.
+!             zqla(ig,l+1)=0.
+              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
+!             lmax(ig)=l+1
+!             zmax(ig)=zlev(ig,lmax(ig))
+!             print*,'alpha>1',l+1,lmax(ig)
+              ncorecalpha=ncorecalpha+1
+           endif
+           endif
+        enddo
+!    enddo
+!
+
+
+      if (lev_out.ge.10) &
+     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+! Fin de la grande boucle sur les niveaux verticaux
+      enddo
+
+      if (lev_out.ge.10) &
+    &    call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
+    &    ptimestep,masse,entr,detr,fm,'8  ')
+
+
+!-----------------------------------------------------------------------
+! On fait en sorte que la quantite totale d'air entraine dans le 
+! panache ne soit pas trop grande comparee a la masse de la maille
+!-----------------------------------------------------------------------
+
+      if (1.eq.1) then
+      do l=1,klev-1
+         do ig=1,ngrid
+            eee0=entr(ig,l)
+            ddd0=detr(ig,l)
+            eee=entr(ig,l)-masse(ig,l)*fomass_max/ptimestep
+            ddd=detr(ig,l)-eee
+            if (eee.gt.0.) then
+                ncorecfm3=ncorecfm3+1
+                entr(ig,l)=entr(ig,l)-eee
+                if ( ddd.gt.0.) then
+!   l'entrainement est trop fort mais l'exces peut etre compense par une
+!   diminution du detrainement)
+                   detr(ig,l)=ddd
+                else
+!   l'entrainement est trop fort mais l'exces doit etre compense en partie
+!   par un entrainement plus fort dans la couche superieure
+                   if(l.eq.lmax(ig)) then
+                      detr(ig,l)=fm(ig,l)+entr(ig,l)
+                   else
+                      if(l.ge.lmax(ig).and.0.eq.1) then
+                         print*,'ig,l',ig,l
+                         print*,'eee0',eee0
+                         print*,'ddd0',ddd0
+                         print*,'eee',eee
+                         print*,'ddd',ddd
+                         print*,'entr',entr(ig,l)
+                         print*,'detr',detr(ig,l)
+                         print*,'masse',masse(ig,l)
+                         print*,'fomass_max',fomass_max
+                         print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*fomass_max/ptimestep
+                         print*,'ptimestep',ptimestep
+                         print*,'lmax(ig)',lmax(ig)
+                         print*,'fm(ig,l+1)',fm(ig,l+1)
+                         print*,'fm(ig,l)',fm(ig,l)
+                         stop'probleme dans thermcell_flux'
+                      endif
+                      entr(ig,l+1)=entr(ig,l+1)-ddd
+                      detr(ig,l)=0.
+                      fm(ig,l+1)=fm(ig,l)+entr(ig,l)
+                      detr(ig,l)=0.
+                   endif
+                endif
+            endif
+         enddo
+      enddo
+      endif
+!                  
+!              ddd=detr(ig)-entre
+!on s assure que tout s annule bien en zmax
+      do ig=1,ngrid
+         fm(ig,lmax(ig)+1)=0.
+         entr(ig,lmax(ig))=0.
+         detr(ig,lmax(ig))=fm(ig,lmax(ig))+entr(ig,lmax(ig))
+      enddo
+
+!-----------------------------------------------------------------------
+! Impression du nombre de bidouilles qui ont ete necessaires
+!-----------------------------------------------------------------------
+
+      if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then
+
+          print*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',&
+    &     ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', &
+    &     ncorecfm4,'x fm4',ncorecfm5,'x fm5 et', &
+    &     ncorecfm6,'x fm6', &
+    &     ncorecfm7,'x fm7', &
+    &     ncorecfm8,'x fm8', &
+    &     ncorecalpha,'x alpha'
+      endif
+
+      if (lev_out.ge.10) &
+    &    call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
+    &    ptimestep,masse,entr,detr,fm,'fin')
+
+
+      return
+      end
+
+      subroutine printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
+    &    ptimestep,masse,entr,detr,fm,descr)
+
+     implicit none
+
+      integer ngrid,klev,lunout,igout,l,lm
+
+      integer lmax(klev),lalim(klev)
+      real ptimestep,masse(ngrid,klev),entr(ngrid,klev),detr(ngrid,klev)
+      real fm(ngrid,klev+1),f(ngrid)
+
+      character*3 descr
+
+      lm=lmax(igout)+5
+      if(lm.gt.klev) lm=klev
+
+      print*,'Impression jusque lm=',lm
+
+         write(lunout,*) 'Dans thermcell_flux '//descr
+         write(lunout,*) 'flux base ',f(igout)
+         write(lunout,*) 'lmax ',lmax(igout)
+         write(lunout,*) 'lalim ',lalim(igout)
+         write(lunout,*) 'ig= ',igout
+         write(lunout,'(a3,4a14)') 'l','M','E','D','F'
+         write(lunout,'(i4,4e14.4)') (l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l) &
+     &    ,fm(igout,l+1),l=1,lm)
+
+
+      do l=lmax(igout)+1,klev
+          if (abs(entr(igout,l))+abs(detr(igout,l))+abs(fm(igout,l)).gt.0.) then
+          print*,'cas 1 : igout,l,lmax(igout)',igout,l,lmax(igout)
+          print*,'entr(igout,l)',entr(igout,l)
+          print*,'detr(igout,l)',detr(igout,l)
+          print*,'fm(igout,l)',fm(igout,l)
+          stop
+          endif
+      enddo
+
+      return
+      end
+
Index: LMDZ4/trunk/libf/phylmd/thermcell_height.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_height.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_height.F90	(revision 878)
@@ -0,0 +1,125 @@
+      SUBROUTINE thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,  &
+     &           zw2,zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)                            
+
+!-----------------------------------------------------------------------------
+!thermcell_height: calcul des caracteristiques du thermique: zmax,wmax,zmix
+!-----------------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER ig,l
+      INTEGER ngrid,nlay
+      INTEGER lalim(ngrid),lmin(ngrid)
+      INTEGER lmix(ngrid)
+      REAL linter(ngrid)
+      integer lev_out                           ! niveau pour les print
+
+      REAL zw2(ngrid,nlay+1)
+      REAL zlev(ngrid,nlay+1)
+
+      REAL wmax(ngrid)
+      INTEGER lmax(ngrid)
+      REAL zmax(ngrid)
+      REAL zmax0(ngrid)
+      REAL zmix(ngrid)
+
+      REAL zlevinter(ngrid)
+
+!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
+! 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
+      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
+!
+! 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
Index: LMDZ4/trunk/libf/phylmd/thermcell_init.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_init.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_init.F90	(revision 878)
@@ -0,0 +1,100 @@
+      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  
Index: LMDZ4/trunk/libf/phylmd/thermcell_main.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_main.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_main.F90	(revision 878)
@@ -0,0 +1,601 @@
+!
+! $Header$
+!
+      SUBROUTINE thermcell_main(ngrid,nlay,ptimestep  &
+     &                  ,pplay,pplev,pphi,debut  &
+     &                  ,pu,pv,pt,po  &
+     &                  ,pduadj,pdvadj,pdtadj,pdoadj  &
+     &                  ,fm0,entr0,zqla,lmax  &
+     &                  ,ratqscth,ratqsdiff,zqsatth  &
+     &                  ,r_aspect,l_mix,w2di,tho)
+
+      IMPLICIT NONE
+
+!=======================================================================
+!   Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
+!   Version du 09.02.07
+!   Calcul du transport vertical dans la couche limite en presence
+!   de "thermiques" explicitement representes avec processus nuageux
+!
+!   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+!
+!   le thermique est supposé homogène et dissipé par mélange avec
+!   son environnement. la longueur l_mix contrôle l'efficacité du
+!   mélange
+!
+!   Le calcul du transport des différentes espèces se fait en prenant
+!   en compte:
+!     1. un flux de masse montant
+!     2. un flux de masse descendant
+!     3. un entrainement
+!     4. un detrainement
+!
+!=======================================================================
+
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+
+!   arguments:
+!   ----------
+
+      INTEGER ngrid,nlay,w2di,tho
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+!   local:
+!   ------
+
+!      integer,save :: igout=4259
+      integer,save :: igout=2928
+      integer,save :: lunout=6
+      integer,save :: lev_out=10
+
+      INTEGER ig,k,l,ll
+      real zsortie1d(klon)
+      INTEGER lmax(klon),lmin(klon),lalim(klon)
+      INTEGER lmix(klon)
+      real linter(klon)
+      real zmix(klon)
+      real zmax(klon),zw2(klon,klev+1),ztva(klon,klev)
+      real zmax_sec(klon)
+      real w_est(klon,klev+1)
+!on garde le zmax du pas de temps precedent
+      real zmax0(klon)
+      save zmax0
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      real deltaz(klon,klev)
+      REAL zh(klon,klev),zdhadj(klon,klev)
+      real zthl(klon,klev),zdthladj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      real zl(klon,klev)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zta(klon,klev)
+      real zha(klon,klev)
+      real fraca(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev)
+      real q2(klon,klev)
+      common/comtherm/thetath2,wth2
+    
+      real ratqscth(klon,klev)
+      real var
+      real vardiff
+      real ratqsdiff(klon,klev)
+      integer isplit,nsplit
+      parameter (nsplit=10)
+      data isplit/0/
+      save isplit
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+      real wmax(klon)
+      real wmax_sec(klon)
+      real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
+      real detr0(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev)
+
+      real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
+!niveau de condensation
+      real nivcon(klon)
+      real zcon(klon)
+      REAL CHI
+      real zcon2(klon)
+      real pcon(klon)
+      real zqsat(klon,klev)
+      real zqsatth(klon,klev) 
+
+      real f_star(klon,klev+1),entr_star(klon,klev)
+      real detr_star(klon,klev)
+      real alim_star_tot(klon),alim_star2(klon)
+      real alim_star(klon,klev)
+      real f(klon), f0(klon)
+      save f0
+      real zlevinter(klon)
+      logical debut
+       real seuil
+
+!
+
+      character*2 str2
+      character*10 str10
+
+      EXTERNAL SCOPY
+!
+
+!-----------------------------------------------------------------------
+!   initialisation:
+!   ---------------
+!
+
+      seuil=0.25
+
+      if (lev_out.ge.1) print*,'thermcell_main V4'
+
+       sorties=.true.
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+!
+!Initialisation
+!
+      do ig=1,klon      
+      if ((debut).or.((.not.debut).and.(f0(ig).lt.1.e-10))) then
+            f0(ig)=1.e-5
+            zmax0(ig)=40.
+      endif
+      enddo 
+
+
+
+!-----------------------------------------------------------------------
+! Calcul de T,q,ql a partir de Tl et qT dans l environnement
+!   --------------------------------------------------------------------
+!
+      CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
+     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
+       
+      if (lev_out.ge.1) print*,'thermcell_main apres thermcell_env'
+
+!------------------------------------------------------------------------
+!                       --------------------
+!
+!
+!                       + + + + + + + + + + +
+!
+!
+!  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+!  wh,wt,wo ...
+!
+!                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+!
+!
+!                       --------------------   zlev(1)
+!                       \\\\\\\\\\\\\\\\\\\\
+!
+!
+
+!-----------------------------------------------------------------------
+!   Calcul des altitudes des couches
+!-----------------------------------------------------------------------
+
+      do l=2,nlay
+         zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
+      enddo
+         zlev(:,1)=0.
+         zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG
+      do l=1,nlay
+         zlay(:,l)=pphi(:,l)/RG
+      enddo
+!calcul de l epaisseur des couches
+      do l=1,nlay
+         deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
+      enddo
+
+!     print*,'2 OK convect8'
+!-----------------------------------------------------------------------
+!   Calcul des densites
+!-----------------------------------------------------------------------
+
+      do l=1,nlay
+         rho(:,l)=pplay(:,l)/(zpspsk(:,l)*RD*ztv(:,l))
+      enddo
+
+      do l=2,nlay
+         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
+      enddo
+
+!calcul de la masse
+      do l=1,nlay
+         masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
+      enddo
+
+      if (lev_out.ge.1) print*,'thermcell_main apres initialisation'
+
+!------------------------------------------------------------------
+!
+!             /|\
+!    --------  |  F_k+1 -------   
+!                              ----> D_k
+!             /|\              <---- E_k , A_k
+!    --------  |  F_k --------- 
+!                              ----> D_k-1
+!                              <---- E_k-1 , A_k-1
+!
+!
+!
+!
+!
+!    ---------------------------
+!
+!    ----- F_lmax+1=0 ----------         \
+!            lmax     (zmax)              |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |  E
+!    ---------------------------          |  D
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------  \       |
+!            lalim                 |      |
+!    ---------------------------   |      |
+!                                  |      |
+!    ---------------------------   |      |
+!                                  | A    |
+!    ---------------------------   |      |
+!                                  |      |
+!    ---------------------------   |      |
+!    lmin  (=1 pour le moment)     |      |
+!    ----- F_lmin=0 ------------  /      /
+!
+!    ---------------------------
+!    //////////////////////////
+!
+!
+!=============================================================================
+!  Calculs initiaux ne faisant pas intervenir les changements de phase
+!=============================================================================
+
+!------------------------------------------------------------------
+!  1. alim_star est le profil vertical de l'alimentation à la base du
+!     panache thermique, calculé à partir de la flotabilité de l'air sec
+!  2. lmin et lalim sont les indices inferieurs et superieurs de alim_star
+!------------------------------------------------------------------
+!
+      entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0.
+      CALL thermcell_init(ngrid,nlay,ztv,zlev,  &
+     &                    lalim,lmin,alim_star,alim_star_tot,lev_out)
+
+call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lmin  ')
+call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lalim ')
+
+
+      if (lev_out.ge.1) print*,'thermcell_main apres thermcell_init'
+      if (lev_out.ge.10) then
+         write(lunout,*) 'Dans thermcell_main 1'
+         write(lunout,*) 'lmin ',lmin(igout)
+         write(lunout,*) 'lalim ',lalim(igout)
+         write(lunout,*) ' ig l alim_star thetav'
+         write(lunout,'(i6,i4,2e15.5)') (igout,l,alim_star(igout,l) &
+     &   ,ztv(igout,l),l=1,lalim(igout)+4)
+      endif
+
+!-----------------------------------------------------------------------------
+!  3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un
+!     panache sec conservatif (e=d=0) alimente selon alim_star 
+!     Il s'agit d'un calcul de type CAPE
+!     zmax_sec est utilisé pour déterminer la géométrie du thermique.
+!------------------------------------------------------------------------------
+!
+      CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
+     &                      lalim,lmin,zmax_sec,wmax_sec,lev_out)
+
+call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
+call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
+
+      if (lev_out.ge.1) print*,'thermcell_main apres thermcell_dry'
+      if (lev_out.ge.10) then
+         write(lunout,*) 'Dans thermcell_main 1b'
+         write(lunout,*) 'lmin ',lmin(igout)
+         write(lunout,*) 'lalim ',lalim(igout)
+         write(lunout,*) ' ig l alim_star entr_star detr_star f_star '
+         write(lunout,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) &
+     &    ,l=1,lalim(igout)+4)
+      endif
+
+
+
+!---------------------------------------------------------------------------------
+!calcul du melange et des variables dans le thermique
+!--------------------------------------------------------------------------------
+!
+      CALL thermcell_plume(ngrid,nlay,ztv,zthl,po,zl,rhobarz,  &
+     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,  &
+     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
+     &           ztla,zqla,zqta,zha,zw2,zqsatth,lmix,linter,lev_out)
+      call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
+
+      if (lev_out.ge.1) print*,'thermcell_main apres thermcell_plume'
+      if (lev_out.ge.10) then
+         write(lunout,*) 'Dans thermcell_main 2'
+         write(lunout,*) 'lmin ',lmin(igout)
+         write(lunout,*) 'lalim ',lalim(igout)
+         write(lunout,*) ' ig l alim_star entr_star detr_star f_star '
+         write(lunout,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
+     &    ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
+      endif
+
+!-------------------------------------------------------------------------------
+! Calcul des caracteristiques du thermique:zmax,zmix,wmax
+!-------------------------------------------------------------------------------
+!
+      CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2,  &
+     &           zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)
+
+
+      call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
+
+      if (lev_out.ge.1) print*,'thermcell_main apres thermcell_height'
+
+!-------------------------------------------------------------------------------
+! Fermeture,determination de f
+!-------------------------------------------------------------------------------
+
+      CALL thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
+     &   zlev,lalim,alim_star,zmax_sec,wmax_sec,zmax,wmax,f,f0,lev_out)
+
+      if(lev_out.ge.1)print*,'thermcell_closure apres thermcell_closure'
+
+!-------------------------------------------------------------------------------
+!deduction des flux
+!-------------------------------------------------------------------------------
+
+      CALL thermcell_flux(ngrid,nlay,ptimestep,masse, &
+     &       lalim,lmax,alim_star,  &
+     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
+     &       detr,zqla,zmax,lev_out,lunout,igout)
+
+      if (lev_out.ge.1) print*,'thermcell_main apres thermcell_flux'
+      call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
+
+!c------------------------------------------------------------------
+!   calcul du transport vertical
+!------------------------------------------------------------------
+
+      if (w2di.eq.1) then
+         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+      else
+         fm0=fm
+         entr0=entr
+         detr0=detr
+      endif
+
+      call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse,  &
+     &                    zthl,zdthladj,zta,lev_out)
+      call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse,  &
+     &                   po,pdoadj,zoa,lev_out)
+
+      if (1.eq.0) then
+
+! Calcul du transport de V tenant compte d'echange par gradient
+! de pression horizontal avec l'environnement
+
+         call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse  &
+     &    ,fraca,zmax  &
+     &    ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
+      else
+
+! calcul purement conservatif pour le transport de V
+         call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
+     &    ,zu,pduadj,zua,lev_out)
+         call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
+     &    ,zv,pdvadj,zva,lev_out)
+      endif
+
+!     print*,'13 OK convect8'
+      do l=1,nlay
+         do ig=1,ngrid
+           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)  
+         enddo
+      enddo
+
+      print*,'14 OK convect8'
+!------------------------------------------------------------------
+!   Calculs de diagnostiques pour les sorties
+!------------------------------------------------------------------
+!calcul de fraca pour les sorties
+      
+      if (sorties) then
+      do ig=1,klon
+         fraca(ig,1)=0.
+      enddo
+      do l=2,nlay
+         do ig=1,klon
+            if (zw2(ig,l).gt.1.e-10) then
+            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
+            else
+            fraca(ig,l)=0.
+            endif
+         enddo
+      enddo
+     
+      print*,'14a OK convect8'
+! calcul du niveau de condensation
+! initialisation
+      do ig=1,ngrid
+         nivcon(ig)=0.
+         zcon(ig)=0.
+      enddo 
+!nouveau calcul
+      do ig=1,ngrid
+      CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1))
+      pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI
+      enddo
+      do k=1,nlay
+         do ig=1,ngrid
+         if ((pcon(ig).le.pplay(ig,k))  &
+     &      .and.(pcon(ig).gt.pplay(ig,k+1))) then
+            zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100.
+         endif
+         enddo
+      enddo
+      print*,'14b OK convect8'
+      do k=nlay,1,-1
+         do ig=1,ngrid
+            if (zqla(ig,k).gt.1e-10) then
+               nivcon(ig)=k
+               zcon(ig)=zlev(ig,k)
+            endif
+         enddo
+      enddo
+      print*,'14c OK convect8'
+!calcul des moments
+!initialisation
+      do l=1,nlay
+         do ig=1,ngrid
+            q2(ig,l)=0.
+            wth2(ig,l)=0.
+            wth3(ig,l)=0.
+            ratqscth(ig,l)=0.
+            ratqsdiff(ig,l)=0.
+         enddo
+      enddo      
+      print*,'14d OK convect8'
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=fraca(ig,l)
+            zf2=zf/(1.-zf)
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
+            wth2(ig,l)=zf2*(zw2(ig,l))**2
+!           print*,'wth2=',wth2(ig,l)
+            wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
+     &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
+            q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+!test: on calcul q2/po=ratqsc
+            ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.))
+         enddo
+      enddo
+!calcul du ratqscdiff
+      print*,'14e OK convect8'
+      var=0.
+      vardiff=0.
+      ratqsdiff(:,:)=0.
+      do ig=1,ngrid
+         do l=1,lalim(ig)
+            var=var+alim_star(ig,l)*zqta(ig,l)*1000.
+         enddo
+      enddo
+      print*,'14f OK convect8'
+      do ig=1,ngrid
+          do l=1,lalim(ig)
+          zf=fraca(ig,l)
+          zf2=zf/(1.-zf)
+          vardiff=vardiff+alim_star(ig,l)  &
+     &           *(zqta(ig,l)*1000.-var)**2
+!         ratqsdiff=ratqsdiff+alim_star(ig,l)*
+!     s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+          enddo
+      enddo
+      print*,'14g OK convect8'
+      do l=1,nlay
+         do ig=1,ngrid
+            ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
+!           write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
+         enddo
+      enddo 
+!--------------------------------------------------------------------    
+!
+!ecriture des fichiers sortie
+!     print*,'15 OK convect8'
+
+      isplit=isplit+1       
+
+
+#ifdef und
+      if (lev_out.ge.1) print*,'thermcell_main sorties 1D'
+#include "thermcell_out1d.h"
+#endif
+
+
+! #define troisD
+      if (lev_out.ge.1) print*,'thermcell_main sorties 3D'
+#ifdef troisD
+#include "thermcell_out3d.h"
+#endif
+
+      endif
+
+      if (lev_out.ge.1) print*,'thermcell_main FIN  OK'
+
+      return
+      end
+
+!-----------------------------------------------------------------------------
+
+      subroutine test_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment)
+
+      integer klon,klev
+      real pplev(klon,klev+1),pplay(klon,klev)
+      real ztv(klon,klev)
+      real po(klon,klev)
+      real ztva(klon,klev)
+      real zqla(klon,klev)
+      real f_star(klon,klev)
+      real zw2(klon,klev)
+      integer long(klon)
+      real seuil
+      character*21 comment
+
+      print*,'TEST ',comment
+!  test sur la hauteur des thermiques ...
+         do i=1,klon
+            if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
+               print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
+               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
+               do k=1,klev
+                  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)
+               enddo
+!              stop
+            endif
+         enddo
+
+
+      return
+      end
+
Index: LMDZ4/trunk/libf/phylmd/thermcell_old.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_old.F	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_old.F	(revision 878)
@@ -0,0 +1,6083 @@
+      SUBROUTINE thermcell_2002(ngrid,nlay,ptimestep
+     s                  ,pplay,pplev,pphi
+     s                  ,pu,pv,pt,po
+     s                  ,pduadj,pdvadj,pdtadj,pdoadj
+     s                  ,fm0,entr0
+c    s                  ,pu_therm,pv_therm
+     s                  ,r_aspect,l_mix,w2di,tho)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c
+c   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+c
+c   le thermique est supposé homogène et dissipé par mélange avec
+c   son environnement. la longueur l_mix contrôle l'efficacité du
+c   mélange
+c
+c   Le calcul du transport des différentes espèces se fait en prenant
+c   en compte:
+c     1. un flux de masse montant
+c     2. un flux de masse descendant
+c     3. un entrainement
+c     4. un detrainement
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,w2di,tho
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+      integer idetr
+      save idetr
+      data idetr/3/
+
+c   local:
+c   ------
+
+      INTEGER ig,k,l,lmax(klon,klev+1),lmaxa(klon),lmix(klon)
+      real zmax(klon),zw,zz,zw2(klon,klev+1),ztva(klon,klev),zzz
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      REAL zh(klon,klev),zdhadj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      REAL wh(klon,klev+1)
+      real wu(klon,klev+1),wv(klon,klev+1),wo(klon,klev+1)
+      real zla(klon,klev+1)
+      real zwa(klon,klev+1)
+      real zld(klon,klev+1)
+      real zwd(klon,klev+1)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zha(klon,klev)
+      real wa_moy(klon,klev+1)
+      real fraca(klon,klev+1)
+      real fracc(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev)
+      common/comtherm/thetath2,wth2
+
+      real count_time
+      integer isplit,nsplit,ialt
+      parameter (nsplit=10)
+      data isplit/0/
+      save isplit
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+      real wmax(klon,klev),wmaxa(klon)
+
+      real wa(klon,klev,klev+1)
+      real wd(klon,klev+1)
+      real larg_part(klon,klev,klev+1)
+      real fracd(klon,klev+1)
+      real xxx(klon,klev+1)
+      real larg_cons(klon,klev+1)
+      real larg_detr(klon,klev+1)
+      real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
+      real pu_therm(klon,klev),pv_therm(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev)
+      real fmc(klon,klev+1)
+
+      character*2 str2
+      character*10 str10
+
+      LOGICAL vtest(klon),down
+
+      EXTERNAL SCOPY
+
+      integer ncorrec,ll
+      save ncorrec
+      data ncorrec/0/
+c
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+       sorties=.true.
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+c
+c-----------------------------------------------------------------------
+c   incrementation eventuelle de tendances precedentes:
+c   ---------------------------------------------------
+
+      print*,'0 OK convect8'
+
+      DO 1010 l=1,nlay
+         DO 1015 ig=1,ngrid
+            zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
+            zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zu(ig,l)=pu(ig,l)
+            zv(ig,l)=pv(ig,l)
+            zo(ig,l)=po(ig,l)
+            ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+1015     CONTINUE
+1010  CONTINUE
+
+c     print*,'1 OK convect8'
+c                       --------------------
+c
+c
+c                       + + + + + + + + + + +
+c
+c
+c  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+c  wh,wt,wo ...
+c
+c                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+c
+c
+c                       --------------------   zlev(1)
+c                       \\\\\\\\\\\\\\\\\\\\
+c
+c
+
+c-----------------------------------------------------------------------
+c   Calcul des altitudes des couches
+c-----------------------------------------------------------------------
+
+      do l=2,nlay
+         do ig=1,ngrid
+            zlev(ig,l)=0.5*(pphi(ig,l)+pphi(ig,l-1))/RG
+         enddo
+      enddo
+      do ig=1,ngrid
+         zlev(ig,1)=0.
+         zlev(ig,nlay+1)=(2.*pphi(ig,klev)-pphi(ig,klev-1))/RG
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid
+            zlay(ig,l)=pphi(ig,l)/RG
+         enddo
+      enddo
+
+c     print*,'2 OK convect8'
+c-----------------------------------------------------------------------
+c   Calcul des densites
+c-----------------------------------------------------------------------
+
+      do l=1,nlay
+         do ig=1,ngrid
+            rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            rhobarz(ig,l)=0.5*(rho(ig,l)+rho(ig,l-1))
+         enddo
+      enddo
+
+      do k=1,nlay
+         do l=1,nlay+1
+            do ig=1,ngrid
+               wa(ig,k,l)=0.
+            enddo
+         enddo
+      enddo
+
+c     print*,'3 OK convect8'
+c------------------------------------------------------------------
+c   Calcul de w2, quarre de w a partir de la cape
+c   a partir de w2, on calcule wa, vitesse de l'ascendance
+c
+c   ATTENTION: Dans cette version, pour cause d'economie de memoire,
+c   w2 est stoke dans wa
+c
+c   ATTENTION: dans convect8, on n'utilise le calcule des wa
+c   independants par couches que pour calculer l'entrainement
+c   a la base et la hauteur max de l'ascendance.
+c
+c   Indicages:
+c   l'ascendance provenant du niveau k traverse l'interface l avec
+c   une vitesse wa(k,l).
+c
+c                       --------------------
+c
+c                       + + + + + + + + + + 
+c
+c  wa(k,l)   ----       --------------------    l
+c             /\
+c            /||\       + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||
+c             ||        + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||__
+c             |___      + + + + + + + + + +     k
+c
+c                       --------------------
+c
+c
+c
+c------------------------------------------------------------------
+
+
+      do k=1,nlay-1
+         do ig=1,ngrid
+            wa(ig,k,k)=0.
+            wa(ig,k,k+1)=2.*RG*(ztv(ig,k)-ztv(ig,k+1))/ztv(ig,k+1)
+     s      *(zlev(ig,k+1)-zlev(ig,k))
+         enddo
+         do l=k+1,nlay-1
+            do ig=1,ngrid
+               wa(ig,k,l+1)=wa(ig,k,l)+
+     s         2.*RG*(ztv(ig,k)-ztv(ig,l))/ztv(ig,l)
+     s         *(zlev(ig,l+1)-zlev(ig,l))
+            enddo
+         enddo
+         do ig=1,ngrid
+            wa(ig,k,nlay+1)=0.
+         enddo
+      enddo
+
+c     print*,'4 OK convect8'
+c Calcul de la couche correspondant a la hauteur du thermique
+      do k=1,nlay-1
+         do ig=1,ngrid
+            lmax(ig,k)=k
+         enddo
+         do l=nlay,k+1,-1
+            do ig=1,ngrid
+               if(wa(ig,k,l).le.1.e-10) lmax(ig,k)=l-1
+            enddo
+         enddo
+      enddo
+
+c     print*,'5 OK convect8'
+c   Calcule du w max du thermique
+      do k=1,nlay
+      do ig=1,ngrid
+         wmax(ig,k)=0.
+      enddo
+      enddo
+
+      do k=1,nlay-1
+         do l=k,nlay
+            do ig=1,ngrid
+               if (l.le.lmax(ig,k)) then
+                  wa(ig,k,l)=sqrt(wa(ig,k,l))
+                  wmax(ig,k)=max(wmax(ig,k),wa(ig,k,l))
+               else
+                  wa(ig,k,l)=0.
+               endif
+            enddo
+         enddo
+      enddo
+
+      do k=1,nlay-1
+         do ig=1,ngrid
+             pu_therm(ig,k)=sqrt(wmax(ig,k))
+             pv_therm(ig,k)=sqrt(wmax(ig,k))
+         enddo
+      enddo
+
+c     print*,'6 OK convect8'
+c   Longueur caracteristique correspondant a la hauteur des thermiques.
+      do  ig=1,ngrid
+         zmax(ig)=500.
+      enddo
+c     print*,'LMAX LMAX LMAX '
+      do k=1,nlay-1
+         do  ig=1,ngrid
+            zmax(ig)=max(zmax(ig),zlev(ig,lmax(ig,k))-zlev(ig,k))
+         enddo
+c     print*,k,lmax(1,k)
+      enddo
+c     print*,'ZMAX ZMAX ZMAX ',zmax
+c      call dump2d(iim,jjm-1,zmax(2:ngrid-1),'ZMAX      ')
+
+c   Calcul de l'entrainement.
+c   Le rapport d'aspect relie la largeur de l'ascendance a l'epaisseur
+c   de la couche d'alimentation en partant du principe que la vitesse
+c   maximum dans l'ascendance est la vitesse d'entrainement horizontale.
+      do k=1,nlay
+         do ig=1,ngrid
+            zzz=rho(ig,k)*wmax(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+     s    /(zmax(ig)*r_aspect)
+            if(w2di.eq.2) then
+               entr(ig,k)=entr(ig,k)+
+     s         ptimestep*(zzz-entr(ig,k))/float(tho)
+            else
+               entr(ig,k)=zzz
+            endif
+            ztva(ig,k)=ztv(ig,k)
+         enddo
+      enddo
+
+c     print*,'7 OK convect8'
+      do k=1,klev+1
+         do ig=1,ngrid
+            zw2(ig,k)=0.
+            fmc(ig,k)=0.
+            larg_cons(ig,k)=0.
+            larg_detr(ig,k)=0.
+            wa_moy(ig,k)=0.
+         enddo
+      enddo
+
+c     print*,'8 OK convect8'
+      do ig=1,ngrid
+         lmaxa(ig)=1
+         lmix(ig)=1
+         wmaxa(ig)=0.
+      enddo
+
+
+      do l=1,nlay-2
+         do ig=1,ngrid
+c           if (zw2(ig,l).lt.1.e-10.and.ztv(ig,l).gt.ztv(ig,l+1)) then
+c         print*,'COUCOU ',l,zw2(ig,l),ztv(ig,l),ztv(ig,l+1)
+            if (zw2(ig,l).lt.1.e-10.and.ztv(ig,l).gt.ztv(ig,l+1)
+     s       .and.entr(ig,l).gt.1.e-10) then
+c        print*,'COUCOU cas 1'
+c   Initialisation de l'ascendance
+c              lmix(ig)=1
+               ztva(ig,l)=ztv(ig,l)
+               fmc(ig,l)=0.
+               fmc(ig,l+1)=entr(ig,l)
+               zw2(ig,l)=0.
+c     if (.not.ztv(ig,l+1).gt.150.) then
+c     print*,'ig,l+1,ztv(ig,l+1)'
+c     print*, ig,l+1,ztv(ig,l+1)
+c        stop'dans thermiques'
+c     endif
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
+     s         *(zlev(ig,l+1)-zlev(ig,l))
+               larg_detr(ig,l)=0.
+            else if (zw2(ig,l).ge.1.e-10.and.
+     .               fmc(ig,l)+entr(ig,l).gt.1.e-10) then
+c   Incrementation...
+               fmc(ig,l+1)=fmc(ig,l)+entr(ig,l)
+c     if (.not.fmc(ig,l+1).gt.1.e-15) then
+c     print*,'ig,l+1,fmc(ig,l+1)'
+c     print*, ig,l+1,fmc(ig,l+1)
+c     print*,'Fmc ',(fmc(ig,ll),ll=1,klev+1)
+c     print*,'W2 ',(zw2(ig,ll),ll=1,klev+1)
+c     print*,'Tv ',(ztv(ig,ll),ll=1,klev)
+c     print*,'Entr ',(entr(ig,ll),ll=1,klev)
+c        stop'dans thermiques'
+c     endif
+               ztva(ig,l)=(fmc(ig,l)*ztva(ig,l-1)+entr(ig,l)*ztv(ig,l))
+     s          /fmc(ig,l+1)
+c  mise a jour de la vitesse ascendante (l'air entraine de la couche
+c  consideree commence avec une vitesse nulle).
+               zw2(ig,l+1)=zw2(ig,l)*(fmc(ig,l)/fmc(ig,l+1))**2+
+     s         2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+     s         *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+            if (zw2(ig,l+1).lt.0.) then
+               zw2(ig,l+1)=0.
+               lmaxa(ig)=l
+            else
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+            endif
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+c   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
+c        print*,'COUCOU cas 2 LMIX=',lmix(ig),wa_moy(ig,l+1),wmaxa(ig)
+         enddo
+      enddo
+
+c     print*,'9 OK convect8'
+c     print*,'WA1 ',wa_moy
+
+c   determination de l'indice du debut de la mixed layer ou w decroit
+
+c   calcul de la largeur de chaque ascendance dans le cas conservatif.
+c   dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+c   d'une couche est égale à la hauteur de la couche alimentante.
+c   La vitesse maximale dans l'ascendance est aussi prise comme estimation
+c   de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+               zw=max(wa_moy(ig,l),1.e-10)
+               larg_cons(ig,l)=zmax(ig)*r_aspect
+     s         *fmc(ig,l)/(rhobarz(ig,l)*zw)
+            endif
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+c              if (idetr.eq.0) then
+c  cette option est finalement en dur.
+                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c              else if (idetr.eq.1) then
+c                 larg_detr(ig,l)=larg_cons(ig,l)
+c    s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+c              else if (idetr.eq.2) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *sqrt(wa_moy(ig,l))
+c              else if (idetr.eq.4) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *wa_moy(ig,l)
+c              endif
+            endif
+         enddo
+       enddo
+
+c     print*,'10 OK convect8'
+c     print*,'WA2 ',wa_moy
+c   calcul de la fraction de la maille concernée par l'ascendance en tenant
+c   compte de l'epluchage du thermique.
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if(larg_cons(ig,l).gt.1.) then
+c     print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+               fraca(ig,l)=(larg_cons(ig,l)-larg_detr(ig,l))
+     s            /(r_aspect*zmax(ig))
+               if(l.gt.lmix(ig)) then
+                  xxx(ig,l)=(lmaxa(ig)+1.-l) / (lmaxa(ig)+1.-lmix(ig))
+           if (idetr.eq.0) then
+               fraca(ig,l)=fraca(ig,lmix(ig))
+           else if (idetr.eq.1) then
+               fraca(ig,l)=fraca(ig,lmix(ig))*xxx(ig,l)
+           else if (idetr.eq.2) then
+               fraca(ig,l)=fraca(ig,lmix(ig))*(1.-(1.-xxx(ig,l))**2)
+           else
+               fraca(ig,l)=fraca(ig,lmix(ig))*xxx(ig,l)**2
+           endif
+               endif
+c     print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+            else
+c              wa_moy(ig,l)=0.
+               fraca(ig,l)=0.
+               fracc(ig,l)=0.
+               fracd(ig,l)=1.
+            endif
+         enddo
+      enddo
+
+c     print*,'11 OK convect8'
+c     print*,'Ea3 ',wa_moy
+c------------------------------------------------------------------
+c   Calcul de fracd, wd
+c   somme wa - wd = 0
+c------------------------------------------------------------------
+
+
+      do ig=1,ngrid
+         fm(ig,1)=0.
+         fm(ig,nlay+1)=0.
+      enddo
+
+      do l=2,nlay
+           do ig=1,ngrid
+              fm(ig,l)=fraca(ig,l)*wa_moy(ig,l)*rhobarz(ig,l)
+           enddo
+         do ig=1,ngrid
+            if(fracd(ig,l).lt.0.1) then
+               stop'fracd trop petit'
+            else
+c    vitesse descendante "diagnostique"
+               wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l))
+            endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+c           masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+            masse(ig,l)=(pplev(ig,l)-pplev(ig,l+1))/RG
+         enddo
+      enddo
+
+c     print*,'12 OK convect8'
+c     print*,'WA4 ',wa_moy
+cc------------------------------------------------------------------
+c   calcul du transport vertical
+c------------------------------------------------------------------
+
+      go to 4444
+c     print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+      do l=2,nlay-1
+         do ig=1,ngrid
+            if(fm(ig,l+1)*ptimestep.gt.masse(ig,l)
+     s      .and.fm(ig,l+1)*ptimestep.gt.masse(ig,l+1)) then
+c     print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+c    s         ,fm(ig,l+1)*ptimestep
+c    s         ,'   M=',masse(ig,l),masse(ig,l+1)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(entr(ig,l)*ptimestep.gt.masse(ig,l)) then
+c     print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+c    s         ,entr(ig,l)*ptimestep
+c    s         ,'   M=',masse(ig,l)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(.not.fm(ig,l).ge.0..or..not.fm(ig,l).le.10.) then
+c     print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+c    s         ,'   FM=',fm(ig,l)
+            endif
+            if(.not.masse(ig,l).ge.1.e-10
+     s         .or..not.masse(ig,l).le.1.e4) then
+c     print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+c    s         ,'   M=',masse(ig,l)
+c     print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+c    s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+c     print*,'zlev(ig,l+1),zlev(ig,l)'
+c    s                ,zlev(ig,l+1),zlev(ig,l)
+c     print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+c    s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+            endif
+            if(.not.entr(ig,l).ge.0..or..not.entr(ig,l).le.10.) then
+c     print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+c    s         ,'   E=',entr(ig,l)
+            endif
+         enddo
+      enddo
+
+4444   continue
+
+      if (w2di.eq.1) then
+         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+      else
+         fm0=fm
+         entr0=entr
+      endif
+
+      if (1.eq.1) then
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zh,zdhadj,zha)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zo,pdoadj,zoa)
+      else
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zh,zdhadj,zha)
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zo,pdoadj,zoa)
+      endif
+
+      if (1.eq.0) then
+         call dvthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,fraca,zmax
+     .    ,zu,zv,pduadj,pdvadj,zua,zva)
+      else
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zu,pduadj,zua)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zv,pdvadj,zva)
+      endif
+
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
+            zf2=zf/(1.-zf)
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
+            wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+         enddo
+      enddo
+
+
+
+c     print*,'13 OK convect8'
+c     print*,'WA5 ',wa_moy
+      do l=1,nlay
+         do ig=1,ngrid
+            pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+         enddo
+      enddo
+
+
+c     do l=1,nlay
+c        do ig=1,ngrid
+c           if(abs(pdtadj(ig,l))*86400..gt.500.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdtadj=',pdtadj(ig,l)
+c           endif
+c           if(abs(pdoadj(ig,l))*86400..gt.1.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdoadj=',pdoadj(ig,l)
+c           endif
+c        enddo
+c      enddo
+
+c     print*,'14 OK convect8'
+c------------------------------------------------------------------
+c   Calculs pour les sorties
+c------------------------------------------------------------------
+
+      if(sorties) then
+      do l=1,nlay
+         do ig=1,ngrid
+            zla(ig,l)=(1.-fracd(ig,l))*zmax(ig)
+            zld(ig,l)=fracd(ig,l)*zmax(ig)
+            if(1.-fracd(ig,l).gt.1.e-10)
+     s      zwa(ig,l)=wd(ig,l)*fracd(ig,l)/(1.-fracd(ig,l))
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+            if (detr(ig,l).lt.0.) then
+                entr(ig,l)=entr(ig,l)-detr(ig,l)
+                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+            endif
+         enddo
+      enddo
+
+c     print*,'15 OK convect8'
+
+      isplit=isplit+1
+
+
+c #define und
+	goto 123
+#ifdef und
+      CALL writeg1d(1,nlay,wd,'wd      ','wd      ')
+      CALL writeg1d(1,nlay,zwa,'wa      ','wa      ')
+      CALL writeg1d(1,nlay,fracd,'fracd      ','fracd      ')
+      CALL writeg1d(1,nlay,fraca,'fraca      ','fraca      ')
+      CALL writeg1d(1,nlay,wa_moy,'wam         ','wam         ')
+      CALL writeg1d(1,nlay,zla,'la      ','la      ')
+      CALL writeg1d(1,nlay,zld,'ld      ','ld      ')
+      CALL writeg1d(1,nlay,pt,'pt      ','pt      ')
+      CALL writeg1d(1,nlay,zh,'zh      ','zh      ')
+      CALL writeg1d(1,nlay,zha,'zha      ','zha      ')
+      CALL writeg1d(1,nlay,zu,'zu      ','zu      ')
+      CALL writeg1d(1,nlay,zv,'zv      ','zv      ')
+      CALL writeg1d(1,nlay,zo,'zo      ','zo      ')
+      CALL writeg1d(1,nlay,wh,'wh      ','wh      ')
+      CALL writeg1d(1,nlay,wu,'wu      ','wu      ')
+      CALL writeg1d(1,nlay,wv,'wv      ','wv      ')
+      CALL writeg1d(1,nlay,wo,'w15uo     ','wXo     ')
+      CALL writeg1d(1,nlay,zdhadj,'zdhadj      ','zdhadj      ')
+      CALL writeg1d(1,nlay,pduadj,'pduadj      ','pduadj      ')
+      CALL writeg1d(1,nlay,pdvadj,'pdvadj      ','pdvadj      ')
+      CALL writeg1d(1,nlay,pdoadj,'pdoadj      ','pdoadj      ')
+      CALL writeg1d(1,nlay,entr  ,'entr        ','entr        ')
+      CALL writeg1d(1,nlay,detr  ,'detr        ','detr        ')
+      CALL writeg1d(1,nlay,fm    ,'fm          ','fm          ')
+
+      CALL writeg1d(1,nlay,pdtadj,'pdtadj    ','pdtadj    ')
+      CALL writeg1d(1,nlay,pplay,'pplay     ','pplay     ')
+      CALL writeg1d(1,nlay,pplev,'pplev     ','pplev     ')
+c   recalcul des flux en diagnostique...
+c     print*,'PAS DE TEMPS ',ptimestep
+       call dt2F(pplev,pplay,pt,pdtadj,wh)
+      CALL writeg1d(1,nlay,wh,'wh2     ','wh2     ')
+#endif
+123   continue
+! #define troisD
+#ifdef troisD
+c       if (sorties) then
+      print*,'Debut des wrgradsfi'
+
+c      print*,'16 OK convect8'
+         call wrgradsfi(1,nlay,wd,'wd        ','wd        ')
+         call wrgradsfi(1,nlay,zwa,'wa        ','wa        ')
+         call wrgradsfi(1,nlay,fracd,'fracd     ','fracd     ')
+         call wrgradsfi(1,nlay,fraca,'fraca     ','fraca     ')
+         call wrgradsfi(1,nlay,xxx,'xxx       ','xxx       ')
+         call wrgradsfi(1,nlay,wa_moy,'wam       ','wam       ')
+c      print*,'WA6 ',wa_moy
+         call wrgradsfi(1,nlay,zla,'la        ','la        ')
+         call wrgradsfi(1,nlay,zld,'ld        ','ld        ')
+         call wrgradsfi(1,nlay,pt,'pt        ','pt        ')
+         call wrgradsfi(1,nlay,zh,'zh        ','zh        ')
+         call wrgradsfi(1,nlay,zha,'zha        ','zha        ')
+         call wrgradsfi(1,nlay,zua,'zua        ','zua        ')
+         call wrgradsfi(1,nlay,zva,'zva        ','zva        ')
+         call wrgradsfi(1,nlay,zu,'zu        ','zu        ')
+         call wrgradsfi(1,nlay,zv,'zv        ','zv        ')
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,wh,'wh        ','wh        ')
+         call wrgradsfi(1,nlay,wu,'wu        ','wu        ')
+         call wrgradsfi(1,nlay,wv,'wv        ','wv        ')
+         call wrgradsfi(1,nlay,wo,'wo        ','wo        ')
+         call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+         call wrgradsfi(1,nlay,zdhadj,'zdhadj    ','zdhadj    ')
+         call wrgradsfi(1,nlay,pduadj,'pduadj    ','pduadj    ')
+         call wrgradsfi(1,nlay,pdvadj,'pdvadj    ','pdvadj    ')
+         call wrgradsfi(1,nlay,pdoadj,'pdoadj    ','pdoadj    ')
+         call wrgradsfi(1,nlay,entr,'entr      ','entr      ')
+         call wrgradsfi(1,nlay,detr,'detr      ','detr      ')
+         call wrgradsfi(1,nlay,fm,'fm        ','fm        ')
+         call wrgradsfi(1,nlay,fmc,'fmc       ','fmc       ')
+         call wrgradsfi(1,nlay,zw2,'zw2       ','zw2       ')
+         call wrgradsfi(1,nlay,ztva,'ztva      ','ztva      ')
+         call wrgradsfi(1,nlay,ztv,'ztv       ','ztv       ')
+
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,larg_cons,'Lc        ','Lc        ')
+         call wrgradsfi(1,nlay,larg_detr,'Ldetr     ','Ldetr     ')
+
+
+c      print*,'17 OK convect8'
+
+         do k=1,klev/10
+            write(str2,'(i2.2)') k
+            str10='wa'//str2
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=wa(ig,k,l)
+               enddo
+            enddo   
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=larg_part(ig,k,l)
+               enddo
+            enddo
+            str10='la'//str2
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+         enddo
+
+
+c     print*,'18 OK convect8'
+c      endif
+      print*,'Fin des wrgradsfi'
+#endif
+
+      endif
+
+c     if(wa_moy(1,4).gt.1.e-10) stop
+
+c     print*,'19 OK convect8'
+      return
+      end
+
+      SUBROUTINE thermcell_cld(ngrid,nlay,ptimestep
+     s                  ,pplay,pplev,pphi,zlev,debut
+     s                  ,pu,pv,pt,po
+     s                  ,pduadj,pdvadj,pdtadj,pdoadj
+     s                  ,fm0,entr0,zqla,lmax
+     s                  ,zmax_sec,wmax_sec,zw_sec,lmix_sec
+     s                  ,ratqscth,ratqsdiff
+c    s                  ,pu_therm,pv_therm
+     s                  ,r_aspect,l_mix,w2di,tho)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c
+c   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+c
+c   le thermique est supposé homogène et dissipé par mélange avec
+c   son environnement. la longueur l_mix contrôle l'efficacité du
+c   mélange
+c
+c   Le calcul du transport des différentes espèces se fait en prenant
+c   en compte:
+c     1. un flux de masse montant
+c     2. un flux de masse descendant
+c     3. un entrainement
+c     4. un detrainement
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,w2di,tho
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+      integer idetr
+      save idetr
+      data idetr/3/
+
+c   local:
+c   ------
+
+      INTEGER ig,k,l,lmaxa(klon),lmix(klon)
+      real zsortie1d(klon)
+c CR: on remplace lmax(klon,klev+1)
+      INTEGER lmax(klon),lmin(klon),lentr(klon)
+      real linter(klon)
+      real zmix(klon), fracazmix(klon)
+      real alpha
+      save alpha
+      data alpha/1./
+c RC 
+      real zmax(klon),zw,zz,zw2(klon,klev+1),ztva(klon,klev),zzz
+      real zmax_sec(klon)
+      real zmax_sec2(klon)
+      real zw_sec(klon,klev+1)
+      INTEGER lmix_sec(klon)
+      real w_est(klon,klev+1)
+con garde le zmax du pas de temps precedent
+      real zmax0(klon)
+      save zmax0
+      real zmix0(klon)
+      save zmix0 
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      real deltaz(klon,klev)
+      REAL zh(klon,klev),zdhadj(klon,klev)
+      real zthl(klon,klev),zdthladj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      real zl(klon,klev)
+      REAL wh(klon,klev+1)
+      real wu(klon,klev+1),wv(klon,klev+1),wo(klon,klev+1)
+      real zla(klon,klev+1)
+      real zwa(klon,klev+1)
+      real zld(klon,klev+1)
+      real zwd(klon,klev+1)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zta(klon,klev)
+      real zha(klon,klev)
+      real wa_moy(klon,klev+1)
+      real fraca(klon,klev+1)
+      real fracc(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev)
+      real q2(klon,klev)
+      real dtheta(klon,klev)
+      common/comtherm/thetath2,wth2
+    
+      real ratqscth(klon,klev)
+      real sum
+      real sumdiff
+      real ratqsdiff(klon,klev)
+      real count_time
+      integer isplit,nsplit,ialt
+      parameter (nsplit=10)
+      data isplit/0/
+      save isplit
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+c     real wmax(klon,klev),wmaxa(klon)
+      real wmax(klon),wmaxa(klon)
+      real wmax_sec(klon)
+      real wmax_sec2(klon)
+      real wa(klon,klev,klev+1)
+      real wd(klon,klev+1)
+      real larg_part(klon,klev,klev+1)
+      real fracd(klon,klev+1)
+      real xxx(klon,klev+1)
+      real larg_cons(klon,klev+1)
+      real larg_detr(klon,klev+1)
+      real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
+      real massetot(klon,klev)
+      real detr0(klon,klev)
+      real alim0(klon,klev)
+      real pu_therm(klon,klev),pv_therm(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev)
+      real fmc(klon,klev+1)
+
+      real zcor,zdelta,zcvm5,qlbef
+      real Tbef(klon),qsatbef(klon)
+      real dqsat_dT,DT,num,denom
+      REAL REPS,RLvCp,DDT0
+      real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
+cCR niveau de condensation
+      real nivcon(klon)
+      real zcon(klon)
+      real zqsat(klon,klev)
+      real zqsatth(klon,klev) 
+      PARAMETER (DDT0=.01)
+
+
+cCR:nouvelles variables
+      real f_star(klon,klev+1),entr_star(klon,klev)
+      real detr_star(klon,klev)
+      real alim_star_tot(klon),alim_star2(klon)
+      real entr_star_tot(klon)
+      real detr_star_tot(klon)
+      real alim_star(klon,klev)
+      real alim(klon,klev)
+      real nu(klon,klev)
+      real nu_e(klon,klev)
+      real nu_min
+      real nu_max
+      real nu_r
+      real f(klon), f0(klon)
+      save f0
+      real f_old
+      real zlevinter(klon)
+      logical first
+c      data first /.false./
+c      save first
+      logical nuage
+c      save nuage
+      logical boucle
+      logical therm
+      logical debut
+      logical rale
+      integer test(klon)
+      integer signe_zw2
+cRC
+
+      character*2 str2
+      character*10 str10
+
+      LOGICAL vtest(klon),down
+      LOGICAL Zsat(klon)
+
+      EXTERNAL SCOPY
+
+      integer ncorrec,ll
+      save ncorrec
+      data ncorrec/0/
+c
+
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+       sorties=.false.
+c     print*,'NOUVEAU DETR PLUIE '
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+c
+c Initialisation
+      RLvCp = RLVTT/RCPD
+      REPS  = RD/RV
+cinitialisations de zqsat
+      DO ll=1,nlay
+         DO ig=1,ngrid
+            zqsat(ig,ll)=0.
+            zqsatth(ig,ll)=0.
+         ENDDO
+      ENDDO
+c
+con met le first a true pour le premier passage de la journée
+      do ig=1,klon
+            test(ig)=0
+      enddo
+      if (debut) then
+         do ig=1,klon
+            test(ig)=1
+            f0(ig)=0.
+            zmax0(ig)=0.
+         enddo
+      endif
+      do ig=1,klon      
+         if ((.not.debut).and.(f0(ig).lt.1.e-10)) then
+            test(ig)=1
+         endif
+      enddo 
+c     do ig=1,klon
+c        print*,'test(ig)',test(ig),zmax0(ig)
+c     enddo
+      nuage=.false.
+c-----------------------------------------------------------------------
+cAM Calcul de T,q,ql a partir de Tl et qT
+c   ---------------------------------------------------
+c
+c Pr Tprec=Tl calcul de qsat 
+c Si qsat>qT T=Tl, q=qT
+c Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt) 
+c On cherche DDT < DDT0
+c
+c defaut
+       DO  ll=1,nlay
+         DO ig=1,ngrid
+            zo(ig,ll)=po(ig,ll)
+            zl(ig,ll)=0.
+            zh(ig,ll)=pt(ig,ll)
+         EndDO
+       EndDO
+       do ig=1,ngrid
+          Zsat(ig)=.false.
+       enddo
+c
+c
+       DO ll=1,nlay
+c les points insatures sont definitifs
+         DO ig=1,ngrid
+            Tbef(ig)=pt(ig,ll)
+            zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+            qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,ll)
+            qsatbef(ig)=MIN(0.5,qsatbef(ig))
+            zcor=1./(1.-retv*qsatbef(ig))
+            qsatbef(ig)=qsatbef(ig)*zcor
+            Zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig)) .gt. 1.e-10)
+         EndDO
+
+         DO ig=1,ngrid
+           if (Zsat(ig).and.(1.eq.1)) then
+            qlbef=max(0.,po(ig,ll)-qsatbef(ig))
+c si sature: ql est surestime, d'ou la sous-relax
+            DT = 0.5*RLvCp*qlbef
+c            write(18,*),'DT0=',DT
+c on pourra enchainer 2 ou 3 calculs sans Do while
+            do while (abs(DT).gt.DDT0)
+c il faut verifier si c,a conserve quand on repasse en insature ...
+              Tbef(ig)=Tbef(ig)+DT
+              zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+              qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,ll)
+              qsatbef(ig)=MIN(0.5,qsatbef(ig))
+              zcor=1./(1.-retv*qsatbef(ig))
+              qsatbef(ig)=qsatbef(ig)*zcor
+c on veut le signe de qlbef
+              qlbef=po(ig,ll)-qsatbef(ig)
+              zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+              zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+              zcor=1./(1.-retv*qsatbef(ig))
+              dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef(ig),zcor)
+              num=-Tbef(ig)+pt(ig,ll)+RLvCp*qlbef
+              denom=1.+RLvCp*dqsat_dT
+              if (denom.lt.1.e-10) then
+                  print*,'pb denom'
+              endif
+              DT=num/denom
+            enddo
+c on ecrit de maniere conservative (sat ou non)
+            zl(ig,ll) = max(0.,qlbef)
+c          T = Tl +Lv/Cp ql
+            zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)
+            zo(ig,ll) = po(ig,ll)-zl(ig,ll)
+           endif
+con ecrit zqsat 
+            zqsat(ig,ll)=qsatbef(ig)     
+         EndDO
+       EndDO
+cAM fin
+c
+c-----------------------------------------------------------------------
+c   incrementation eventuelle de tendances precedentes:
+c   ---------------------------------------------------
+
+c     print*,'0 OK convect8'
+
+      DO 1010 l=1,nlay
+         DO 1015 ig=1,ngrid
+             zpspsk(ig,l)=(pplay(ig,l)/100000.)**RKAPPA
+c            zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
+c            zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zu(ig,l)=pu(ig,l)
+            zv(ig,l)=pv(ig,l)
+c            zo(ig,l)=po(ig,l)
+c            ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+cAM attention zh est maintenant le profil de T et plus le profil de theta !
+c
+c   T-> Theta
+            ztv(ig,l)=zh(ig,l)/zpspsk(ig,l)
+cAM Theta_v
+            ztv(ig,l)=ztv(ig,l)*(1.+RETV*(zo(ig,l))
+     s           -zl(ig,l))
+cAM Thetal
+            zthl(ig,l)=pt(ig,l)/zpspsk(ig,l)
+c            
+1015     CONTINUE
+1010  CONTINUE
+
+c     print*,'1 OK convect8'
+c                       --------------------
+c
+c
+c                       + + + + + + + + + + +
+c
+c
+c  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+c  wh,wt,wo ...
+c
+c                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+c
+c
+c                       --------------------   zlev(1)
+c                       \\\\\\\\\\\\\\\\\\\\
+c
+c
+
+c-----------------------------------------------------------------------
+c   Calcul des altitudes des couches
+c-----------------------------------------------------------------------
+
+      do l=2,nlay
+         do ig=1,ngrid
+            zlev(ig,l)=0.5*(pphi(ig,l)+pphi(ig,l-1))/RG
+         enddo
+      enddo
+      do ig=1,ngrid
+         zlev(ig,1)=0.
+         zlev(ig,nlay+1)=(2.*pphi(ig,klev)-pphi(ig,klev-1))/RG
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid
+            zlay(ig,l)=pphi(ig,l)/RG
+         enddo
+      enddo
+ccalcul de deltaz
+      do l=1,nlay
+         do ig=1,ngrid
+            deltaz(ig,l)=zlev(ig,l+1)-zlev(ig,l)
+         enddo
+      enddo
+
+c     print*,'2 OK convect8'
+c-----------------------------------------------------------------------
+c   Calcul des densites
+c-----------------------------------------------------------------------
+
+      do l=1,nlay
+         do ig=1,ngrid
+c            rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+             rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*ztv(ig,l))
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            rhobarz(ig,l)=0.5*(rho(ig,l)+rho(ig,l-1))
+         enddo
+      enddo
+
+      do k=1,nlay
+         do l=1,nlay+1
+            do ig=1,ngrid
+               wa(ig,k,l)=0.
+            enddo
+         enddo
+      enddo
+cCr:ajout:calcul de la masse
+      do l=1,nlay
+         do ig=1,ngrid
+c           masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+            masse(ig,l)=(pplev(ig,l)-pplev(ig,l+1))/RG
+         enddo
+      enddo
+c     print*,'3 OK convect8'
+c------------------------------------------------------------------
+c   Calcul de w2, quarre de w a partir de la cape
+c   a partir de w2, on calcule wa, vitesse de l'ascendance
+c
+c   ATTENTION: Dans cette version, pour cause d'economie de memoire,
+c   w2 est stoke dans wa
+c
+c   ATTENTION: dans convect8, on n'utilise le calcule des wa
+c   independants par couches que pour calculer l'entrainement
+c   a la base et la hauteur max de l'ascendance.
+c
+c   Indicages:
+c   l'ascendance provenant du niveau k traverse l'interface l avec
+c   une vitesse wa(k,l).
+c
+c                       --------------------
+c
+c                       + + + + + + + + + + 
+c
+c  wa(k,l)   ----       --------------------    l
+c             /\
+c            /||\       + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||
+c             ||        + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||__
+c             |___      + + + + + + + + + +     k
+c
+c                       --------------------
+c
+c
+c
+c------------------------------------------------------------------
+
+cCR: ponderation entrainement des couches instables
+cdef des alim_star tels que alim=f*alim_star      
+      do l=1,klev
+         do ig=1,ngrid 
+            alim_star(ig,l)=0.
+            alim(ig,l)=0.
+         enddo
+      enddo
+c determination de la longueur de la couche d entrainement
+      do ig=1,ngrid
+         lentr(ig)=1
+      enddo
+
+con ne considere que les premieres couches instables
+      therm=.false.
+      do k=nlay-2,1,-1
+         do ig=1,ngrid
+            if (ztv(ig,k).gt.ztv(ig,k+1).and.
+     s          ztv(ig,k+1).le.ztv(ig,k+2)) then
+               lentr(ig)=k+1
+               therm=.true.
+            endif
+          enddo
+      enddo
+c
+c determination du lmin: couche d ou provient le thermique
+      do ig=1,ngrid
+         lmin(ig)=1
+      enddo
+      do ig=1,ngrid
+         do l=nlay,2,-1
+            if (ztv(ig,l-1).gt.ztv(ig,l)) then
+               lmin(ig)=l-1
+            endif
+         enddo
+      enddo
+c
+c definition de l'entrainement des couches
+      do l=1,klev-1
+         do ig=1,ngrid 
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.
+     s          l.ge.lmin(ig).and.l.lt.lentr(ig)) then
+cdef possibles pour alim_star: zdthetadz, dthetadz, zdtheta
+             alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)
+c     s                       *(zlev(ig,l+1)-zlev(ig,l))
+     s                       *sqrt(zlev(ig,l+1))
+c             alim_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
+c     s                         /zlev(ig,lentr(ig)+2)))**(3./2.) 
+            endif
+         enddo
+      enddo
+      
+c pas de thermique si couche 1 stable
+      do ig=1,ngrid
+c         if (lmin(ig).gt.1) then
+cCRnouveau test
+        if (alim_star(ig,1).lt.1.e-10) then 
+            do l=1,klev
+                alim_star(ig,l)=0.
+            enddo
+         endif
+      enddo 
+c calcul de l entrainement total
+      do ig=1,ngrid
+         alim_star_tot(ig)=0.
+         entr_star_tot(ig)=0.
+         detr_star_tot(ig)=0.
+      enddo
+      do ig=1,ngrid
+         do k=1,klev
+            alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,k)
+         enddo
+      enddo
+c
+c Calcul entrainement normalise
+      do ig=1,ngrid 
+         if (alim_star_tot(ig).gt.1.e-10) then
+c         do l=1,lentr(ig)
+          do l=1,klev
+cdef possibles pour entr_star: zdthetadz, dthetadz, zdtheta 
+            alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
+         enddo
+         endif
+      enddo
+       
+c     print*,'fin calcul alim_star'
+
+cAM:initialisations
+      do k=1,nlay
+         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)
+            Zsat(ig) =.false.
+         enddo
+      enddo 
+      do k=1,klev
+        do ig=1,ngrid
+           detr_star(ig,k)=0.
+           entr_star(ig,k)=0.
+           detr(ig,k)=0.
+           entr(ig,k)=0.
+        enddo
+      enddo
+c     print*,'7 OK convect8'
+      do k=1,klev+1
+         do ig=1,ngrid
+            zw2(ig,k)=0.
+            fmc(ig,k)=0.
+cCR
+            f_star(ig,k)=0.
+cRC
+            larg_cons(ig,k)=0.
+            larg_detr(ig,k)=0.
+            wa_moy(ig,k)=0.
+         enddo
+      enddo
+
+cn     print*,'8 OK convect8'
+      do ig=1,ngrid
+         linter(ig)=1.
+         lmaxa(ig)=1
+         lmix(ig)=1
+         wmaxa(ig)=0.
+      enddo
+
+      nu_min=l_mix
+      nu_max=1000.
+c      do ig=1,ngrid
+c      nu_max=wmax_sec(ig)
+c      enddo
+      do ig=1,ngrid
+         do k=1,klev
+            nu(ig,k)=0.
+            nu_e(ig,k)=0.
+         enddo
+      enddo
+cCalcul de l'excès de température du à la diffusion turbulente
+      do ig=1,ngrid
+         do l=1,klev
+            dtheta(ig,l)=0.
+         enddo
+       enddo
+      do ig=1,ngrid
+         do l=1,lentr(ig)-1
+      dtheta(ig,l)=sqrt(10.*0.4*zlev(ig,l+1)**2*1.
+     s          *((ztv(ig,l+1)-ztv(ig,l))/(zlev(ig,l+1)-zlev(ig,l)))**2)
+         enddo
+       enddo
+c      do l=1,nlay-2
+      do l=1,klev-1
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1)
+     s         .and.alim_star(ig,l).gt.1.e-10
+     s         .and.zw2(ig,l).lt.1e-10) then
+cAM
+ctest:on rajoute un excès de T dans couche alim
+c               ztla(ig,l)=zthl(ig,l)+dtheta(ig,l)
+               ztla(ig,l)=zthl(ig,l) 
+ctest: on rajoute un excès de q dans la couche alim
+c               zqta(ig,l)=po(ig,l)+0.001
+               zqta(ig,l)=po(ig,l)
+               zqla(ig,l)=zl(ig,l)
+cAM
+               f_star(ig,l+1)=alim_star(ig,l)
+ctest:calcul de dteta
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+     s                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+               w_est(ig,l+1)=zw2(ig,l+1)
+               larg_detr(ig,l)=0.
+c     print*,'coucou boucle 1'
+            else if ((zw2(ig,l).ge.1e-10).and.
+     s         (f_star(ig,l)+alim_star(ig,l)).gt.1.e-10) then
+c     print*,'coucou boucle 2'
+cestimation du detrainement a partir de la geometrie du pas precedent
+      if ((test(ig).eq.1).or.((.not.debut).and.(f0(ig).lt.1.e-10))) then
+                  detr_star(ig,l)=0.
+                  entr_star(ig,l)=0.
+c     print*,'coucou test(ig)',test(ig),f0(ig),zmax0(ig)
+             else
+c     print*,'coucou debut detr'
+ctests sur la definition du detr
+        if (zqla(ig,l-1).gt.1.e-10) then
+           nuage=.true.
+        endif 
+
+             w_est(ig,l+1)=zw2(ig,l)*
+     s                   ((f_star(ig,l))**2)
+     s                   /(f_star(ig,l)+alim_star(ig,l))**2+
+     s                   2.*RG*(ztva(ig,l-1)-ztv(ig,l))/ztv(ig,l)
+     s                   *(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
+      if (l.gt.2) then
+             if ((w_est(ig,l+1).gt.w_est(ig,l)).and.
+     s           (zlev(ig,l+1).lt.zmax_sec(ig)).and.
+     s            (zqla(ig,l-1).lt.1.e-10)) then 
+             detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1)
+     s                *sqrt(w_est(ig,l+1))*sqrt(nu(ig,l)*zlev(ig,l+1))
+     s       -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(nu(ig,l)*zlev(ig,l)))
+     s       /(r_aspect*zmax_sec(ig)))
+             else if ((zlev(ig,l+1).lt.zmax_sec(ig)).and.
+     s                (zqla(ig,l-1).lt.1.e-10)) then
+       detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig))
+     s /(rhobarz(ig,lmix(ig))*wmaxa(ig))*
+     s (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1))
+     s *((zmax_sec(ig)-zlev(ig,l+1))/((zmax_sec(ig)-zlev(ig,lmix(ig)))))
+     s **2.
+     s -rhobarz(ig,l)*sqrt(w_est(ig,l))
+     s *((zmax_sec(ig)-zlev(ig,l))/((zmax_sec(ig)-zlev(ig,lmix(ig)))))
+     s **2.)
+             else
+       detr_star(ig,l)=0.002*f0(ig)*f_star(ig,l)
+     s                *(zlev(ig,l+1)-zlev(ig,l))
+             
+             endif
+        else
+        detr_star(ig,l)=0.
+        endif
+       
+         detr_star(ig,l)=detr_star(ig,l)/f0(ig)
+         if (nuage) then
+         entr_star(ig,l)=0.4*detr_star(ig,l)
+         else
+         entr_star(ig,l)=0.4*detr_star(ig,l)
+         endif
+
+             if ((detr_star(ig,l)).gt.f_star(ig,l)) then
+              detr_star(ig,l)=f_star(ig,l)
+c              entr_star(ig,l)=0.
+              endif
+
+             if ((l.lt.lentr(ig))) then
+                 entr_star(ig,l)=0.
+c                 detr_star(ig,l)=0.
+             endif  
+
+c           print*,'ok detr_star'
+      endif
+cprise en compte du detrainement dans le calcul du flux
+             f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)
+     s                      -detr_star(ig,l)
+ctest
+c             if (f_star(ig,l+1).lt.0.) then
+c                f_star(ig,l+1)=0.
+c                entr_star(ig,l)=0.
+c                detr_star(ig,l)=f_star(ig,l)+alim_star(ig,l)
+c             endif
+ctest sur le signe de f_star
+       if (f_star(ig,l+1).gt.1.e-10) then 
+c                 then
+ctest
+c         if (((f_star(ig,l+1)+detr_star(ig,l)).gt.1.e-10)) then
+cAM on melange Tl et qt du thermique
+con rajoute un excès de T dans la couche alim
+c               if (l.lt.lentr(ig)) then
+c           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+
+c     s     (alim_star(ig,l)+entr_star(ig,l))*(zthl(ig,l)+dtheta(ig,l)))
+c     s     /(f_star(ig,l+1)+detr_star(ig,l))
+c               else
+               ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+
+     s                    (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))
+     s                 /(f_star(ig,l+1)+detr_star(ig,l))
+c     s                    /(f_star(ig,l+1)) 
+c               endif
+con rajoute un excès de q dans la couche alim
+c               if (l.lt.lentr(ig)) then
+c               zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+
+c     s           (alim_star(ig,l)+entr_star(ig,l))*(po(ig,l)+0.001))
+c     s                 /(f_star(ig,l+1)+detr_star(ig,l))
+c               else
+               zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+
+     s                    (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))
+     s                 /(f_star(ig,l+1)+detr_star(ig,l))
+c     s                   /(f_star(ig,l+1))
+c               endif
+cAM on en deduit thetav et ql du thermique
+cCR test
+c               Tbef(ig)=ztla(ig,l)*zpspsk(ig,l)
+               Tbef(ig)=ztla(ig,l)*zpspsk(ig,l)
+               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+               qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,l)  
+               qsatbef(ig)=MIN(0.5,qsatbef(ig))
+               zcor=1./(1.-retv*qsatbef(ig))
+               qsatbef(ig)=qsatbef(ig)*zcor
+             Zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig)) .gt. 1.e-10)
+
+           if (Zsat(ig).and.(1.eq.1)) then
+              qlbef=max(0.,zqta(ig,l)-qsatbef(ig))
+              DT = 0.5*RLvCp*qlbef
+c             write(17,*)'DT0=',DT
+              do while (abs(DT).gt.DDT0)
+c                 print*,'aie'
+                 Tbef(ig)=Tbef(ig)+DT
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,l)
+                 qsatbef(ig)=MIN(0.5,qsatbef(ig))
+                 zcor=1./(1.-retv*qsatbef(ig))
+                 qsatbef(ig)=qsatbef(ig)*zcor
+                 qlbef=zqta(ig,l)-qsatbef(ig)
+
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+                 zcor=1./(1.-retv*qsatbef(ig))
+                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef(ig),zcor)
+                 num=-Tbef(ig)+ztla(ig,l)*zpspsk(ig,l)+RLvCp*qlbef
+                 denom=1.+RLvCp*dqsat_dT
+                 if (denom.lt.1.e-10) then
+                    print*,'pb denom'
+                 endif
+                 DT=num/denom
+c                 write(17,*)'DT=',DT
+              enddo
+              zqla(ig,l) = max(0.,zqta(ig,l)-qsatbef(ig))
+              zqla(ig,l) = max(0.,qlbef) 
+c              zqla(ig,l)=0.
+             endif
+c             zqla(ig,l) = max(0.,zqta(ig,l)-qsatbef(ig))
+c      
+c on ecrit de maniere conservative (sat ou non)
+c          T = Tl +Lv/Cp ql
+cCR rq utilisation de humidite specifique ou rapport de melange?
+           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+con rajoute le calcul de zha pour diagnostiques (temp potentielle)
+           zha(ig,l) = ztva(ig,l)
+c           if (l.lt.lentr(ig)) then
+c           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
+c     s              -zqla(ig,l))-zqla(ig,l)) + 0.1
+c           else
+           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
+     s              -zqla(ig,l))-zqla(ig,l))
+c           endif
+c           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+c     s                 /(1.-retv*zqla(ig,l))
+c           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+c           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
+c     s                 /(1.-retv*zqta(ig,l))
+c     s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
+c     s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
+c       write(13,*)zqla(ig,l),zqla(ig,l)/(1.-retv*zqla(ig,l))
+con ecrit zqsat 
+           zqsatth(ig,l)=qsatbef(ig)  
+c        enddo
+c        DO ig=1,ngrid
+c           if (zw2(ig,l).ge.1.e-10.and.
+c     s               f_star(ig,l)+entr_star(ig,l).gt.1.e-10) then
+c  mise a jour de la vitesse ascendante (l'air entraine de la couche
+c  consideree commence avec une vitesse nulle).
+c
+c            if (f_star(ig,l+1).gt.1.e-10) then
+            zw2(ig,l+1)=zw2(ig,l)*
+c     s                  ((f_star(ig,l)-detr_star(ig,l))**2)
+c     s                  /f_star(ig,l+1)**2+
+     s                   ((f_star(ig,l))**2)
+     s                   /(f_star(ig,l+1)+detr_star(ig,l))**2+
+c     s                    /(f_star(ig,l+1))**2+           
+     s                   2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+     s                   *(zlev(ig,l+1)-zlev(ig,l))
+c     s                   *(f_star(ig,l)/f_star(ig,l+1))**2
+
+            endif
+        endif
+c
+            if (zw2(ig,l+1).lt.0.) then 
+               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))
+     s           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+c              print*,'linter=',linter(ig)
+c          else if ((zw2(ig,l+1).lt.1.e-10).and.(zw2(ig,l+1).ge.0.)) then
+c               linter(ig)=l+1
+c               print*,'linter=l',zw2(ig,l),zw2(ig,l+1)
+            else
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+c            wa_moy(ig,l+1)=zw2(ig,l+1) 
+            endif
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+c   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
+      print*,'fin calcul zw2'
+c
+c 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
+c pas de thermique si couche 1 stable
+      do ig=1,ngrid
+         if (lmin(ig).gt.1) then
+            lmax(ig)=1
+             lmin(ig)=1
+             lentr(ig)=1
+         endif
+      enddo 
+c    
+c 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
+
+c   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
+c calcul de zlevinter
+          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*
+     s    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)
+     s    -zlev(ig,lmax(ig)))
+cpour le cas ou on prend tjs lmin=1
+c       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)
+       write(11,*)'ig,lmax,linter',ig,lmax(ig),linter(ig)
+       write(12,*)'ig,zlevinter,zmax',ig,zmax(ig),zlevinter(ig)
+      enddo
+
+cCalcul de zmax_sec et wmax_sec
+      call fermeture_seche(ngrid,nlay
+     s                  ,pplay,pplev,pphi,zlev,rhobarz,f0,zpspsk
+     s                  ,alim,zh,zo,lentr,lmin,nu_min,nu_max,r_aspect
+     s                  ,zmax_sec2,wmax_sec2)
+
+      print*,'avant fermeture'
+c Fermeture,determination de f
+c en lmax f=d-e
+      do ig=1,ngrid
+c      entr_star(ig,lmax(ig))=0.
+c      f_star(ig,lmax(ig)+1)=0.
+c      detr_star(ig,lmax(ig))=f_star(ig,lmax(ig))+entr_star(ig,lmax(ig))
+c     s                       +alim_star(ig,lmax(ig))
+      enddo
+c
+      do ig=1,ngrid
+         alim_star2(ig)=0.
+      enddo
+ccalcul de entr_star_tot
+      do ig=1,ngrid
+         do k=1,lmix(ig)
+            entr_star_tot(ig)=entr_star_tot(ig)
+c     s                        +entr_star(ig,k)
+     s                        +alim_star(ig,k)
+c     s                        -detr_star(ig,k)
+            detr_star_tot(ig)=detr_star_tot(ig)
+c     s                        +alim_star(ig,k)
+     s                        -detr_star(ig,k)
+     s                        +entr_star(ig,k)
+         enddo
+      enddo
+      
+      do ig=1,ngrid
+         if (alim_star_tot(ig).LT.1.e-10) then
+            f(ig)=0.
+         else   
+c             do k=lmin(ig),lentr(ig)
+             do k=1,lentr(ig)
+                alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2
+     s                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+             enddo
+             if ((zmax_sec(ig).gt.1.e-10).and.(1.eq.1)) then 
+             f(ig)=wmax_sec(ig)/(max(500.,zmax_sec(ig))*r_aspect
+     s             *alim_star2(ig))
+             f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/
+     s                     zmax_sec(ig))*wmax_sec(ig))
+             else
+             f(ig)=wmax(ig)/(max(500.,zmax(ig))*r_aspect*alim_star2(ig))
+            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/
+     s                     zmax(ig))*wmax(ig))
+             endif
+         endif
+         f0(ig)=f(ig)
+      enddo
+      print*,'apres fermeture'
+c Calcul de l'entrainement
+         do ig=1,ngrid 
+            do k=1,klev
+            alim(ig,k)=f(ig)*alim_star(ig,k)
+         enddo
+      enddo
+cCR:test pour entrainer moins que la masse
+c       do ig=1,ngrid
+c          do l=1,lentr(ig)
+c             if ((alim(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
+c                alim(ig,l+1)=alim(ig,l+1)+alim(ig,l)
+c     s                       -0.9*masse(ig,l)/ptimestep
+c                alim(ig,l)=0.9*masse(ig,l)/ptimestep
+c             endif
+c          enddo
+c       enddo
+c calcul du détrainement
+         do ig=1,klon
+             do k=1,klev
+            detr(ig,k)=f(ig)*detr_star(ig,k)
+            if (detr(ig,k).lt.0.) then
+c               print*,'detr1<0!!!'
+            endif
+            enddo
+            do k=1,klev
+            entr(ig,k)=f(ig)*entr_star(ig,k)
+            if (entr(ig,k).lt.0.) then
+c               print*,'entr1<0!!!'
+            endif
+         enddo
+      enddo
+c
+c       do ig=1,ngrid
+c          do l=1,klev
+c          if (((detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep).gt.
+c     s          (masse(ig,l))) then  
+c      print*,'d2+e2+a2>m2','ig=',ig,'l=',l,'lmax(ig)=',lmax(ig),'d+e+a='
+c     s,(detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep,'m=',masse(ig,l)
+c      endif
+c      enddo
+c      enddo
+c Calcul des flux
+
+      do ig=1,ngrid
+         do l=1,lmax(ig)
+c         do l=1,klev
+c             fmc(ig,l+1)=f(ig)*f_star(ig,l+1)
+            fmc(ig,l+1)=fmc(ig,l)+alim(ig,l)+entr(ig,l)-detr(ig,l)
+c        print*,'??!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
+c     s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
+c     s  'f+1=',fmc(ig,l+1)
+          if (fmc(ig,l+1).lt.0.) then
+               print*,'fmc1<0',l+1,lmax(ig),fmc(ig,l+1)
+               fmc(ig,l+1)=fmc(ig,l)
+               detr(ig,l)=alim(ig,l)+entr(ig,l)
+c               fmc(ig,l+1)=0.
+c               print*,'fmc1<0',l+1,lmax(ig),fmc(ig,l+1)
+            endif
+c       if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
+c          f_old=fmc(ig,l+1)
+c          fmc(ig,l+1)=fmc(ig,l)
+c          detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1)
+c       endif
+       
+c        if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
+c          f_old=fmc(ig,l+1)
+c          fmc(ig,l+1)=fmc(ig,l)
+c          detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l)
+c       endif
+crajout du test sur alpha croissant
+cif test
+c       if (1.eq.0) then
+
+       if (l.eq.klev) then
+          print*,'THERMCELL PB ig=',ig,'   l=',l
+          stop
+       endif
+!       if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and.
+!     s     (l.ge.lentr(ig)).and.
+       if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and.
+     s         (l.ge.lentr(ig)) ) then
+          if ( ((fmc(ig,l+1)/(rhobarz(ig,l+1)*zw2(ig,l+1))).gt.
+     s     (fmc(ig,l)/(rhobarz(ig,l)*zw2(ig,l))))) then
+           f_old=fmc(ig,l+1)
+           fmc(ig,l+1)=fmc(ig,l)*rhobarz(ig,l+1)*zw2(ig,l+1)
+     s                          /(rhobarz(ig,l)*zw2(ig,l))
+           detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1) 
+c           detr(ig,l)=(fmc(ig,l+1)-fmc(ig,l))/(0.4-1.)
+c           entr(ig,l)=0.4*detr(ig,l)
+c           entr(ig,l)=fmc(ig,l+1)-fmc(ig,l)+detr(ig,l)
+        endif
+        endif
+        if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
+          f_old=fmc(ig,l+1)
+          fmc(ig,l+1)=fmc(ig,l)
+          detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1)
+       endif
+       if (detr(ig,l).gt.fmc(ig,l)) then
+               detr(ig,l)=fmc(ig,l)
+               entr(ig,l)=fmc(ig,l+1)-alim(ig,l)
+        endif
+       if (fmc(ig,l+1).lt.0.) then
+               detr(ig,l)=detr(ig,l)+fmc(ig,l+1)
+               fmc(ig,l+1)=0.
+               print*,'fmc2<0',l+1,lmax(ig)
+            endif
+            
+ctest pour ne pas avoir f=0 et d=e/=0
+c       if (fmc(ig,l+1).lt.1.e-10) then
+c          detr(ig,l+1)=0.
+c          entr(ig,l+1)=0.
+c          zqla(ig,l+1)=0.
+c          zw2(ig,l+1)=0.
+c          lmax(ig)=l+1
+c          zmax(ig)=zlev(ig,lmax(ig))
+c       endif 
+        if (zw2(ig,l+1).gt.1.e-10) then
+       if ((((fmc(ig,l+1))/(rhobarz(ig,l+1)*zw2(ig,l+1))).gt.
+     s      1.)) then
+          f_old=fmc(ig,l+1)
+          fmc(ig,l+1)=rhobarz(ig,l+1)*zw2(ig,l+1)
+          zw2(ig,l+1)=0.
+          zqla(ig,l+1)=0.
+          detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1)
+         lmax(ig)=l+1
+          zmax(ig)=zlev(ig,lmax(ig))
+          print*,'alpha>1',l+1,lmax(ig)
+       endif
+        endif
+c              write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+cendif test
+c      endif
+      enddo
+      enddo
+      do ig=1,ngrid
+c         if (fmc(ig,lmax(ig)+1).ne.0.) then
+         fmc(ig,lmax(ig)+1)=0.
+         entr(ig,lmax(ig))=0.
+         detr(ig,lmax(ig))=fmc(ig,lmax(ig))+entr(ig,lmax(ig))
+     s                     +alim(ig,lmax(ig))
+c         endif
+      enddo
+ctest sur le signe de fmc
+       do ig=1,ngrid
+         do l=1,klev+1
+            if (fmc(ig,l).lt.0.) then
+         print*,'fm1<0!!!','ig=',ig,'l=',l,'a=',alim(ig,l-1),'e='
+     s ,entr(ig,l-1),'f=',fmc(ig,l-1),'d=',detr(ig,l-1),'f+1=',fmc(ig,l)
+            endif
+         enddo
+       enddo
+ctest de verification
+      do ig=1,ngrid
+       do l=1,lmax(ig)
+       if ((abs(fmc(ig,l+1)-fmc(ig,l)-alim(ig,l)-entr(ig,l)+detr(ig,l)))
+     s           .gt.1.e-4) then
+c      print*,'pbcm!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
+c     s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
+c     s  'f+1=',fmc(ig,l+1)
+       endif
+       if (detr(ig,l).lt.0.) then
+          print*,'detrdemi<0!!!'
+       endif
+         enddo
+      enddo
+c
+cRC
+cCR def de  zmix continu (profil parabolique des vitesses)
+      do ig=1,ngrid
+           if (lmix(ig).gt.1.) then
+c test 
+              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)
+     s        then
+c             
+            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))
+     s        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((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
+ctest
+         if ((zmax(ig)-zmix(ig)).le.0.) then
+            zmix(ig)=0.9*zmax(ig)
+c            print*,'pb zmix>zmax'
+         endif
+      enddo
+      do ig=1,klon
+         zmix0(ig)=zmix(ig)
+      enddo
+c
+c calcul du nouveau lmix correspondant
+      do ig=1,ngrid
+         do l=1,klev
+            if (zmix(ig).ge.zlev(ig,l).and.
+     s          zmix(ig).lt.zlev(ig,l+1)) then
+              lmix(ig)=l
+             endif
+          enddo
+      enddo
+c
+cne devrait pas arriver!!!!!
+      do ig=1,ngrid
+       do l=1,klev
+          if (detr(ig,l).gt.(fmc(ig,l)+alim(ig,l))+entr(ig,l)) then
+             print*,'detr2>fmc2!!!','ig=',ig,'l=',l,'d=',detr(ig,l),
+     s             'f=',fmc(ig,l),'lmax=',lmax(ig)
+c             detr(ig,l)=fmc(ig,l)+alim(ig,l)+entr(ig,l)
+c             entr(ig,l)=0.
+c             fmc(ig,l+1)=0.
+c             zw2(ig,l+1)=0.     
+c             zqla(ig,l+1)=0.
+           print*,'pb!fm=0 et f_star>0',l,lmax(ig)        
+c             lmax(ig)=l
+          endif
+       enddo
+      enddo
+      do ig=1,ngrid
+         do l=lmax(ig)+1,klev+1
+c            fmc(ig,l)=0.
+c            detr(ig,l)=0.
+c            entr(ig,l)=0.
+c            zw2(ig,l)=0.
+c            zqla(ig,l)=0.
+         enddo
+      enddo
+
+cCalcul du detrainement lors du premier passage
+c     print*,'9 OK convect8'
+c     print*,'WA1 ',wa_moy
+
+c   determination de l'indice du debut de la mixed layer ou w decroit
+
+c   calcul de la largeur de chaque ascendance dans le cas conservatif.
+c   dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+c   d'une couche est égale à la hauteur de la couche alimentante.
+c   La vitesse maximale dans l'ascendance est aussi prise comme estimation
+c   de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmax(ig).and.(test(ig).eq.1)) then
+               zw=max(wa_moy(ig,l),1.e-10)
+               larg_cons(ig,l)=zmax(ig)*r_aspect
+     s         *fmc(ig,l)/(rhobarz(ig,l)*zw)
+            endif
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmax(ig).and.(test(ig).eq.1)) then
+c              if (idetr.eq.0) then
+c  cette option est finalement en dur.
+                  if ((l_mix*zlev(ig,l)).lt.0.)then
+                   print*,'pb l_mix*zlev<0'
+                  endif
+cCR: test: nouvelle def de lambda
+c                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+                  if (zw2(ig,l).gt.1.e-10) then
+                  larg_detr(ig,l)=sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
+                  else
+                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+                  endif
+c              else if (idetr.eq.1) then
+c                 larg_detr(ig,l)=larg_cons(ig,l)
+c    s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+c              else if (idetr.eq.2) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *sqrt(wa_moy(ig,l))
+c              else if (idetr.eq.4) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *wa_moy(ig,l)
+c              endif
+         endif
+         enddo
+       enddo
+
+c     print*,'10 OK convect8'
+c     print*,'WA2 ',wa_moy
+c   cal1cul de la fraction de la maille concernée par l'ascendance en tenant
+c   compte de l'epluchage du thermique.
+c
+c
+      do l=2,nlay
+         do ig=1,ngrid
+            if(larg_cons(ig,l).gt.1..and.(test(ig).eq.1)) then
+c     print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+               fraca(ig,l)=(larg_cons(ig,l)-larg_detr(ig,l))
+     s            /(r_aspect*zmax(ig))
+c test
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+            else
+c              wa_moy(ig,l)=0.
+               fraca(ig,l)=0.
+               fracc(ig,l)=0.
+               fracd(ig,l)=1.
+            endif
+         enddo
+      enddo                  
+cCR: calcul de fracazmix
+       do ig=1,ngrid
+          if (test(ig).eq.1) then
+          fracazmix(ig)=(fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/
+     s     (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig)
+     s    +fraca(ig,lmix(ig))-zlev(ig,lmix(ig))*(fraca(ig,lmix(ig)+1)
+     s    -fraca(ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+          endif
+       enddo
+c
+       do l=2,nlay
+          do ig=1,ngrid
+             if(larg_cons(ig,l).gt.1..and.(test(ig).eq.1)) then
+               if (l.gt.lmix(ig)) then
+ctest
+                 if (zmax(ig)-zmix(ig).lt.1.e-10) then
+c                   print*,'pb xxx'
+                    xxx(ig,l)=(lmax(ig)+1.-l)/(lmax(ig)+1.-lmix(ig))
+                 else
+                 xxx(ig,l)=(zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+                 endif
+           if (idetr.eq.0) then
+               fraca(ig,l)=fracazmix(ig)
+           else if (idetr.eq.1) then
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)
+           else if (idetr.eq.2) then
+               fraca(ig,l)=fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+           else
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)**2
+           endif
+c     print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+             endif
+            endif
+         enddo
+      enddo
+
+      print*,'fin calcul fraca'
+c     print*,'11 OK convect8'
+c     print*,'Ea3 ',wa_moy
+c------------------------------------------------------------------
+c   Calcul de fracd, wd
+c   somme wa - wd = 0
+c------------------------------------------------------------------
+
+
+      do ig=1,ngrid
+         fm(ig,1)=0.
+         fm(ig,nlay+1)=0.
+      enddo
+
+      do l=2,nlay
+           do ig=1,ngrid
+              if (test(ig).eq.1) then
+              fm(ig,l)=fraca(ig,l)*wa_moy(ig,l)*rhobarz(ig,l)
+cCR:test
+              if (alim(ig,l-1).lt.1e-10.and.fm(ig,l).gt.fm(ig,l-1)
+     s            .and.l.gt.lmix(ig)) then
+                 fm(ig,l)=fm(ig,l-1)
+c                 write(1,*)'ajustement fm, l',l
+              endif
+c              write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+cRC
+              endif
+           enddo
+         do ig=1,ngrid
+            if(fracd(ig,l).lt.0.1.and.(test(ig).eq.1)) then
+               stop'fracd trop petit'
+            else
+c    vitesse descendante "diagnostique"
+               wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l))
+            endif
+         enddo
+      enddo
+
+      do l=1,nlay+1
+         do ig=1,ngrid
+            if (test(ig).eq.0) then
+              fm(ig,l)=fmc(ig,l)
+            endif
+         enddo
+      enddo 
+   
+cfin du first
+      do l=1,nlay
+         do ig=1,ngrid
+c           masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+            masse(ig,l)=(pplev(ig,l)-pplev(ig,l+1))/RG
+         enddo
+      enddo
+
+      print*,'12 OK convect8'
+c     print*,'WA4 ',wa_moy
+cc------------------------------------------------------------------
+c   calcul du transport vertical
+c------------------------------------------------------------------
+
+      go to 4444
+c     print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+      do l=2,nlay-1
+         do ig=1,ngrid
+            if(fm(ig,l+1)*ptimestep.gt.masse(ig,l)
+     s      .and.fm(ig,l+1)*ptimestep.gt.masse(ig,l+1)) then
+      print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+     s         ,fm(ig,l+1)*ptimestep
+     s         ,'   M=',masse(ig,l),masse(ig,l+1)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if((alim(ig,l)+entr(ig,l))*ptimestep.gt.masse(ig,l)) then
+      print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+     s         ,(entr(ig,l)+alim(ig,l))*ptimestep
+     s         ,'   M=',masse(ig,l)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(.not.fm(ig,l).ge.0..or..not.fm(ig,l).le.10.) then
+c     print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+c    s         ,'   FM=',fm(ig,l)
+            endif
+            if(.not.masse(ig,l).ge.1.e-10
+     s         .or..not.masse(ig,l).le.1.e4) then
+c     print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+c    s         ,'   M=',masse(ig,l)
+c     print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+c    s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+c     print*,'zlev(ig,l+1),zlev(ig,l)'
+c    s                ,zlev(ig,l+1),zlev(ig,l)
+c     print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+c    s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+            endif
+            if(.not.alim(ig,l).ge.0..or..not.alim(ig,l).le.10.) then
+c     print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+c    s         ,'   E=',entr(ig,l)
+            endif
+         enddo
+      enddo
+
+4444   continue
+
+cCR:redefinition du entr
+cCR:test:on ne change pas la def du entr mais la def du fm
+       do l=1,nlay
+         do ig=1,ngrid
+            if (test(ig).eq.1) then
+            detr(ig,l)=fm(ig,l)+alim(ig,l)-fm(ig,l+1)
+            if (detr(ig,l).lt.0.) then
+c                entr(ig,l)=entr(ig,l)-detr(ig,l)
+                fm(ig,l+1)=fm(ig,l)+alim(ig,l)
+                detr(ig,l)=0.
+c                write(11,*)'l,ig,entr',l,ig,entr(ig,l)
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+            endif
+            endif
+         enddo
+      enddo
+cRC
+
+      if (w2di.eq.1) then
+         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
+         entr0=entr0+ptimestep*(alim+entr-entr0)/float(tho)
+      else
+         fm0=fm
+         entr0=alim+entr
+         detr0=detr
+         alim0=alim
+c         zoa=zqta
+c         entr0=alim
+      endif
+
+      if (1.eq.1) then
+c         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+c     .    ,zh,zdhadj,zha)
+c         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+c     .    ,zo,pdoadj,zoa)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse,
+     .                    zthl,zdthladj,zta)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse,
+     .                   po,pdoadj,zoa)
+      else
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zh,zdhadj,zha)
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zo,pdoadj,zoa)
+      endif
+
+      if (1.eq.0) then
+         call dvthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,fraca,zmax
+     .    ,zu,zv,pduadj,pdvadj,zua,zva)
+      else
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zu,pduadj,zua)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zv,pdvadj,zva)
+      endif
+
+cCalcul des moments
+c      do l=1,nlay
+c         do ig=1,ngrid
+c            zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
+c            zf2=zf/(1.-zf)
+c            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
+c            wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+c         enddo
+c      enddo
+
+
+
+
+
+
+c     print*,'13 OK convect8'
+c     print*,'WA5 ',wa_moy
+      do l=1,nlay
+         do ig=1,ngrid
+c            pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)  
+         enddo
+      enddo
+
+
+c     do l=1,nlay
+c        do ig=1,ngrid
+c           if(abs(pdtadj(ig,l))*86400..gt.500.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdtadj=',pdtadj(ig,l)
+c           endif
+c           if(abs(pdoadj(ig,l))*86400..gt.1.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdoadj=',pdoadj(ig,l)
+c           endif
+c        enddo
+c      enddo
+
+      print*,'14 OK convect8'
+c------------------------------------------------------------------
+c   Calculs pour les sorties
+c------------------------------------------------------------------
+ccalcul de fraca pour les sorties
+      do l=2,klev
+         do ig=1,klon
+            if (zw2(ig,l).gt.1.e-10) then
+            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
+            else
+            fraca(ig,l)=0.
+            endif
+         enddo
+      enddo
+      if(sorties) then
+      do l=1,nlay
+         do ig=1,ngrid
+            zla(ig,l)=(1.-fracd(ig,l))*zmax(ig)
+            zld(ig,l)=fracd(ig,l)*zmax(ig)
+            if(1.-fracd(ig,l).gt.1.e-10)
+     s      zwa(ig,l)=wd(ig,l)*fracd(ig,l)/(1.-fracd(ig,l))
+         enddo
+      enddo
+c CR calcul du niveau de condensation
+c initialisation
+      do ig=1,ngrid
+         nivcon(ig)=0.
+         zcon(ig)=0.
+      enddo 
+      do k=nlay,1,-1
+         do ig=1,ngrid
+            if (zqla(ig,k).gt.1e-10) then
+               nivcon(ig)=k
+               zcon(ig)=zlev(ig,k)
+            endif
+c            if (zcon(ig).gt.1.e-10) then
+c               nuage=.true.
+c            else 
+c               nuage=.false.
+c            endif
+         enddo
+      enddo
+      
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=fraca(ig,l)
+            zf2=zf/(1.-zf)
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
+            wth2(ig,l)=zf2*(zw2(ig,l))**2
+c           print*,'wth2=',wth2(ig,l)
+            wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))
+     s                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
+            q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+ctest: on calcul q2/po=ratqsc
+c            if (nuage) then
+            ratqscth(ig,l)=sqrt(q2(ig,l))/(po(ig,l)*1000.)
+c            else
+c            ratqscth(ig,l)=0.
+c            endif
+         enddo
+      enddo
+ccalcul du ratqscdiff
+      sum=0.
+      sumdiff=0.
+      ratqsdiff(:,:)=0.
+      do ig=1,ngrid
+         do l=1,lentr(ig)
+            sum=sum+alim_star(ig,l)*zqta(ig,l)*1000.
+         enddo
+      enddo
+      do ig=1,ngrid
+          do l=1,lentr(ig)
+          zf=fraca(ig,l)
+          zf2=zf/(1.-zf)
+       sumdiff=sumdiff+alim_star(ig,l)
+     s           *(zqta(ig,l)*1000.-sum)**2
+c      ratqsdiff=ratqsdiff+alim_star(ig,l)*
+c     s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+          enddo
+      enddo
+      do l=1,klev
+      do ig=1,ngrid
+      ratqsdiff(ig,l)=sqrt(sumdiff)/(po(ig,l)*1000.)   
+c      write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
+      enddo
+      enddo     
+cdeja fait
+c      do l=1,nlay
+c         do ig=1,ngrid
+c            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+c            if (detr(ig,l).lt.0.) then
+c                entr(ig,l)=entr(ig,l)-detr(ig,l)
+c                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+c            endif
+c         enddo
+c      enddo
+
+c     print*,'15 OK convect8'
+
+      isplit=isplit+1       
+
+
+c #define und
+	goto 123
+#ifdef und
+      CALL writeg1d(1,nlay,wd,'wd      ','wd      ')
+      CALL writeg1d(1,nlay,zwa,'wa      ','wa      ')
+      CALL writeg1d(1,nlay,fracd,'fracd      ','fracd      ')
+      CALL writeg1d(1,nlay,fraca,'fraca      ','fraca      ')
+      CALL writeg1d(1,nlay,wa_moy,'wam         ','wam         ')
+      CALL writeg1d(1,nlay,zla,'la      ','la      ')
+      CALL writeg1d(1,nlay,zld,'ld      ','ld      ')
+      CALL writeg1d(1,nlay,pt,'pt      ','pt      ')
+      CALL writeg1d(1,nlay,zh,'zh      ','zh      ')
+      CALL writeg1d(1,nlay,zha,'zha      ','zha      ')
+      CALL writeg1d(1,nlay,zu,'zu      ','zu      ')
+      CALL writeg1d(1,nlay,zv,'zv      ','zv      ')
+      CALL writeg1d(1,nlay,zo,'zo      ','zo      ')
+      CALL writeg1d(1,nlay,wh,'wh      ','wh      ')
+      CALL writeg1d(1,nlay,wu,'wu      ','wu      ')
+      CALL writeg1d(1,nlay,wv,'wv      ','wv      ')
+      CALL writeg1d(1,nlay,wo,'w15uo     ','wXo     ')
+      CALL writeg1d(1,nlay,zdhadj,'zdhadj      ','zdhadj      ')
+      CALL writeg1d(1,nlay,pduadj,'pduadj      ','pduadj      ')
+      CALL writeg1d(1,nlay,pdvadj,'pdvadj      ','pdvadj      ')
+      CALL writeg1d(1,nlay,pdoadj,'pdoadj      ','pdoadj      ')
+      CALL writeg1d(1,nlay,entr  ,'entr        ','entr        ')
+      CALL writeg1d(1,nlay,detr  ,'detr        ','detr        ')
+      CALL writeg1d(1,nlay,fm    ,'fm          ','fm          ')
+
+      CALL writeg1d(1,nlay,pdtadj,'pdtadj    ','pdtadj    ')
+      CALL writeg1d(1,nlay,pplay,'pplay     ','pplay     ')
+      CALL writeg1d(1,nlay,pplev,'pplev     ','pplev     ')
+
+c   recalcul des flux en diagnostique...
+c     print*,'PAS DE TEMPS ',ptimestep
+       call dt2F(pplev,pplay,pt,pdtadj,wh)
+      CALL writeg1d(1,nlay,wh,'wh2     ','wh2     ')
+#endif
+123   continue
+! #define troisD
+#ifdef troisD
+c       if (sorties) then
+      print*,'Debut des wrgradsfi'
+
+c      print*,'16 OK convect8'
+c         call wrgradsfi(1,nlay,wd,'wd        ','wd        ')
+c         call wrgradsfi(1,nlay,zwa,'wa        ','wa        ')
+         call wrgradsfi(1,nlay,fracd,'fracd     ','fracd     ')
+         call wrgradsfi(1,nlay,fraca,'fraca     ','fraca     ')
+c         call wrgradsfi(1,nlay,xxx,'xxx       ','xxx       ')
+c         call wrgradsfi(1,nlay,wa_moy,'wam       ','wam       ')
+c      print*,'WA6 ',wa_moy
+c         call wrgradsfi(1,nlay,zla,'la        ','la        ')
+c         call wrgradsfi(1,nlay,zld,'ld        ','ld        ')
+         call wrgradsfi(1,nlay,pt,'pt        ','pt        ')
+         call wrgradsfi(1,nlay,zh,'zh        ','zh        ')
+         call wrgradsfi(1,nlay,zha,'zha        ','zha        ')
+         call wrgradsfi(1,nlay,zua,'zua        ','zua        ')
+         call wrgradsfi(1,nlay,zva,'zva        ','zva        ')
+         call wrgradsfi(1,nlay,zu,'zu        ','zu        ')
+         call wrgradsfi(1,nlay,zv,'zv        ','zv        ')
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,wh,'wh        ','wh        ')
+         call wrgradsfi(1,nlay,wu,'wu        ','wu        ')
+         call wrgradsfi(1,nlay,wv,'wv        ','wv        ')
+         call wrgradsfi(1,nlay,wo,'wo        ','wo        ')
+         call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+         call wrgradsfi(1,nlay,zdhadj,'zdhadj    ','zdhadj    ')
+         call wrgradsfi(1,nlay,pduadj,'pduadj    ','pduadj    ')
+         call wrgradsfi(1,nlay,pdvadj,'pdvadj    ','pdvadj    ')
+         call wrgradsfi(1,nlay,pdoadj,'pdoadj    ','pdoadj    ')
+         call wrgradsfi(1,nlay,entr,'entr      ','entr      ')
+         call wrgradsfi(1,nlay,detr,'detr      ','detr      ')
+         call wrgradsfi(1,nlay,fm,'fm        ','fm        ')
+         call wrgradsfi(1,nlay,fmc,'fmc       ','fmc       ')
+         call wrgradsfi(1,nlay,zw2,'zw2       ','zw2       ')
+         call wrgradsfi(1,nlay,w_est,'w_est      ','w_est      ')
+con sort les moments
+         call wrgradsfi(1,nlay,thetath2,'zh2       ','zh2       ')
+         call wrgradsfi(1,nlay,wth2,'w2       ','w2       ')
+         call wrgradsfi(1,nlay,wth3,'w3       ','w3       ')
+         call wrgradsfi(1,nlay,q2,'q2       ','q2       ')
+         call wrgradsfi(1,nlay,dtheta,'dT       ','dT       ')
+c
+         call wrgradsfi(1,nlay,zw_sec,'zw_sec       ','zw_sec       ')
+         call wrgradsfi(1,nlay,ztva,'ztva      ','ztva      ')
+         call wrgradsfi(1,nlay,ztv,'ztv       ','ztv       ')
+         call wrgradsfi(1,nlay,nu,'nu       ','nu       ')
+
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,zoa,'zoa        ','zoa        ')
+c         call wrgradsfi(1,nlay,larg_cons,'Lc        ','Lc        ')
+c         call wrgradsfi(1,nlay,larg_detr,'Ldetr     ','Ldetr     ')
+
+cAM:nouveaux diagnostiques
+         call wrgradsfi(1,nlay,zthl,'zthl        ','zthl        ')
+         call wrgradsfi(1,nlay,zta,'zta        ','zta        ')
+         call wrgradsfi(1,nlay,zl,'zl        ','zl        ')
+         call wrgradsfi(1,nlay,zdthladj,'zdthladj    ',
+     s        'zdthladj    ')
+         call wrgradsfi(1,nlay,ztla,'ztla      ','ztla      ')
+         call wrgradsfi(1,nlay,zqta,'zqta      ','zqta      ')
+         call wrgradsfi(1,nlay,zqla,'zqla      ','zqla      ')
+         call wrgradsfi(1,nlay,deltaz,'deltaz      ','deltaz      ')
+cCR:nouveaux diagnostiques
+      call wrgradsfi(1,nlay,entr_star  ,'entr_star   ','entr_star   ')
+      call wrgradsfi(1,nlay,detr_star  ,'detr_star   ','detr_star   ')     
+      call wrgradsfi(1,nlay,f_star    ,'f_star   ','f_star   ')
+      call wrgradsfi(1,nlay,zqsat    ,'zqsat   ','zqsat   ')
+      call wrgradsfi(1,nlay,zqsatth    ,'qsath   ','qsath   ')
+      call wrgradsfi(1,nlay,alim_star    ,'alim_star   ','alim_star   ')
+      call wrgradsfi(1,nlay,alim    ,'alim   ','alim   ')
+      call wrgradsfi(1,1,f,'f      ','f      ')
+      call wrgradsfi(1,1,alim_star_tot,'a_s_t      ','a_s_t      ')
+      call wrgradsfi(1,1,alim_star2,'a_2      ','a_2      ')
+      call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+      call wrgradsfi(1,1,zmax_sec,'z_sec      ','z_sec      ')
+c      call wrgradsfi(1,1,zmax_sec2,'zz_se      ','zz_se      ')
+      call wrgradsfi(1,1,zmix,'zmix      ','zmix      ') 
+      call wrgradsfi(1,1,nivcon,'nivcon      ','nivcon      ')
+      call wrgradsfi(1,1,zcon,'zcon      ','zcon      ')
+      zsortie1d(:)=lmax(:)
+      call wrgradsfi(1,1,zsortie1d,'lmax      ','lmax      ')
+      call wrgradsfi(1,1,wmax,'wmax      ','wmax      ')
+      call wrgradsfi(1,1,wmax_sec,'w_sec      ','w_sec      ')
+      zsortie1d(:)=lmix(:)
+      call wrgradsfi(1,1,zsortie1d,'lmix      ','lmix      ')
+      zsortie1d(:)=lentr(:)
+      call wrgradsfi(1,1,zsortie1d,'lentr      ','lentr     ')
+
+c      print*,'17 OK convect8'
+
+         do k=1,klev/10
+            write(str2,'(i2.2)') k
+            str10='wa'//str2
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=wa(ig,k,l)
+               enddo
+            enddo   
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=larg_part(ig,k,l)
+               enddo
+            enddo
+           str10='la'//str2
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+         enddo
+
+
+c     print*,'18 OK convect8'
+c      endif
+      print*,'Fin des wrgradsfi'
+#endif
+
+      endif
+
+c     if(wa_moy(1,4).gt.1.e-10) stop
+
+      print*,'19 OK convect8'
+      return
+      end
+      SUBROUTINE thermcell_eau(ngrid,nlay,ptimestep
+     s                  ,pplay,pplev,pphi
+     s                  ,pu,pv,pt,po
+     s                  ,pduadj,pdvadj,pdtadj,pdoadj
+     s                  ,fm0,entr0
+c    s                  ,pu_therm,pv_therm
+     s                  ,r_aspect,l_mix,w2di,tho)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c
+c   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+c
+c   le thermique est supposé homogène et dissipé par mélange avec
+c   son environnement. la longueur l_mix contrôle l'efficacité du
+c   mélange
+c
+c   Le calcul du transport des différentes espèces se fait en prenant
+c   en compte:
+c     1. un flux de masse montant
+c     2. un flux de masse descendant
+c     3. un entrainement
+c     4. un detrainement
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,w2di,tho
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+      integer idetr
+      save idetr
+      data idetr/3/
+
+c   local:
+c   ------
+
+      INTEGER ig,k,l,lmaxa(klon),lmix(klon)
+      real zsortie1d(klon)
+c CR: on remplace lmax(klon,klev+1)
+      INTEGER lmax(klon),lmin(klon),lentr(klon)
+      real linter(klon)
+      real zmix(klon), fracazmix(klon) 
+c RC 
+      real zmax(klon),zw,zz,zw2(klon,klev+1),ztva(klon,klev),zzz
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      REAL zh(klon,klev),zdhadj(klon,klev)
+      real zthl(klon,klev),zdthladj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      real zl(klon,klev)
+      REAL wh(klon,klev+1)
+      real wu(klon,klev+1),wv(klon,klev+1),wo(klon,klev+1)
+      real zla(klon,klev+1)
+      real zwa(klon,klev+1)
+      real zld(klon,klev+1)
+      real zwd(klon,klev+1)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zta(klon,klev)
+      real zha(klon,klev)
+      real wa_moy(klon,klev+1)
+      real fraca(klon,klev+1)
+      real fracc(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev)
+      common/comtherm/thetath2,wth2
+
+      real count_time
+      integer isplit,nsplit,ialt
+      parameter (nsplit=10)
+      data isplit/0/
+      save isplit
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+c     real wmax(klon,klev),wmaxa(klon)
+      real wmax(klon),wmaxa(klon)
+      real wa(klon,klev,klev+1)
+      real wd(klon,klev+1)
+      real larg_part(klon,klev,klev+1)
+      real fracd(klon,klev+1)
+      real xxx(klon,klev+1)
+      real larg_cons(klon,klev+1)
+      real larg_detr(klon,klev+1)
+      real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
+      real pu_therm(klon,klev),pv_therm(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev)
+      real fmc(klon,klev+1)
+
+      real zcor,zdelta,zcvm5,qlbef
+      real Tbef(klon),qsatbef(klon)
+      real dqsat_dT,DT,num,denom
+      REAL REPS,RLvCp,DDT0
+      real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
+ 
+      PARAMETER (DDT0=.01)
+
+cCR:nouvelles variables
+      real f_star(klon,klev+1),entr_star(klon,klev)
+      real entr_star_tot(klon),entr_star2(klon)
+      real f(klon), f0(klon)
+      real zlevinter(klon)
+      logical first
+      data first /.false./
+      save first
+cRC
+
+      character*2 str2
+      character*10 str10
+
+      LOGICAL vtest(klon),down
+      LOGICAL Zsat(klon)
+
+      EXTERNAL SCOPY
+
+      integer ncorrec,ll
+      save ncorrec
+      data ncorrec/0/
+c
+
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+       sorties=.true.
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+c
+c Initialisation
+      RLvCp = RLVTT/RCPD
+      REPS  = RD/RV
+c
+c-----------------------------------------------------------------------
+cAM Calcul de T,q,ql a partir de Tl et qT
+c   ---------------------------------------------------
+c
+c Pr Tprec=Tl calcul de qsat 
+c Si qsat>qT T=Tl, q=qT
+c Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt) 
+c On cherche DDT < DDT0
+c
+c defaut
+       DO  ll=1,nlay
+         DO ig=1,ngrid
+            zo(ig,ll)=po(ig,ll)
+            zl(ig,ll)=0.
+            zh(ig,ll)=pt(ig,ll)
+         EndDO
+       EndDO
+       do ig=1,ngrid
+          Zsat(ig)=.false.
+       enddo
+c
+c
+       DO ll=1,nlay
+c les points insatures sont definitifs
+         DO ig=1,ngrid
+            Tbef(ig)=pt(ig,ll)
+            zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+            qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,ll)
+            qsatbef(ig)=MIN(0.5,qsatbef(ig))
+            zcor=1./(1.-retv*qsatbef(ig))
+            qsatbef(ig)=qsatbef(ig)*zcor
+            Zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig)) .gt. 0.00001)
+         EndDO
+
+         DO ig=1,ngrid
+           if (Zsat(ig)) then
+            qlbef=max(0.,po(ig,ll)-qsatbef(ig))
+c si sature: ql est surestime, d'ou la sous-relax
+            DT = 0.5*RLvCp*qlbef
+c on pourra enchainer 2 ou 3 calculs sans Do while
+            do while (DT.gt.DDT0)
+c il faut verifier si c,a conserve quand on repasse en insature ...
+              Tbef(ig)=Tbef(ig)+DT
+              zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+              qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,ll)
+              qsatbef(ig)=MIN(0.5,qsatbef(ig))
+              zcor=1./(1.-retv*qsatbef(ig))
+              qsatbef(ig)=qsatbef(ig)*zcor
+c on veut le signe de qlbef
+              qlbef=po(ig,ll)-qsatbef(ig)
+c          dqsat_dT
+              zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+              zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+              zcor=1./(1.-retv*qsatbef(ig))
+              dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef(ig),zcor)
+              num=-Tbef(ig)+pt(ig,ll)+RLvCp*qlbef
+              denom=1.+RLvCp*dqsat_dT
+              DT=num/denom
+            enddo
+c on ecrit de maniere conservative (sat ou non)
+            zl(ig,ll) = max(0.,qlbef)
+c          T = Tl +Lv/Cp ql
+            zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)
+            zo(ig,ll) = po(ig,ll)-zl(ig,ll)
+           endif
+         EndDO
+       EndDO
+cAM fin
+c
+c-----------------------------------------------------------------------
+c   incrementation eventuelle de tendances precedentes:
+c   ---------------------------------------------------
+
+      print*,'0 OK convect8'
+
+      DO 1010 l=1,nlay
+         DO 1015 ig=1,ngrid
+            zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
+c            zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zu(ig,l)=pu(ig,l)
+            zv(ig,l)=pv(ig,l)
+c            zo(ig,l)=po(ig,l)
+c            ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+cAM attention zh est maintenant le profil de T et plus le profil de theta !
+c
+c   T-> Theta
+            ztv(ig,l)=zh(ig,l)/zpspsk(ig,l)
+cAM Theta_v
+            ztv(ig,l)=ztv(ig,l)*(1.+RETV*(zo(ig,l))
+     s           -zl(ig,l))
+cAM Thetal
+            zthl(ig,l)=pt(ig,l)/zpspsk(ig,l)
+c            
+1015     CONTINUE
+1010  CONTINUE
+
+c     print*,'1 OK convect8'
+c                       --------------------
+c
+c
+c                       + + + + + + + + + + +
+c
+c
+c  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+c  wh,wt,wo ...
+c
+c                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+c
+c
+c                       --------------------   zlev(1)
+c                       \\\\\\\\\\\\\\\\\\\\
+c
+c
+
+c-----------------------------------------------------------------------
+c   Calcul des altitudes des couches
+c-----------------------------------------------------------------------
+
+      do l=2,nlay
+         do ig=1,ngrid
+            zlev(ig,l)=0.5*(pphi(ig,l)+pphi(ig,l-1))/RG
+         enddo
+      enddo
+      do ig=1,ngrid
+         zlev(ig,1)=0.
+         zlev(ig,nlay+1)=(2.*pphi(ig,klev)-pphi(ig,klev-1))/RG
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid
+            zlay(ig,l)=pphi(ig,l)/RG
+         enddo
+      enddo
+
+c     print*,'2 OK convect8'
+c-----------------------------------------------------------------------
+c   Calcul des densites
+c-----------------------------------------------------------------------
+
+      do l=1,nlay
+         do ig=1,ngrid
+c            rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+             rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*ztv(ig,l))
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            rhobarz(ig,l)=0.5*(rho(ig,l)+rho(ig,l-1))
+         enddo
+      enddo
+
+      do k=1,nlay
+         do l=1,nlay+1
+            do ig=1,ngrid
+               wa(ig,k,l)=0.
+            enddo
+         enddo
+      enddo
+
+c     print*,'3 OK convect8'
+c------------------------------------------------------------------
+c   Calcul de w2, quarre de w a partir de la cape
+c   a partir de w2, on calcule wa, vitesse de l'ascendance
+c
+c   ATTENTION: Dans cette version, pour cause d'economie de memoire,
+c   w2 est stoke dans wa
+c
+c   ATTENTION: dans convect8, on n'utilise le calcule des wa
+c   independants par couches que pour calculer l'entrainement
+c   a la base et la hauteur max de l'ascendance.
+c
+c   Indicages:
+c   l'ascendance provenant du niveau k traverse l'interface l avec
+c   une vitesse wa(k,l).
+c
+c                       --------------------
+c
+c                       + + + + + + + + + + 
+c
+c  wa(k,l)   ----       --------------------    l
+c             /\
+c            /||\       + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||
+c             ||        + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||__
+c             |___      + + + + + + + + + +     k
+c
+c                       --------------------
+c
+c
+c
+c------------------------------------------------------------------
+
+cCR: ponderation entrainement des couches instables
+cdef des entr_star tels que entr=f*entr_star      
+      do l=1,klev
+         do ig=1,ngrid 
+            entr_star(ig,l)=0.
+         enddo
+      enddo
+c determination de la longueur de la couche d entrainement
+      do ig=1,ngrid
+         lentr(ig)=1
+      enddo
+
+con ne considere que les premieres couches instables
+      do k=nlay-1,1,-1
+         do ig=1,ngrid
+            if (ztv(ig,k).gt.ztv(ig,k+1).and.
+     s          ztv(ig,k+1).lt.ztv(ig,k+2)) then
+               lentr(ig)=k
+            endif
+          enddo
+      enddo
+    
+c determination du lmin: couche d ou provient le thermique
+      do ig=1,ngrid
+         lmin(ig)=1
+      enddo
+      do ig=1,ngrid
+         do l=nlay,2,-1
+            if (ztv(ig,l-1).gt.ztv(ig,l)) then
+               lmin(ig)=l-1
+            endif
+         enddo
+      enddo
+c
+c definition de l'entrainement des couches
+      do l=1,klev-1
+         do ig=1,ngrid 
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.
+     s          l.ge.lmin(ig).and.l.le.lentr(ig)) then 
+                 entr_star(ig,l)=(ztv(ig,l)-ztv(ig,l+1))*
+     s                          (zlev(ig,l+1)-zlev(ig,l))
+            endif
+         enddo
+      enddo
+c pas de thermique si couche 1 stable
+      do ig=1,ngrid
+         if (lmin(ig).gt.1) then
+            do l=1,klev
+               entr_star(ig,l)=0.
+            enddo
+         endif
+      enddo 
+c calcul de l entrainement total
+      do ig=1,ngrid
+         entr_star_tot(ig)=0.
+      enddo
+      do ig=1,ngrid
+         do k=1,klev
+            entr_star_tot(ig)=entr_star_tot(ig)+entr_star(ig,k)
+         enddo
+      enddo
+c
+      do k=1,klev
+         do ig=1,ngrid 
+            ztva(ig,k)=ztv(ig,k)
+         enddo
+      enddo
+cRC
+cAM:initialisations
+      do k=1,nlay
+         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)
+            Zsat(ig) =.false.
+         enddo
+      enddo
+c
+c     print*,'7 OK convect8'
+      do k=1,klev+1
+         do ig=1,ngrid
+            zw2(ig,k)=0.
+            fmc(ig,k)=0.
+cCR
+            f_star(ig,k)=0.
+cRC
+            larg_cons(ig,k)=0.
+            larg_detr(ig,k)=0.
+            wa_moy(ig,k)=0.
+         enddo
+      enddo
+
+c     print*,'8 OK convect8'
+      do ig=1,ngrid
+         linter(ig)=1.
+         lmaxa(ig)=1
+         lmix(ig)=1
+         wmaxa(ig)=0.
+      enddo
+
+cCR: 
+      do l=1,nlay-2
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1)
+     s         .and.entr_star(ig,l).gt.1.e-10
+     s         .and.zw2(ig,l).lt.1e-10) then
+cAM
+               ztla(ig,l)=zthl(ig,l)
+               zqta(ig,l)=po(ig,l)
+               zqla(ig,l)=zl(ig,l)
+cAM
+               f_star(ig,l+1)=entr_star(ig,l)
+ctest:calcul de dteta
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+     s                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+               larg_detr(ig,l)=0.
+            else if ((zw2(ig,l).ge.1e-10).and.
+     s               (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)
+c
+cAM on melange Tl et qt du thermique
+               ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+entr_star(ig,l)
+     s                    *zthl(ig,l))/f_star(ig,l+1)
+               zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+entr_star(ig,l)
+     s                    *po(ig,l))/f_star(ig,l+1)
+c
+c               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)
+c     s                    *ztv(ig,l))/f_star(ig,l+1)
+c
+cAM on en deduit thetav et ql du thermique
+               Tbef(ig)=ztla(ig,l)*zpspsk(ig,l)
+               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+               qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,l)
+               qsatbef(ig)=MIN(0.5,qsatbef(ig))
+               zcor=1./(1.-retv*qsatbef(ig))
+               qsatbef(ig)=qsatbef(ig)*zcor
+               Zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig)) .gt. 0.00001)
+            endif
+         enddo
+         DO ig=1,ngrid
+           if (Zsat(ig)) then
+              qlbef=max(0.,zqta(ig,l)-qsatbef(ig))
+              DT = 0.5*RLvCp*qlbef
+              do while (DT.gt.DDT0)
+                 Tbef(ig)=Tbef(ig)+DT
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 qsatbef(ig)= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig,l)
+                 qsatbef(ig)=MIN(0.5,qsatbef(ig))
+                 zcor=1./(1.-retv*qsatbef(ig))
+                 qsatbef(ig)=qsatbef(ig)*zcor
+                 qlbef=zqta(ig,l)-qsatbef(ig)
+
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+                 zcor=1./(1.-retv*qsatbef(ig))
+                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef(ig),zcor)
+                 num=-Tbef(ig)+ztla(ig,l)*zpspsk(ig,l)+RLvCp*qlbef
+                 denom=1.+RLvCp*dqsat_dT
+                 DT=num/denom
+              enddo
+              zqla(ig,l) = max(0.,zqta(ig,l)-qsatbef(ig))
+           endif
+c on ecrit de maniere conservative (sat ou non)
+c          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)
+           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
+     s              -zqla(ig,l))-zqla(ig,l))
+
+        enddo
+        DO ig=1,ngrid
+           if (zw2(ig,l).ge.1.e-10.and.
+     s               f_star(ig,l)+entr_star(ig,l).gt.1.e-10) then
+c  mise a jour de la vitesse ascendante (l'air entraine de la couche
+c  consideree commence avec une vitesse nulle).
+c
+               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+
+     s                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+c 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))
+     s           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+               lmaxa(ig)=l
+            else
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+            endif
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+c   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
+c
+c 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
+c pas de thermique si couche 1 stable
+      do ig=1,ngrid
+         if (lmin(ig).gt.1) then
+            lmax(ig)=1
+            lmin(ig)=1
+         endif
+      enddo 
+c    
+c 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
+
+c   Longueur caracteristique correspondant a la hauteur des thermiques.
+      do  ig=1,ngrid
+         zmax(ig)=500.
+         zlevinter(ig)=zlev(ig,1)
+      enddo
+      do  ig=1,ngrid
+c calcul de zlevinter
+          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*
+     s    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)
+     s    -zlev(ig,lmax(ig)))
+       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+      enddo
+
+c Fermeture,determination de f
+      do ig=1,ngrid
+         entr_star2(ig)=0.
+      enddo
+      do ig=1,ngrid
+         if (entr_star_tot(ig).LT.1.e-10) then
+            f(ig)=0.
+         else
+             do k=lmin(ig),lentr(ig)
+                entr_star2(ig)=entr_star2(ig)+entr_star(ig,k)**2
+     s                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+             enddo
+c Nouvelle fermeture
+             f(ig)=wmax(ig)/(zmax(ig)*r_aspect*entr_star2(ig))
+     s             *entr_star_tot(ig)
+ctest
+             if (first) then
+             f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
+     s             *wmax(ig))
+             endif
+         endif
+         f0(ig)=f(ig)
+         first=.true.
+      enddo
+
+c Calcul de l'entrainement
+       do k=1,klev
+         do ig=1,ngrid 
+            entr(ig,k)=f(ig)*entr_star(ig,k)
+         enddo
+      enddo
+c Calcul des flux
+      do ig=1,ngrid
+         do l=1,lmax(ig)-1
+            fmc(ig,l+1)=fmc(ig,l)+entr(ig,l)
+         enddo
+      enddo
+
+cRC
+
+
+c     print*,'9 OK convect8'
+c     print*,'WA1 ',wa_moy
+
+c   determination de l'indice du debut de la mixed layer ou w decroit
+
+c   calcul de la largeur de chaque ascendance dans le cas conservatif.
+c   dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+c   d'une couche est égale à la hauteur de la couche alimentante.
+c   La vitesse maximale dans l'ascendance est aussi prise comme estimation
+c   de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+               zw=max(wa_moy(ig,l),1.e-10)
+               larg_cons(ig,l)=zmax(ig)*r_aspect
+     s         *fmc(ig,l)/(rhobarz(ig,l)*zw)
+            endif
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+c              if (idetr.eq.0) then
+c  cette option est finalement en dur.
+                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c              else if (idetr.eq.1) then
+c                 larg_detr(ig,l)=larg_cons(ig,l)
+c    s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+c              else if (idetr.eq.2) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *sqrt(wa_moy(ig,l))
+c              else if (idetr.eq.4) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *wa_moy(ig,l)
+c              endif
+            endif
+         enddo
+       enddo
+
+c     print*,'10 OK convect8'
+c     print*,'WA2 ',wa_moy
+c   calcul de la fraction de la maille concernée par l'ascendance en tenant
+c   compte de l'epluchage du thermique.
+c
+cCR def de  zmix continu (profil parabolique des vitesses)
+      do ig=1,ngrid
+           if (lmix(ig).gt.1.) then
+            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))
+     s        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+         else 
+         zmix(ig)=0.
+         endif
+      enddo
+c
+c calcul du nouveau lmix correspondant
+      do ig=1,ngrid
+         do l=1,klev
+            if (zmix(ig).ge.zlev(ig,l).and.
+     s          zmix(ig).lt.zlev(ig,l+1)) then
+              lmix(ig)=l
+             endif
+          enddo
+      enddo
+c
+      do l=2,nlay
+         do ig=1,ngrid
+            if(larg_cons(ig,l).gt.1.) then
+c     print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+               fraca(ig,l)=(larg_cons(ig,l)-larg_detr(ig,l))
+     s            /(r_aspect*zmax(ig))
+c test
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+            else
+c              wa_moy(ig,l)=0.
+               fraca(ig,l)=0.
+               fracc(ig,l)=0.
+               fracd(ig,l)=1.
+            endif
+         enddo
+      enddo                  
+cCR: calcul de fracazmix
+       do ig=1,ngrid
+          fracazmix(ig)=(fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/
+     s     (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig)
+     s    +fraca(ig,lmix(ig))-zlev(ig,lmix(ig))*(fraca(ig,lmix(ig)+1)
+     s    -fraca(ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+       enddo
+c
+       do l=2,nlay
+          do ig=1,ngrid
+             if(larg_cons(ig,l).gt.1.) then
+               if (l.gt.lmix(ig)) then
+                 xxx(ig,l)=(zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+           if (idetr.eq.0) then
+               fraca(ig,l)=fracazmix(ig)
+           else if (idetr.eq.1) then
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)
+           else if (idetr.eq.2) then
+               fraca(ig,l)=fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+           else
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)**2
+           endif
+c     print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+             endif
+            endif
+         enddo
+      enddo
+
+c     print*,'11 OK convect8'
+c     print*,'Ea3 ',wa_moy
+c------------------------------------------------------------------
+c   Calcul de fracd, wd
+c   somme wa - wd = 0
+c------------------------------------------------------------------
+
+
+      do ig=1,ngrid
+         fm(ig,1)=0.
+         fm(ig,nlay+1)=0.
+      enddo
+
+      do l=2,nlay
+           do ig=1,ngrid
+              fm(ig,l)=fraca(ig,l)*wa_moy(ig,l)*rhobarz(ig,l)
+cCR:test
+              if (entr(ig,l-1).lt.1e-10.and.fm(ig,l).gt.fm(ig,l-1)
+     s            .and.l.gt.lmix(ig)) then
+                 fm(ig,l)=fm(ig,l-1)
+c                 write(1,*)'ajustement fm, l',l
+              endif
+c              write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+cRC
+           enddo
+         do ig=1,ngrid
+            if(fracd(ig,l).lt.0.1) then
+               stop'fracd trop petit'
+            else
+c    vitesse descendante "diagnostique"
+               wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l))
+            endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+c           masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+            masse(ig,l)=(pplev(ig,l)-pplev(ig,l+1))/RG
+         enddo
+      enddo
+
+c     print*,'12 OK convect8'
+c     print*,'WA4 ',wa_moy
+cc------------------------------------------------------------------
+c   calcul du transport vertical
+c------------------------------------------------------------------
+
+      go to 4444
+c     print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+      do l=2,nlay-1
+         do ig=1,ngrid
+            if(fm(ig,l+1)*ptimestep.gt.masse(ig,l)
+     s      .and.fm(ig,l+1)*ptimestep.gt.masse(ig,l+1)) then
+c     print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+c    s         ,fm(ig,l+1)*ptimestep
+c    s         ,'   M=',masse(ig,l),masse(ig,l+1)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(entr(ig,l)*ptimestep.gt.masse(ig,l)) then
+c     print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+c    s         ,entr(ig,l)*ptimestep
+c    s         ,'   M=',masse(ig,l)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(.not.fm(ig,l).ge.0..or..not.fm(ig,l).le.10.) then
+c     print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+c    s         ,'   FM=',fm(ig,l)
+            endif
+            if(.not.masse(ig,l).ge.1.e-10
+     s         .or..not.masse(ig,l).le.1.e4) then
+c     print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+c    s         ,'   M=',masse(ig,l)
+c     print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+c    s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+c     print*,'zlev(ig,l+1),zlev(ig,l)'
+c    s                ,zlev(ig,l+1),zlev(ig,l)
+c     print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+c    s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+            endif
+            if(.not.entr(ig,l).ge.0..or..not.entr(ig,l).le.10.) then
+c     print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+c    s         ,'   E=',entr(ig,l)
+            endif
+         enddo
+      enddo
+
+4444   continue
+
+      if (w2di.eq.1) then
+         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+      else
+         fm0=fm
+         entr0=entr
+      endif
+
+      if (1.eq.1) then
+c         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+c     .    ,zh,zdhadj,zha)
+c         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+c     .    ,zo,pdoadj,zoa)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zthl,zdthladj,zta)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,po,pdoadj,zoa)
+      else
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zh,zdhadj,zha)
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zo,pdoadj,zoa)
+      endif
+
+      if (1.eq.0) then
+         call dvthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,fraca,zmax
+     .    ,zu,zv,pduadj,pdvadj,zua,zva)
+      else
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zu,pduadj,zua)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zv,pdvadj,zva)
+      endif
+
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
+            zf2=zf/(1.-zf)
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
+            wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+         enddo
+      enddo
+
+
+
+c     print*,'13 OK convect8'
+c     print*,'WA5 ',wa_moy
+      do l=1,nlay
+         do ig=1,ngrid
+c            pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)  
+         enddo
+      enddo
+
+
+c     do l=1,nlay
+c        do ig=1,ngrid
+c           if(abs(pdtadj(ig,l))*86400..gt.500.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdtadj=',pdtadj(ig,l)
+c           endif
+c           if(abs(pdoadj(ig,l))*86400..gt.1.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdoadj=',pdoadj(ig,l)
+c           endif
+c        enddo
+c      enddo
+
+c     print*,'14 OK convect8'
+c------------------------------------------------------------------
+c   Calculs pour les sorties
+c------------------------------------------------------------------
+
+      if(sorties) then
+      do l=1,nlay
+         do ig=1,ngrid
+            zla(ig,l)=(1.-fracd(ig,l))*zmax(ig)
+            zld(ig,l)=fracd(ig,l)*zmax(ig)
+            if(1.-fracd(ig,l).gt.1.e-10)
+     s      zwa(ig,l)=wd(ig,l)*fracd(ig,l)/(1.-fracd(ig,l))
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+            if (detr(ig,l).lt.0.) then
+                entr(ig,l)=entr(ig,l)-detr(ig,l)
+                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+            endif
+         enddo
+      enddo
+
+c     print*,'15 OK convect8'
+
+      isplit=isplit+1
+
+
+c #define und
+	goto 123
+#ifdef und
+      CALL writeg1d(1,nlay,wd,'wd      ','wd      ')
+      CALL writeg1d(1,nlay,zwa,'wa      ','wa      ')
+      CALL writeg1d(1,nlay,fracd,'fracd      ','fracd      ')
+      CALL writeg1d(1,nlay,fraca,'fraca      ','fraca      ')
+      CALL writeg1d(1,nlay,wa_moy,'wam         ','wam         ')
+      CALL writeg1d(1,nlay,zla,'la      ','la      ')
+      CALL writeg1d(1,nlay,zld,'ld      ','ld      ')
+      CALL writeg1d(1,nlay,pt,'pt      ','pt      ')
+      CALL writeg1d(1,nlay,zh,'zh      ','zh      ')
+      CALL writeg1d(1,nlay,zha,'zha      ','zha      ')
+      CALL writeg1d(1,nlay,zu,'zu      ','zu      ')
+      CALL writeg1d(1,nlay,zv,'zv      ','zv      ')
+      CALL writeg1d(1,nlay,zo,'zo      ','zo      ')
+      CALL writeg1d(1,nlay,wh,'wh      ','wh      ')
+      CALL writeg1d(1,nlay,wu,'wu      ','wu      ')
+      CALL writeg1d(1,nlay,wv,'wv      ','wv      ')
+      CALL writeg1d(1,nlay,wo,'w15uo     ','wXo     ')
+      CALL writeg1d(1,nlay,zdhadj,'zdhadj      ','zdhadj      ')
+      CALL writeg1d(1,nlay,pduadj,'pduadj      ','pduadj      ')
+      CALL writeg1d(1,nlay,pdvadj,'pdvadj      ','pdvadj      ')
+      CALL writeg1d(1,nlay,pdoadj,'pdoadj      ','pdoadj      ')
+      CALL writeg1d(1,nlay,entr  ,'entr        ','entr        ')
+      CALL writeg1d(1,nlay,detr  ,'detr        ','detr        ')
+      CALL writeg1d(1,nlay,fm    ,'fm          ','fm          ')
+
+      CALL writeg1d(1,nlay,pdtadj,'pdtadj    ','pdtadj    ')
+      CALL writeg1d(1,nlay,pplay,'pplay     ','pplay     ')
+      CALL writeg1d(1,nlay,pplev,'pplev     ','pplev     ')
+
+c   recalcul des flux en diagnostique...
+c     print*,'PAS DE TEMPS ',ptimestep
+       call dt2F(pplev,pplay,pt,pdtadj,wh)
+      CALL writeg1d(1,nlay,wh,'wh2     ','wh2     ')
+#endif
+123   continue
+! #define troisD
+#ifdef troisD
+c       if (sorties) then
+      print*,'Debut des wrgradsfi'
+
+c      print*,'16 OK convect8'
+         call wrgradsfi(1,nlay,wd,'wd        ','wd        ')
+         call wrgradsfi(1,nlay,zwa,'wa        ','wa        ')
+         call wrgradsfi(1,nlay,fracd,'fracd     ','fracd     ')
+         call wrgradsfi(1,nlay,fraca,'fraca     ','fraca     ')
+         call wrgradsfi(1,nlay,xxx,'xxx       ','xxx       ')
+         call wrgradsfi(1,nlay,wa_moy,'wam       ','wam       ')
+c      print*,'WA6 ',wa_moy
+         call wrgradsfi(1,nlay,zla,'la        ','la        ')
+         call wrgradsfi(1,nlay,zld,'ld        ','ld        ')
+         call wrgradsfi(1,nlay,pt,'pt        ','pt        ')
+         call wrgradsfi(1,nlay,zh,'zh        ','zh        ')
+         call wrgradsfi(1,nlay,zha,'zha        ','zha        ')
+         call wrgradsfi(1,nlay,zua,'zua        ','zua        ')
+         call wrgradsfi(1,nlay,zva,'zva        ','zva        ')
+         call wrgradsfi(1,nlay,zu,'zu        ','zu        ')
+         call wrgradsfi(1,nlay,zv,'zv        ','zv        ')
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,wh,'wh        ','wh        ')
+         call wrgradsfi(1,nlay,wu,'wu        ','wu        ')
+         call wrgradsfi(1,nlay,wv,'wv        ','wv        ')
+         call wrgradsfi(1,nlay,wo,'wo        ','wo        ')
+         call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+         call wrgradsfi(1,nlay,zdhadj,'zdhadj    ','zdhadj    ')
+         call wrgradsfi(1,nlay,pduadj,'pduadj    ','pduadj    ')
+         call wrgradsfi(1,nlay,pdvadj,'pdvadj    ','pdvadj    ')
+         call wrgradsfi(1,nlay,pdoadj,'pdoadj    ','pdoadj    ')
+         call wrgradsfi(1,nlay,entr,'entr      ','entr      ')
+         call wrgradsfi(1,nlay,detr,'detr      ','detr      ')
+         call wrgradsfi(1,nlay,fm,'fm        ','fm        ')
+         call wrgradsfi(1,nlay,fmc,'fmc       ','fmc       ')
+         call wrgradsfi(1,nlay,zw2,'zw2       ','zw2       ')
+         call wrgradsfi(1,nlay,ztva,'ztva      ','ztva      ')
+         call wrgradsfi(1,nlay,ztv,'ztv       ','ztv       ')
+
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,larg_cons,'Lc        ','Lc        ')
+         call wrgradsfi(1,nlay,larg_detr,'Ldetr     ','Ldetr     ')
+
+cAM:nouveaux diagnostiques
+         call wrgradsfi(1,nlay,zthl,'zthl        ','zthl        ')
+         call wrgradsfi(1,nlay,zta,'zta        ','zta        ')
+         call wrgradsfi(1,nlay,zl,'zl        ','zl        ')
+         call wrgradsfi(1,nlay,zdthladj,'zdthladj    ',
+     s        'zdthladj    ')
+         call wrgradsfi(1,nlay,ztla,'ztla      ','ztla      ')
+         call wrgradsfi(1,nlay,zqta,'zqta      ','zqta      ')
+         call wrgradsfi(1,nlay,zqla,'zqla      ','zqla      ')
+cCR:nouveaux diagnostiques
+      call wrgradsfi(1,nlay,entr_star  ,'entr_star   ','entr_star   ')     
+      call wrgradsfi(1,nlay,f_star    ,'f_star   ','f_star   ')
+      call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+      call wrgradsfi(1,1,zmix,'zmix      ','zmix      ') 
+      zsortie1d(:)=lmax(:)
+      call wrgradsfi(1,1,zsortie1d,'lmax      ','lmax      ')
+      call wrgradsfi(1,1,wmax,'wmax      ','wmax      ')
+      zsortie1d(:)=lmix(:)
+      call wrgradsfi(1,1,zsortie1d,'lmix      ','lmix      ')
+      zsortie1d(:)=lentr(:)
+      call wrgradsfi(1,1,zsortie1d,'lentr      ','lentr     ')
+
+c      print*,'17 OK convect8'
+
+         do k=1,klev/10
+            write(str2,'(i2.2)') k
+            str10='wa'//str2
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=wa(ig,k,l)
+               enddo
+            enddo   
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=larg_part(ig,k,l)
+               enddo
+            enddo
+            str10='la'//str2
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+         enddo
+
+
+c     print*,'18 OK convect8'
+c      endif
+      print*,'Fin des wrgradsfi'
+#endif
+
+      endif
+
+c     if(wa_moy(1,4).gt.1.e-10) stop
+
+c     print*,'19 OK convect8'
+      return
+      end
+
+      SUBROUTINE thermcell(ngrid,nlay,ptimestep
+     s                  ,pplay,pplev,pphi
+     s                  ,pu,pv,pt,po
+     s                  ,pduadj,pdvadj,pdtadj,pdoadj
+     s                  ,fm0,entr0
+c    s                  ,pu_therm,pv_therm
+     s                  ,r_aspect,l_mix,w2di,tho)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c
+c   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+c
+c   le thermique est supposé homogène et dissipé par mélange avec
+c   son environnement. la longueur l_mix contrôle l'efficacité du
+c   mélange
+c
+c   Le calcul du transport des différentes espèces se fait en prenant
+c   en compte:
+c     1. un flux de masse montant
+c     2. un flux de masse descendant
+c     3. un entrainement
+c     4. un detrainement
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,w2di,tho
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+      integer idetr
+      save idetr
+      data idetr/3/
+
+c   local:
+c   ------
+
+      INTEGER ig,k,l,lmaxa(klon),lmix(klon)
+      real zsortie1d(klon)
+c CR: on remplace lmax(klon,klev+1)
+      INTEGER lmax(klon),lmin(klon),lentr(klon)
+      real linter(klon)
+      real zmix(klon), fracazmix(klon) 
+c RC 
+      real zmax(klon),zw,zz,zw2(klon,klev+1),ztva(klon,klev),zzz
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      REAL zh(klon,klev),zdhadj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      REAL wh(klon,klev+1)
+      real wu(klon,klev+1),wv(klon,klev+1),wo(klon,klev+1)
+      real zla(klon,klev+1)
+      real zwa(klon,klev+1)
+      real zld(klon,klev+1)
+      real zwd(klon,klev+1)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zha(klon,klev)
+      real wa_moy(klon,klev+1)
+      real fraca(klon,klev+1)
+      real fracc(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev)
+      common/comtherm/thetath2,wth2
+
+      real count_time
+      integer isplit,nsplit,ialt
+      parameter (nsplit=10)
+      data isplit/0/
+      save isplit
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+c     real wmax(klon,klev),wmaxa(klon)
+      real wmax(klon),wmaxa(klon)
+      real wa(klon,klev,klev+1)
+      real wd(klon,klev+1)
+      real larg_part(klon,klev,klev+1)
+      real fracd(klon,klev+1)
+      real xxx(klon,klev+1)
+      real larg_cons(klon,klev+1)
+      real larg_detr(klon,klev+1)
+      real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
+      real pu_therm(klon,klev),pv_therm(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev)
+      real fmc(klon,klev+1)
+
+cCR:nouvelles variables
+      real f_star(klon,klev+1),entr_star(klon,klev)
+      real entr_star_tot(klon),entr_star2(klon)
+      real f(klon), f0(klon)
+      real zlevinter(klon)
+      logical first
+      data first /.false./
+      save first
+cRC
+
+      character*2 str2
+      character*10 str10
+
+      LOGICAL vtest(klon),down
+
+      EXTERNAL SCOPY
+
+      integer ncorrec,ll
+      save ncorrec
+      data ncorrec/0/
+      
+c
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+       sorties=.true.
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+c
+c-----------------------------------------------------------------------
+c   incrementation eventuelle de tendances precedentes:
+c   ---------------------------------------------------
+
+       print*,'0 OK convect8'
+
+      DO 1010 l=1,nlay
+         DO 1015 ig=1,ngrid
+            zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
+            zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zu(ig,l)=pu(ig,l)
+            zv(ig,l)=pv(ig,l)
+            zo(ig,l)=po(ig,l)
+            ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+1015     CONTINUE
+1010  CONTINUE
+
+       print*,'1 OK convect8'
+c                       --------------------
+c
+c
+c                       + + + + + + + + + + +
+c
+c
+c  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+c  wh,wt,wo ...
+c
+c                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+c
+c
+c                       --------------------   zlev(1)
+c                       \\\\\\\\\\\\\\\\\\\\
+c
+c
+
+c-----------------------------------------------------------------------
+c   Calcul des altitudes des couches
+c-----------------------------------------------------------------------
+
+      do l=2,nlay
+         do ig=1,ngrid
+            zlev(ig,l)=0.5*(pphi(ig,l)+pphi(ig,l-1))/RG
+         enddo
+      enddo
+      do ig=1,ngrid
+         zlev(ig,1)=0.
+         zlev(ig,nlay+1)=(2.*pphi(ig,klev)-pphi(ig,klev-1))/RG
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid
+            zlay(ig,l)=pphi(ig,l)/RG
+         enddo
+      enddo
+
+c      print*,'2 OK convect8'
+c-----------------------------------------------------------------------
+c   Calcul des densites
+c-----------------------------------------------------------------------
+
+      do l=1,nlay
+         do ig=1,ngrid
+            rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            rhobarz(ig,l)=0.5*(rho(ig,l)+rho(ig,l-1))
+         enddo
+      enddo
+
+      do k=1,nlay
+         do l=1,nlay+1
+            do ig=1,ngrid
+               wa(ig,k,l)=0.
+            enddo
+         enddo
+      enddo
+
+c      print*,'3 OK convect8'
+c------------------------------------------------------------------
+c   Calcul de w2, quarre de w a partir de la cape
+c   a partir de w2, on calcule wa, vitesse de l'ascendance
+c
+c   ATTENTION: Dans cette version, pour cause d'economie de memoire,
+c   w2 est stoke dans wa
+c
+c   ATTENTION: dans convect8, on n'utilise le calcule des wa
+c   independants par couches que pour calculer l'entrainement
+c   a la base et la hauteur max de l'ascendance.
+c
+c   Indicages:
+c   l'ascendance provenant du niveau k traverse l'interface l avec
+c   une vitesse wa(k,l).
+c
+c                       --------------------
+c
+c                       + + + + + + + + + + 
+c
+c  wa(k,l)   ----       --------------------    l
+c             /\
+c            /||\       + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||
+c             ||        + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||__
+c             |___      + + + + + + + + + +     k
+c
+c                       --------------------
+c
+c
+c
+c------------------------------------------------------------------
+
+cCR: ponderation entrainement des couches instables
+cdef des entr_star tels que entr=f*entr_star      
+      do l=1,klev
+         do ig=1,ngrid 
+            entr_star(ig,l)=0.
+         enddo
+      enddo
+c determination de la longueur de la couche d entrainement
+      do ig=1,ngrid
+         lentr(ig)=1
+      enddo
+
+con ne considere que les premieres couches instables
+      do k=nlay-2,1,-1
+         do ig=1,ngrid
+            if (ztv(ig,k).gt.ztv(ig,k+1).and.
+     s          ztv(ig,k+1).le.ztv(ig,k+2)) then
+               lentr(ig)=k
+            endif
+          enddo
+      enddo
+    
+c determination du lmin: couche d ou provient le thermique
+      do ig=1,ngrid
+         lmin(ig)=1
+      enddo
+      do ig=1,ngrid
+         do l=nlay,2,-1
+            if (ztv(ig,l-1).gt.ztv(ig,l)) then
+               lmin(ig)=l-1
+            endif
+         enddo
+      enddo
+c
+c definition de l'entrainement des couches
+      do l=1,klev-1
+         do ig=1,ngrid 
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.
+     s          l.ge.lmin(ig).and.l.le.lentr(ig)) then 
+                 entr_star(ig,l)=(ztv(ig,l)-ztv(ig,l+1))*
+     s                           (zlev(ig,l+1)-zlev(ig,l))
+            endif
+         enddo
+      enddo
+c pas de thermique si couches 1->5 stables
+      do ig=1,ngrid
+         if (lmin(ig).gt.5) then
+            do l=1,klev
+               entr_star(ig,l)=0.
+            enddo
+         endif
+      enddo 
+c calcul de l entrainement total
+      do ig=1,ngrid
+         entr_star_tot(ig)=0.
+      enddo
+      do ig=1,ngrid
+         do k=1,klev
+            entr_star_tot(ig)=entr_star_tot(ig)+entr_star(ig,k)
+         enddo
+      enddo
+c
+      print*,'fin calcul entr_star'
+      do k=1,klev
+         do ig=1,ngrid 
+            ztva(ig,k)=ztv(ig,k)
+         enddo
+      enddo
+cRC
+c      print*,'7 OK convect8'
+      do k=1,klev+1
+         do ig=1,ngrid
+            zw2(ig,k)=0.
+            fmc(ig,k)=0.
+cCR
+            f_star(ig,k)=0.
+cRC
+            larg_cons(ig,k)=0.
+            larg_detr(ig,k)=0.
+            wa_moy(ig,k)=0.
+         enddo
+      enddo
+
+c      print*,'8 OK convect8'
+      do ig=1,ngrid
+         linter(ig)=1.
+         lmaxa(ig)=1
+         lmix(ig)=1
+         wmaxa(ig)=0.
+      enddo
+
+cCR: 
+      do l=1,nlay-2
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1)
+     s         .and.entr_star(ig,l).gt.1.e-10
+     s         .and.zw2(ig,l).lt.1e-10) then
+               f_star(ig,l+1)=entr_star(ig,l)
+ctest:calcul de dteta
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+     s                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+               larg_detr(ig,l)=0.
+            else if ((zw2(ig,l).ge.1e-10).and.
+     s               (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)
+     s                    *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+
+     s                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+c determination de zmax continu par interpolation lineaire
+            if (zw2(ig,l+1).lt.0.) then
+ctest
+               if (abs(zw2(ig,l+1)-zw2(ig,l)).lt.1e-10) then
+                  print*,'pb linter'
+               endif
+               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))
+     s           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+               lmaxa(ig)=l
+            else
+               if (zw2(ig,l+1).lt.0.) then
+                  print*,'pb1 zw2<0'
+               endif
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+            endif
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+c   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
+      print*,'fin calcul zw2'
+c
+c 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
+c pas de thermique si couches 1->5 stables
+      do ig=1,ngrid
+         if (lmin(ig).gt.5) then
+            lmax(ig)=1
+            lmin(ig)=1
+         endif
+      enddo 
+c    
+c 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
+
+c   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
+c calcul de zlevinter
+          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*
+     s    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)
+     s    -zlev(ig,lmax(ig)))
+       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+      enddo
+
+      print*,'avant fermeture'
+c Fermeture,determination de f
+      do ig=1,ngrid
+         entr_star2(ig)=0.
+      enddo
+      do ig=1,ngrid
+         if (entr_star_tot(ig).LT.1.e-10) then
+            f(ig)=0.
+         else
+             do k=lmin(ig),lentr(ig)
+                entr_star2(ig)=entr_star2(ig)+entr_star(ig,k)**2
+     s                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+             enddo
+c Nouvelle fermeture
+             f(ig)=wmax(ig)/(max(500.,zmax(ig))*r_aspect
+     s             *entr_star2(ig))*entr_star_tot(ig)
+ctest
+c             if (first) then
+c             f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
+c     s             *wmax(ig))
+c             endif
+         endif
+c         f0(ig)=f(ig)
+c         first=.true.
+      enddo
+      print*,'apres fermeture'
+
+c Calcul de l'entrainement
+       do k=1,klev
+         do ig=1,ngrid 
+            entr(ig,k)=f(ig)*entr_star(ig,k)
+         enddo
+      enddo
+c Calcul des flux
+      do ig=1,ngrid
+         do l=1,lmax(ig)-1
+            fmc(ig,l+1)=fmc(ig,l)+entr(ig,l)
+         enddo
+      enddo
+
+cRC
+
+
+c      print*,'9 OK convect8'
+c     print*,'WA1 ',wa_moy
+
+c   determination de l'indice du debut de la mixed layer ou w decroit
+
+c   calcul de la largeur de chaque ascendance dans le cas conservatif.
+c   dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+c   d'une couche est égale à la hauteur de la couche alimentante.
+c   La vitesse maximale dans l'ascendance est aussi prise comme estimation
+c   de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+               zw=max(wa_moy(ig,l),1.e-10)
+               larg_cons(ig,l)=zmax(ig)*r_aspect
+     s         *fmc(ig,l)/(rhobarz(ig,l)*zw)
+            endif
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+c              if (idetr.eq.0) then
+c  cette option est finalement en dur.
+                  if ((l_mix*zlev(ig,l)).lt.0.)then
+                   print*,'pb l_mix*zlev<0'
+                  endif
+                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c              else if (idetr.eq.1) then
+c                 larg_detr(ig,l)=larg_cons(ig,l)
+c    s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+c              else if (idetr.eq.2) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *sqrt(wa_moy(ig,l))
+c              else if (idetr.eq.4) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *wa_moy(ig,l)
+c              endif
+            endif
+         enddo
+       enddo
+
+c      print*,'10 OK convect8'
+c     print*,'WA2 ',wa_moy
+c   calcul de la fraction de la maille concernée par l'ascendance en tenant
+c   compte de l'epluchage du thermique.
+c
+cCR def de  zmix continu (profil parabolique des vitesses)
+      do ig=1,ngrid
+           if (lmix(ig).gt.1.) then
+c test 
+              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)
+     s        then
+c             
+            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))
+     s        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((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
+ctest
+         if ((zmax(ig)-zmix(ig)).lt.0.) then
+            zmix(ig)=0.99*zmax(ig)
+c            print*,'pb zmix>zmax'
+         endif
+      enddo
+c
+c calcul du nouveau lmix correspondant
+      do ig=1,ngrid
+         do l=1,klev
+            if (zmix(ig).ge.zlev(ig,l).and.
+     s          zmix(ig).lt.zlev(ig,l+1)) then
+              lmix(ig)=l
+             endif
+          enddo
+      enddo
+c
+      do l=2,nlay
+         do ig=1,ngrid
+            if(larg_cons(ig,l).gt.1.) then
+c     print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+               fraca(ig,l)=(larg_cons(ig,l)-larg_detr(ig,l))
+     s            /(r_aspect*zmax(ig))
+c test
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+            else
+c              wa_moy(ig,l)=0.
+               fraca(ig,l)=0.
+               fracc(ig,l)=0.
+               fracd(ig,l)=1.
+            endif
+         enddo
+      enddo                  
+cCR: calcul de fracazmix
+       do ig=1,ngrid
+          fracazmix(ig)=(fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/
+     s     (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig)
+     s    +fraca(ig,lmix(ig))-zlev(ig,lmix(ig))*(fraca(ig,lmix(ig)+1)
+     s    -fraca(ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+       enddo
+c
+       do l=2,nlay
+          do ig=1,ngrid
+             if(larg_cons(ig,l).gt.1.) then
+               if (l.gt.lmix(ig)) then
+ctest
+                 if (zmax(ig)-zmix(ig).lt.1.e-10) then
+c                   print*,'pb xxx'
+                   xxx(ig,l)=(lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
+                 else
+                 xxx(ig,l)=(zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+                 endif
+           if (idetr.eq.0) then
+               fraca(ig,l)=fracazmix(ig)
+           else if (idetr.eq.1) then
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)
+           else if (idetr.eq.2) then
+               fraca(ig,l)=fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+           else
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)**2
+           endif
+c     print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+             endif
+            endif
+         enddo
+      enddo
+      
+      print*,'fin calcul fraca'
+c      print*,'11 OK convect8'
+c     print*,'Ea3 ',wa_moy
+c------------------------------------------------------------------
+c   Calcul de fracd, wd
+c   somme wa - wd = 0
+c------------------------------------------------------------------
+
+
+      do ig=1,ngrid
+         fm(ig,1)=0.
+         fm(ig,nlay+1)=0.
+      enddo
+
+      do l=2,nlay
+           do ig=1,ngrid
+              fm(ig,l)=fraca(ig,l)*wa_moy(ig,l)*rhobarz(ig,l)
+cCR:test
+              if (entr(ig,l-1).lt.1e-10.and.fm(ig,l).gt.fm(ig,l-1)
+     s            .and.l.gt.lmix(ig)) then
+                 fm(ig,l)=fm(ig,l-1)
+c                 write(1,*)'ajustement fm, l',l
+              endif
+c              write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+cRC
+           enddo
+         do ig=1,ngrid
+            if(fracd(ig,l).lt.0.1) then
+               stop'fracd trop petit'
+            else
+c    vitesse descendante "diagnostique"
+               wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l))
+            endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+c           masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+            masse(ig,l)=(pplev(ig,l)-pplev(ig,l+1))/RG
+         enddo
+      enddo
+
+      print*,'12 OK convect8'
+c     print*,'WA4 ',wa_moy
+cc------------------------------------------------------------------
+c   calcul du transport vertical
+c------------------------------------------------------------------
+
+      go to 4444
+c     print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+      do l=2,nlay-1
+         do ig=1,ngrid
+            if(fm(ig,l+1)*ptimestep.gt.masse(ig,l)
+     s      .and.fm(ig,l+1)*ptimestep.gt.masse(ig,l+1)) then
+c     print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+c    s         ,fm(ig,l+1)*ptimestep
+c    s         ,'   M=',masse(ig,l),masse(ig,l+1)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(entr(ig,l)*ptimestep.gt.masse(ig,l)) then
+c     print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+c    s         ,entr(ig,l)*ptimestep
+c    s         ,'   M=',masse(ig,l)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(.not.fm(ig,l).ge.0..or..not.fm(ig,l).le.10.) then
+c     print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+c    s         ,'   FM=',fm(ig,l)
+            endif
+            if(.not.masse(ig,l).ge.1.e-10
+     s         .or..not.masse(ig,l).le.1.e4) then
+c     print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+c    s         ,'   M=',masse(ig,l)
+c     print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+c    s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+c     print*,'zlev(ig,l+1),zlev(ig,l)'
+c    s                ,zlev(ig,l+1),zlev(ig,l)
+c     print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+c    s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+            endif
+            if(.not.entr(ig,l).ge.0..or..not.entr(ig,l).le.10.) then
+c     print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+c    s         ,'   E=',entr(ig,l)
+            endif
+         enddo
+      enddo
+
+4444   continue
+
+cCR:redefinition du entr
+       do l=1,nlay
+         do ig=1,ngrid
+            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+            if (detr(ig,l).lt.0.) then
+                entr(ig,l)=entr(ig,l)-detr(ig,l)
+                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+            endif
+         enddo
+      enddo
+cRC
+      if (w2di.eq.1) then
+         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+      else
+         fm0=fm
+         entr0=entr
+      endif
+
+      if (1.eq.1) then
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zh,zdhadj,zha)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zo,pdoadj,zoa)
+      else
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zh,zdhadj,zha)
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zo,pdoadj,zoa)
+      endif
+
+      if (1.eq.0) then
+         call dvthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,fraca,zmax
+     .    ,zu,zv,pduadj,pdvadj,zua,zva)
+      else
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zu,pduadj,zua)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zv,pdvadj,zva)
+      endif
+
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
+            zf2=zf/(1.-zf)
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
+            wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+         enddo
+      enddo
+
+
+
+c     print*,'13 OK convect8'
+c     print*,'WA5 ',wa_moy
+      do l=1,nlay
+         do ig=1,ngrid
+            pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+         enddo
+      enddo
+
+
+c     do l=1,nlay
+c        do ig=1,ngrid
+c           if(abs(pdtadj(ig,l))*86400..gt.500.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdtadj=',pdtadj(ig,l)
+c           endif
+c           if(abs(pdoadj(ig,l))*86400..gt.1.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdoadj=',pdoadj(ig,l)
+c           endif
+c        enddo
+c      enddo
+
+      print*,'14 OK convect8'
+c------------------------------------------------------------------
+c   Calculs pour les sorties
+c------------------------------------------------------------------
+
+      if(sorties) then
+      do l=1,nlay
+         do ig=1,ngrid
+            zla(ig,l)=(1.-fracd(ig,l))*zmax(ig)
+            zld(ig,l)=fracd(ig,l)*zmax(ig)
+            if(1.-fracd(ig,l).gt.1.e-10)
+     s      zwa(ig,l)=wd(ig,l)*fracd(ig,l)/(1.-fracd(ig,l))
+         enddo
+      enddo
+
+cdeja fait
+c      do l=1,nlay
+c         do ig=1,ngrid
+c            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+c            if (detr(ig,l).lt.0.) then
+c                entr(ig,l)=entr(ig,l)-detr(ig,l)
+c                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+c            endif
+c         enddo
+c      enddo
+
+c     print*,'15 OK convect8'
+
+      isplit=isplit+1
+
+
+c #define und
+	goto 123
+#ifdef und
+      CALL writeg1d(1,nlay,wd,'wd      ','wd      ')
+      CALL writeg1d(1,nlay,zwa,'wa      ','wa      ')
+      CALL writeg1d(1,nlay,fracd,'fracd      ','fracd      ')
+      CALL writeg1d(1,nlay,fraca,'fraca      ','fraca      ')
+      CALL writeg1d(1,nlay,wa_moy,'wam         ','wam         ')
+      CALL writeg1d(1,nlay,zla,'la      ','la      ')
+      CALL writeg1d(1,nlay,zld,'ld      ','ld      ')
+      CALL writeg1d(1,nlay,pt,'pt      ','pt      ')
+      CALL writeg1d(1,nlay,zh,'zh      ','zh      ')
+      CALL writeg1d(1,nlay,zha,'zha      ','zha      ')
+      CALL writeg1d(1,nlay,zu,'zu      ','zu      ')
+      CALL writeg1d(1,nlay,zv,'zv      ','zv      ')
+      CALL writeg1d(1,nlay,zo,'zo      ','zo      ')
+      CALL writeg1d(1,nlay,wh,'wh      ','wh      ')
+      CALL writeg1d(1,nlay,wu,'wu      ','wu      ')
+      CALL writeg1d(1,nlay,wv,'wv      ','wv      ')
+      CALL writeg1d(1,nlay,wo,'w15uo     ','wXo     ')
+      CALL writeg1d(1,nlay,zdhadj,'zdhadj      ','zdhadj      ')
+      CALL writeg1d(1,nlay,pduadj,'pduadj      ','pduadj      ')
+      CALL writeg1d(1,nlay,pdvadj,'pdvadj      ','pdvadj      ')
+      CALL writeg1d(1,nlay,pdoadj,'pdoadj      ','pdoadj      ')
+      CALL writeg1d(1,nlay,entr  ,'entr        ','entr        ')
+      CALL writeg1d(1,nlay,detr  ,'detr        ','detr        ')
+      CALL writeg1d(1,nlay,fm    ,'fm          ','fm          ')
+
+      CALL writeg1d(1,nlay,pdtadj,'pdtadj    ','pdtadj    ')
+      CALL writeg1d(1,nlay,pplay,'pplay     ','pplay     ')
+      CALL writeg1d(1,nlay,pplev,'pplev     ','pplev     ')
+
+c   recalcul des flux en diagnostique...
+c     print*,'PAS DE TEMPS ',ptimestep
+       call dt2F(pplev,pplay,pt,pdtadj,wh)
+      CALL writeg1d(1,nlay,wh,'wh2     ','wh2     ')
+#endif
+123   continue
+#define troisD
+#ifdef troisD
+c       if (sorties) then
+      print*,'Debut des wrgradsfi'
+
+c      print*,'16 OK convect8'
+         call wrgradsfi(1,nlay,wd,'wd        ','wd        ')
+         call wrgradsfi(1,nlay,zwa,'wa        ','wa        ')
+         call wrgradsfi(1,nlay,fracd,'fracd     ','fracd     ')
+         call wrgradsfi(1,nlay,fraca,'fraca     ','fraca     ')
+         call wrgradsfi(1,nlay,xxx,'xxx       ','xxx       ')
+         call wrgradsfi(1,nlay,wa_moy,'wam       ','wam       ')
+c      print*,'WA6 ',wa_moy
+         call wrgradsfi(1,nlay,zla,'la        ','la        ')
+         call wrgradsfi(1,nlay,zld,'ld        ','ld        ')
+         call wrgradsfi(1,nlay,pt,'pt        ','pt        ')
+         call wrgradsfi(1,nlay,zh,'zh        ','zh        ')
+         call wrgradsfi(1,nlay,zha,'zha        ','zha        ')
+         call wrgradsfi(1,nlay,zua,'zua        ','zua        ')
+         call wrgradsfi(1,nlay,zva,'zva        ','zva        ')
+         call wrgradsfi(1,nlay,zu,'zu        ','zu        ')
+         call wrgradsfi(1,nlay,zv,'zv        ','zv        ')
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,wh,'wh        ','wh        ')
+         call wrgradsfi(1,nlay,wu,'wu        ','wu        ')
+         call wrgradsfi(1,nlay,wv,'wv        ','wv        ')
+         call wrgradsfi(1,nlay,wo,'wo        ','wo        ')
+         call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+         call wrgradsfi(1,nlay,zdhadj,'zdhadj    ','zdhadj    ')
+         call wrgradsfi(1,nlay,pduadj,'pduadj    ','pduadj    ')
+         call wrgradsfi(1,nlay,pdvadj,'pdvadj    ','pdvadj    ')
+         call wrgradsfi(1,nlay,pdoadj,'pdoadj    ','pdoadj    ')
+         call wrgradsfi(1,nlay,entr,'entr      ','entr      ')
+         call wrgradsfi(1,nlay,detr,'detr      ','detr      ')
+         call wrgradsfi(1,nlay,fm,'fm        ','fm        ')
+         call wrgradsfi(1,nlay,fmc,'fmc       ','fmc       ')
+         call wrgradsfi(1,nlay,zw2,'zw2       ','zw2       ')
+         call wrgradsfi(1,nlay,ztva,'ztva      ','ztva      ')
+         call wrgradsfi(1,nlay,ztv,'ztv       ','ztv       ')
+
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,larg_cons,'Lc        ','Lc        ')
+         call wrgradsfi(1,nlay,larg_detr,'Ldetr     ','Ldetr     ')
+
+cCR:nouveaux diagnostiques
+      call wrgradsfi(1,nlay,entr_star  ,'entr_star   ','entr_star   ')     
+      call wrgradsfi(1,nlay,f_star    ,'f_star   ','f_star   ')
+      call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+      call wrgradsfi(1,1,zmix,'zmix      ','zmix      ') 
+      zsortie1d(:)=lmax(:)
+      call wrgradsfi(1,1,zsortie1d,'lmax      ','lmax      ')
+      call wrgradsfi(1,1,wmax,'wmax      ','wmax      ')
+      zsortie1d(:)=lmix(:)
+      call wrgradsfi(1,1,zsortie1d,'lmix      ','lmix      ')
+      zsortie1d(:)=lentr(:)
+      call wrgradsfi(1,1,zsortie1d,'lentr      ','lentr     ')
+
+c      print*,'17 OK convect8'
+
+         do k=1,klev/10
+            write(str2,'(i2.2)') k
+            str10='wa'//str2
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=wa(ig,k,l)
+               enddo
+            enddo   
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=larg_part(ig,k,l)
+               enddo
+            enddo
+            str10='la'//str2
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+         enddo
+
+
+c     print*,'18 OK convect8'
+c      endif
+      print*,'Fin des wrgradsfi'
+#endif
+
+      endif
+
+c     if(wa_moy(1,4).gt.1.e-10) stop
+
+      print*,'19 OK convect8'
+      return
+      end
+
+      subroutine dqthermcell(ngrid,nlay,ptimestep,fm,entr,
+     .           masse,q,dq,qa)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay)
+      real q(ngrid,nlay)
+      real dq(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+ctest
+            if (detr(ig,k).lt.0.) then
+               entr(ig,k)=entr(ig,k)-detr(ig,k)
+               detr(ig,k)=0.
+c               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
+c     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
+            endif
+            if (fm(ig,k+1).lt.0.) then
+c               print*,'fm2<0!!!'
+            endif
+            if (entr(ig,k).lt.0.) then
+c               print*,'entr2<0!!!'
+            endif
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))
+     s         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+            if (qa(ig,k).lt.0.) then
+c               print*,'qa<0!!!'
+            endif
+            if (q(ig,k).lt.0.) then
+c               print*,'q<0!!!'
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+c             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+            wqd(ig,k)=fm(ig,k)*q(ig,k)
+            if (wqd(ig,k).lt.0.) then
+c               print*,'wqd<0!!!'
+            endif
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+     
+      do k=1,nlay
+         do ig=1,ngrid
+            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)
+     s               -wqd(ig,k)+wqd(ig,k+1))
+     s               /masse(ig,k)
+c            if (dq(ig,k).lt.0.) then
+c               print*,'dq<0!!!'
+c            endif
+         enddo
+      enddo
+
+      return
+      end
+      subroutine dvthermcell(ngrid,nlay,ptimestep,fm,entr,masse
+     .    ,fraca,larga
+     .    ,u,v,du,dv,ua,va)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real fraca(ngrid,nlay+1)
+      real larga(ngrid)
+      real entr(ngrid,nlay)
+      real u(ngrid,nlay)
+      real ua(ngrid,nlay)
+      real du(ngrid,nlay)
+      real v(ngrid,nlay)
+      real va(ngrid,nlay)
+      real dv(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev)
+      real wvd(klon,klev+1),wud(klon,klev+1)
+      real gamma0,gamma(klon,klev+1)
+      real dua,dva
+      integer iter
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         ua(ig,1)=u(ig,1)
+         va(ig,1)=v(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+c   On itère sur la valeur du coeff de freinage.
+c              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+               gamma0=masse(ig,k)
+     s         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )
+     s         *0.5/larga(ig)
+c              gamma0=0.
+c   la première fois on multiplie le coefficient de freinage
+c   par le module du vent dans la couche en dessous.
+               dua=ua(ig,k-1)-u(ig,k-1)
+               dva=va(ig,k-1)-v(ig,k-1)
+               do iter=1,5
+                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
+                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)
+     s               +(entr(ig,k)+gamma(ig,k))*u(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
+                  va(ig,k)=(fm(ig,k)*va(ig,k-1)
+     s               +(entr(ig,k)+gamma(ig,k))*v(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
+c                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
+                  dua=ua(ig,k)-u(ig,k)
+                  dva=va(ig,k)-v(ig,k)
+               enddo
+            else
+               ua(ig,k)=u(ig,k)
+               va(ig,k)=v(ig,k)
+               gamma(ig,k)=0.
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wud(ig,k)=fm(ig,k)*u(ig,k)
+            wvd(ig,k)=fm(ig,k)*v(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wud(ig,1)=0.
+         wud(ig,nlay+1)=0.
+         wvd(ig,1)=0.
+         wvd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*u(ig,k)
+     s               -wud(ig,k)+wud(ig,k+1))
+     s               /masse(ig,k)
+            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*v(ig,k)
+     s               -wvd(ig,k)+wvd(ig,k+1))
+     s               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
+      subroutine dqthermcell2(ngrid,nlay,ptimestep,fm,entr,masse,frac
+     .    ,q,dq,qa)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay),frac(ngrid,nlay)
+      real q(ngrid,nlay)
+      real dq(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
+      real qe(klon,klev),zf,zf2
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+         qe(ig,1)=q(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+               zf=0.5*(frac(ig,k)+frac(ig,k+1))
+               zf2=1./(1.-zf)
+               qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+zf2*entr(ig,k)*q(ig,k))
+     s         /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2)
+               qe(ig,k)=(q(ig,k)-zf*qa(ig,k))*zf2
+            else
+               qa(ig,k)=q(ig,k)
+               qe(ig,k)=q(ig,k)
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+c             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+            wqd(ig,k)=fm(ig,k)*qe(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*qe(ig,k)
+     s               -wqd(ig,k)+wqd(ig,k+1))
+     s               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
+      subroutine dvthermcell2(ngrid,nlay,ptimestep,fm,entr,masse
+     .    ,fraca,larga
+     .    ,u,v,du,dv,ua,va)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real fraca(ngrid,nlay+1)
+      real larga(ngrid)
+      real entr(ngrid,nlay)
+      real u(ngrid,nlay)
+      real ua(ngrid,nlay)
+      real du(ngrid,nlay)
+      real v(ngrid,nlay)
+      real va(ngrid,nlay)
+      real dv(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev),zf,zf2
+      real wvd(klon,klev+1),wud(klon,klev+1)
+      real gamma0,gamma(klon,klev+1)
+      real ue(klon,klev),ve(klon,klev)
+      real dua,dva
+      integer iter
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         ua(ig,1)=u(ig,1)
+         va(ig,1)=v(ig,1)
+         ue(ig,1)=u(ig,1)
+         ve(ig,1)=v(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+c   On itère sur la valeur du coeff de freinage.
+c              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+               gamma0=masse(ig,k)
+     s         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )
+     s         *0.5/larga(ig)
+     s         *1.
+c    s         *0.5
+c              gamma0=0.
+               zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
+               zf=0.
+               zf2=1./(1.-zf)
+c   la première fois on multiplie le coefficient de freinage
+c   par le module du vent dans la couche en dessous.
+               dua=ua(ig,k-1)-u(ig,k-1)
+               dva=va(ig,k-1)-v(ig,k-1)
+               do iter=1,5
+c   On choisit une relaxation lineaire.
+                  gamma(ig,k)=gamma0
+c   On choisit une relaxation quadratique.
+                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
+                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)
+     s               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2
+     s                 +gamma(ig,k))
+                  va(ig,k)=(fm(ig,k)*va(ig,k-1)
+     s               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2
+     s                 +gamma(ig,k))
+c                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
+                  dua=ua(ig,k)-u(ig,k)
+                  dva=va(ig,k)-v(ig,k)
+                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
+                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
+               enddo
+            else
+               ua(ig,k)=u(ig,k)
+               va(ig,k)=v(ig,k)
+               ue(ig,k)=u(ig,k)
+               ve(ig,k)=v(ig,k)
+               gamma(ig,k)=0.
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wud(ig,k)=fm(ig,k)*ue(ig,k)
+            wvd(ig,k)=fm(ig,k)*ve(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wud(ig,1)=0.
+         wud(ig,nlay+1)=0.
+         wvd(ig,1)=0.
+         wvd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)
+     s               -wud(ig,k)+wud(ig,k+1))
+     s               /masse(ig,k)
+            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)
+     s               -wvd(ig,k)+wvd(ig,k+1))
+     s               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
+      SUBROUTINE thermcell_sec(ngrid,nlay,ptimestep
+     s                  ,pplay,pplev,pphi,zlev
+     s                  ,pu,pv,pt,po
+     s                  ,pduadj,pdvadj,pdtadj,pdoadj
+     s                  ,fm0,entr0
+c    s                  ,pu_therm,pv_therm
+     s                  ,r_aspect,l_mix,w2di,tho)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c
+c   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+c
+c   le thermique est supposé homogène et dissipé par mélange avec
+c   son environnement. la longueur l_mix contrôle l'efficacité du
+c   mélange
+c
+c   Le calcul du transport des différentes espèces se fait en prenant
+c   en compte:
+c     1. un flux de masse montant
+c     2. un flux de masse descendant
+c     3. un entrainement
+c     4. un detrainement
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,w2di,tho
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+      integer idetr
+      save idetr
+      data idetr/3/
+
+c   local:
+c   ------
+
+      INTEGER ig,k,l,lmaxa(klon),lmix(klon)
+      real zsortie1d(klon)
+c CR: on remplace lmax(klon,klev+1)
+      INTEGER lmax(klon),lmin(klon),lentr(klon)
+      real linter(klon)
+      real zmix(klon), fracazmix(klon) 
+c RC 
+      real zmax(klon),zw,zz,zw2(klon,klev+1),ztva(klon,klev),zzz
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      REAL zh(klon,klev),zdhadj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      REAL wh(klon,klev+1)
+      real wu(klon,klev+1),wv(klon,klev+1),wo(klon,klev+1)
+      real zla(klon,klev+1)
+      real zwa(klon,klev+1)
+      real zld(klon,klev+1)
+      real zwd(klon,klev+1)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zha(klon,klev)
+      real wa_moy(klon,klev+1)
+      real fraca(klon,klev+1)
+      real fracc(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev)
+      common/comtherm/thetath2,wth2
+
+      real count_time
+      integer isplit,nsplit,ialt
+      parameter (nsplit=10)
+      data isplit/0/
+      save isplit
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+c     real wmax(klon,klev),wmaxa(klon)
+      real wmax(klon),wmaxa(klon)
+      real wa(klon,klev,klev+1)
+      real wd(klon,klev+1)
+      real larg_part(klon,klev,klev+1)
+      real fracd(klon,klev+1)
+      real xxx(klon,klev+1)
+      real larg_cons(klon,klev+1)
+      real larg_detr(klon,klev+1)
+      real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
+      real pu_therm(klon,klev),pv_therm(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev)
+      real fmc(klon,klev+1)
+
+cCR:nouvelles variables
+      real f_star(klon,klev+1),entr_star(klon,klev)
+      real entr_star_tot(klon),entr_star2(klon)
+      real f(klon), f0(klon)
+      real zlevinter(klon)
+      logical first
+      data first /.false./
+      save first
+cRC
+
+      character*2 str2
+      character*10 str10
+
+      LOGICAL vtest(klon),down
+
+      EXTERNAL SCOPY
+
+      integer ncorrec,ll
+      save ncorrec
+      data ncorrec/0/
+      
+c
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+       sorties=.true.
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+c
+c-----------------------------------------------------------------------
+c   incrementation eventuelle de tendances precedentes:
+c   ---------------------------------------------------
+
+c       print*,'0 OK convect8'
+
+      DO 1010 l=1,nlay
+         DO 1015 ig=1,ngrid
+            zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
+            zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zu(ig,l)=pu(ig,l)
+            zv(ig,l)=pv(ig,l)
+            zo(ig,l)=po(ig,l)
+            ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+1015     CONTINUE
+1010  CONTINUE
+
+c       print*,'1 OK convect8'
+c                       --------------------
+c
+c
+c                       + + + + + + + + + + +
+c
+c
+c  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+c  wh,wt,wo ...
+c
+c                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+c
+c
+c                       --------------------   zlev(1)
+c                       \\\\\\\\\\\\\\\\\\\\
+c
+c
+
+c-----------------------------------------------------------------------
+c   Calcul des altitudes des couches
+c-----------------------------------------------------------------------
+
+      do l=2,nlay
+         do ig=1,ngrid
+            zlev(ig,l)=0.5*(pphi(ig,l)+pphi(ig,l-1))/RG
+         enddo
+      enddo
+      do ig=1,ngrid
+         zlev(ig,1)=0.
+         zlev(ig,nlay+1)=(2.*pphi(ig,klev)-pphi(ig,klev-1))/RG
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid
+            zlay(ig,l)=pphi(ig,l)/RG
+         enddo
+      enddo
+
+c      print*,'2 OK convect8'
+c-----------------------------------------------------------------------
+c   Calcul des densites
+c-----------------------------------------------------------------------
+
+      do l=1,nlay
+         do ig=1,ngrid
+            rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            rhobarz(ig,l)=0.5*(rho(ig,l)+rho(ig,l-1))
+         enddo
+      enddo
+
+      do k=1,nlay
+         do l=1,nlay+1
+            do ig=1,ngrid
+               wa(ig,k,l)=0.
+            enddo
+         enddo
+      enddo
+
+c      print*,'3 OK convect8'
+c------------------------------------------------------------------
+c   Calcul de w2, quarre de w a partir de la cape
+c   a partir de w2, on calcule wa, vitesse de l'ascendance
+c
+c   ATTENTION: Dans cette version, pour cause d'economie de memoire,
+c   w2 est stoke dans wa
+c
+c   ATTENTION: dans convect8, on n'utilise le calcule des wa
+c   independants par couches que pour calculer l'entrainement
+c   a la base et la hauteur max de l'ascendance.
+c
+c   Indicages:
+c   l'ascendance provenant du niveau k traverse l'interface l avec
+c   une vitesse wa(k,l).
+c
+c                       --------------------
+c
+c                       + + + + + + + + + + 
+c
+c  wa(k,l)   ----       --------------------    l
+c             /\
+c            /||\       + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||
+c             ||        + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||__
+c             |___      + + + + + + + + + +     k
+c
+c                       --------------------
+c
+c
+c
+c------------------------------------------------------------------
+
+cCR: ponderation entrainement des couches instables
+cdef des entr_star tels que entr=f*entr_star      
+      do l=1,klev
+         do ig=1,ngrid 
+            entr_star(ig,l)=0.
+         enddo
+      enddo
+c determination de la longueur de la couche d entrainement
+      do ig=1,ngrid
+         lentr(ig)=1
+      enddo
+
+con ne considere que les premieres couches instables
+      do k=nlay-2,1,-1
+         do ig=1,ngrid
+            if (ztv(ig,k).gt.ztv(ig,k+1).and.
+     s          ztv(ig,k+1).le.ztv(ig,k+2)) then
+               lentr(ig)=k
+            endif
+          enddo
+      enddo
+    
+c determination du lmin: couche d ou provient le thermique
+      do ig=1,ngrid
+         lmin(ig)=1
+      enddo
+      do ig=1,ngrid
+         do l=nlay,2,-1
+            if (ztv(ig,l-1).gt.ztv(ig,l)) then
+               lmin(ig)=l-1
+            endif
+         enddo
+      enddo
+c
+c definition de l'entrainement des couches
+      do l=1,klev-1
+         do ig=1,ngrid 
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.
+     s          l.ge.lmin(ig).and.l.le.lentr(ig)) then 
+                 entr_star(ig,l)=(ztv(ig,l)-ztv(ig,l+1))*
+c     s                           (zlev(ig,l+1)-zlev(ig,l))
+     s                           *sqrt(zlev(ig,l+1))
+            endif
+         enddo
+      enddo
+c pas de thermique si couche 1 stable
+      do ig=1,ngrid
+         if (lmin(ig).gt.1) then
+            do l=1,klev
+               entr_star(ig,l)=0.
+            enddo
+         endif
+      enddo 
+c calcul de l entrainement total
+      do ig=1,ngrid
+         entr_star_tot(ig)=0.
+      enddo
+      do ig=1,ngrid
+         do k=1,klev
+            entr_star_tot(ig)=entr_star_tot(ig)+entr_star(ig,k)
+         enddo
+      enddo
+c
+c      print*,'fin calcul entr_star'
+      do k=1,klev
+         do ig=1,ngrid 
+            ztva(ig,k)=ztv(ig,k)
+         enddo
+      enddo
+cRC
+c      print*,'7 OK convect8'
+      do k=1,klev+1
+         do ig=1,ngrid
+            zw2(ig,k)=0.
+            fmc(ig,k)=0.
+cCR
+            f_star(ig,k)=0.
+cRC
+            larg_cons(ig,k)=0.
+            larg_detr(ig,k)=0.
+            wa_moy(ig,k)=0.
+         enddo
+      enddo
+
+c      print*,'8 OK convect8'
+      do ig=1,ngrid
+         linter(ig)=1.
+         lmaxa(ig)=1
+         lmix(ig)=1
+         wmaxa(ig)=0.
+      enddo
+
+cCR: 
+      do l=1,nlay-2
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1)
+     s         .and.entr_star(ig,l).gt.1.e-10
+     s         .and.zw2(ig,l).lt.1e-10) then
+               f_star(ig,l+1)=entr_star(ig,l)
+ctest:calcul de dteta
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+     s                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+               larg_detr(ig,l)=0.
+            else if ((zw2(ig,l).ge.1e-10).and.
+     s               (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)
+     s                    *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+
+     s                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+c determination de zmax continu par interpolation lineaire
+            if (zw2(ig,l+1).lt.0.) then
+ctest
+               if (abs(zw2(ig,l+1)-zw2(ig,l)).lt.1e-10) then
+c                  print*,'pb linter'
+               endif
+               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))
+     s           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+               lmaxa(ig)=l
+            else
+               if (zw2(ig,l+1).lt.0.) then
+c                  print*,'pb1 zw2<0'
+               endif
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+            endif
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+c   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
+c      print*,'fin calcul zw2'
+c
+c 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
+c pas de thermique si couche 1 stable
+      do ig=1,ngrid
+         if (lmin(ig).gt.1) then
+            lmax(ig)=1
+            lmin(ig)=1
+         endif
+      enddo 
+c    
+c 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
+c                  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
+
+c   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
+c calcul de zlevinter
+          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*
+     s    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)
+     s    -zlev(ig,lmax(ig)))
+       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+      enddo
+
+c      print*,'avant fermeture'
+c Fermeture,determination de f
+      do ig=1,ngrid
+         entr_star2(ig)=0.
+      enddo
+      do ig=1,ngrid
+         if (entr_star_tot(ig).LT.1.e-10) then
+            f(ig)=0.
+         else
+             do k=lmin(ig),lentr(ig)
+                entr_star2(ig)=entr_star2(ig)+entr_star(ig,k)**2
+     s                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+             enddo
+c Nouvelle fermeture
+             f(ig)=wmax(ig)/(max(500.,zmax(ig))*r_aspect
+     s             *entr_star2(ig))*entr_star_tot(ig)
+ctest
+c             if (first) then
+c             f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
+c     s             *wmax(ig))
+c             endif
+         endif
+c         f0(ig)=f(ig)
+c         first=.true.
+      enddo
+c      print*,'apres fermeture'
+
+c Calcul de l'entrainement
+       do k=1,klev
+         do ig=1,ngrid 
+            entr(ig,k)=f(ig)*entr_star(ig,k)
+         enddo
+      enddo
+cCR:test pour entrainer moins que la masse
+       do ig=1,ngrid
+          do l=1,lentr(ig)
+             if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
+                entr(ig,l+1)=entr(ig,l+1)+entr(ig,l)
+     s                       -0.9*masse(ig,l)/ptimestep
+                entr(ig,l)=0.9*masse(ig,l)/ptimestep
+             endif
+          enddo
+       enddo
+cCR: fin test
+c Calcul des flux
+      do ig=1,ngrid
+         do l=1,lmax(ig)-1
+            fmc(ig,l+1)=fmc(ig,l)+entr(ig,l)
+         enddo
+      enddo
+
+cRC
+
+
+c      print*,'9 OK convect8'
+c     print*,'WA1 ',wa_moy
+
+c   determination de l'indice du debut de la mixed layer ou w decroit
+
+c   calcul de la largeur de chaque ascendance dans le cas conservatif.
+c   dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+c   d'une couche est égale à la hauteur de la couche alimentante.
+c   La vitesse maximale dans l'ascendance est aussi prise comme estimation
+c   de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+               zw=max(wa_moy(ig,l),1.e-10)
+               larg_cons(ig,l)=zmax(ig)*r_aspect
+     s         *fmc(ig,l)/(rhobarz(ig,l)*zw)
+            endif
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+c              if (idetr.eq.0) then
+c  cette option est finalement en dur.
+                  if ((l_mix*zlev(ig,l)).lt.0.)then
+c                   print*,'pb l_mix*zlev<0'
+                  endif
+cCR: test: nouvelle def de lambda
+c                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+                  if (zw2(ig,l).gt.1.e-10) then
+                  larg_detr(ig,l)=sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
+                  else
+                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+                  endif
+cRC
+c              else if (idetr.eq.1) then
+c                 larg_detr(ig,l)=larg_cons(ig,l)
+c    s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+c              else if (idetr.eq.2) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *sqrt(wa_moy(ig,l))
+c              else if (idetr.eq.4) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *wa_moy(ig,l)
+c              endif
+            endif
+         enddo
+       enddo
+
+c      print*,'10 OK convect8'
+c     print*,'WA2 ',wa_moy
+c   calcul de la fraction de la maille concernée par l'ascendance en tenant
+c   compte de l'epluchage du thermique.
+c
+cCR def de  zmix continu (profil parabolique des vitesses)
+      do ig=1,ngrid
+           if (lmix(ig).gt.1.) then
+c test 
+              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)
+     s        then
+c             
+            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))
+     s        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+            else
+            zmix(ig)=zlev(ig,lmix(ig))
+c            print*,'pb zmix'
+            endif
+         else 
+         zmix(ig)=0.
+         endif
+ctest
+         if ((zmax(ig)-zmix(ig)).lt.0.) then
+            zmix(ig)=0.99*zmax(ig)
+c            print*,'pb zmix>zmax'
+         endif
+      enddo
+c
+c calcul du nouveau lmix correspondant
+      do ig=1,ngrid
+         do l=1,klev
+            if (zmix(ig).ge.zlev(ig,l).and.
+     s          zmix(ig).lt.zlev(ig,l+1)) then
+              lmix(ig)=l
+             endif
+          enddo
+      enddo
+c
+      do l=2,nlay
+         do ig=1,ngrid
+            if(larg_cons(ig,l).gt.1.) then
+c     print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+               fraca(ig,l)=(larg_cons(ig,l)-larg_detr(ig,l))
+     s            /(r_aspect*zmax(ig))
+c test
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+            else
+c              wa_moy(ig,l)=0.
+               fraca(ig,l)=0.
+               fracc(ig,l)=0.
+               fracd(ig,l)=1.
+            endif
+         enddo
+      enddo                  
+cCR: calcul de fracazmix
+       do ig=1,ngrid
+          fracazmix(ig)=(fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/
+     s     (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig)
+     s    +fraca(ig,lmix(ig))-zlev(ig,lmix(ig))*(fraca(ig,lmix(ig)+1)
+     s    -fraca(ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+       enddo
+c
+       do l=2,nlay
+          do ig=1,ngrid
+             if(larg_cons(ig,l).gt.1.) then
+               if (l.gt.lmix(ig)) then
+ctest
+                 if (zmax(ig)-zmix(ig).lt.1.e-10) then
+c                   print*,'pb xxx'
+                   xxx(ig,l)=(lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
+                 else
+                 xxx(ig,l)=(zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+                 endif
+           if (idetr.eq.0) then
+               fraca(ig,l)=fracazmix(ig)
+           else if (idetr.eq.1) then
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)
+           else if (idetr.eq.2) then
+               fraca(ig,l)=fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+           else
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)**2
+           endif
+c     print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+             endif
+            endif
+         enddo
+      enddo
+      
+c      print*,'fin calcul fraca'
+c      print*,'11 OK convect8'
+c     print*,'Ea3 ',wa_moy
+c------------------------------------------------------------------
+c   Calcul de fracd, wd
+c   somme wa - wd = 0
+c------------------------------------------------------------------
+
+
+      do ig=1,ngrid
+         fm(ig,1)=0.
+         fm(ig,nlay+1)=0.
+      enddo
+
+      do l=2,nlay
+           do ig=1,ngrid
+              fm(ig,l)=fraca(ig,l)*wa_moy(ig,l)*rhobarz(ig,l)
+cCR:test
+              if (entr(ig,l-1).lt.1e-10.and.fm(ig,l).gt.fm(ig,l-1)
+     s            .and.l.gt.lmix(ig)) then
+                 fm(ig,l)=fm(ig,l-1)
+c                 write(1,*)'ajustement fm, l',l
+              endif
+c              write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+cRC
+           enddo
+         do ig=1,ngrid
+            if(fracd(ig,l).lt.0.1) then
+               stop'fracd trop petit'
+            else
+c    vitesse descendante "diagnostique"
+               wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l))
+            endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+c           masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+            masse(ig,l)=(pplev(ig,l)-pplev(ig,l+1))/RG
+         enddo
+      enddo
+
+c      print*,'12 OK convect8'
+c     print*,'WA4 ',wa_moy
+cc------------------------------------------------------------------
+c   calcul du transport vertical
+c------------------------------------------------------------------
+
+      go to 4444
+c     print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+      do l=2,nlay-1
+         do ig=1,ngrid
+            if(fm(ig,l+1)*ptimestep.gt.masse(ig,l)
+     s      .and.fm(ig,l+1)*ptimestep.gt.masse(ig,l+1)) then
+c     print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+c    s         ,fm(ig,l+1)*ptimestep
+c    s         ,'   M=',masse(ig,l),masse(ig,l+1)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(entr(ig,l)*ptimestep.gt.masse(ig,l)) then
+c     print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+c    s         ,entr(ig,l)*ptimestep
+c    s         ,'   M=',masse(ig,l)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(.not.fm(ig,l).ge.0..or..not.fm(ig,l).le.10.) then
+c     print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+c    s         ,'   FM=',fm(ig,l)
+            endif
+            if(.not.masse(ig,l).ge.1.e-10
+     s         .or..not.masse(ig,l).le.1.e4) then
+c     print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+c    s         ,'   M=',masse(ig,l)
+c     print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+c    s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+c     print*,'zlev(ig,l+1),zlev(ig,l)'
+c    s                ,zlev(ig,l+1),zlev(ig,l)
+c     print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+c    s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+            endif
+            if(.not.entr(ig,l).ge.0..or..not.entr(ig,l).le.10.) then
+c     print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+c    s         ,'   E=',entr(ig,l)
+            endif
+         enddo
+      enddo
+
+4444   continue
+
+cCR:redefinition du entr
+       do l=1,nlay
+         do ig=1,ngrid
+            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+            if (detr(ig,l).lt.0.) then
+                entr(ig,l)=entr(ig,l)-detr(ig,l)
+                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+            endif
+         enddo
+      enddo
+cRC
+      if (w2di.eq.1) then
+         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+      else
+         fm0=fm
+         entr0=entr
+      endif
+
+      if (1.eq.1) then
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zh,zdhadj,zha)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zo,pdoadj,zoa)
+      else
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zh,zdhadj,zha)
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zo,pdoadj,zoa)
+      endif
+
+      if (1.eq.0) then
+         call dvthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,fraca,zmax
+     .    ,zu,zv,pduadj,pdvadj,zua,zva)
+      else
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zu,pduadj,zua)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zv,pdvadj,zva)
+      endif
+
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
+            zf2=zf/(1.-zf)
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
+            wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+         enddo
+      enddo
+
+
+
+c     print*,'13 OK convect8'
+c     print*,'WA5 ',wa_moy
+      do l=1,nlay
+         do ig=1,ngrid
+            pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+         enddo
+      enddo
+
+
+c     do l=1,nlay
+c        do ig=1,ngrid
+c           if(abs(pdtadj(ig,l))*86400..gt.500.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdtadj=',pdtadj(ig,l)
+c           endif
+c           if(abs(pdoadj(ig,l))*86400..gt.1.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdoadj=',pdoadj(ig,l)
+c           endif
+c        enddo
+c      enddo
+
+c      print*,'14 OK convect8'
+c------------------------------------------------------------------
+c   Calculs pour les sorties
+c------------------------------------------------------------------
+
+      if(sorties) then
+      do l=1,nlay
+         do ig=1,ngrid
+            zla(ig,l)=(1.-fracd(ig,l))*zmax(ig)
+            zld(ig,l)=fracd(ig,l)*zmax(ig)
+            if(1.-fracd(ig,l).gt.1.e-10)
+     s      zwa(ig,l)=wd(ig,l)*fracd(ig,l)/(1.-fracd(ig,l))
+         enddo
+      enddo
+
+cdeja fait
+c      do l=1,nlay
+c         do ig=1,ngrid
+c            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+c            if (detr(ig,l).lt.0.) then
+c                entr(ig,l)=entr(ig,l)-detr(ig,l)
+c                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+c            endif
+c         enddo
+c      enddo
+
+c     print*,'15 OK convect8'
+
+      isplit=isplit+1
+
+
+c #define und
+	goto 123
+#ifdef und
+      CALL writeg1d(1,nlay,wd,'wd      ','wd      ')
+      CALL writeg1d(1,nlay,zwa,'wa      ','wa      ')
+      CALL writeg1d(1,nlay,fracd,'fracd      ','fracd      ')
+      CALL writeg1d(1,nlay,fraca,'fraca      ','fraca      ')
+      CALL writeg1d(1,nlay,wa_moy,'wam         ','wam         ')
+      CALL writeg1d(1,nlay,zla,'la      ','la      ')
+      CALL writeg1d(1,nlay,zld,'ld      ','ld      ')
+      CALL writeg1d(1,nlay,pt,'pt      ','pt      ')
+      CALL writeg1d(1,nlay,zh,'zh      ','zh      ')
+      CALL writeg1d(1,nlay,zha,'zha      ','zha      ')
+      CALL writeg1d(1,nlay,zu,'zu      ','zu      ')
+      CALL writeg1d(1,nlay,zv,'zv      ','zv      ')
+      CALL writeg1d(1,nlay,zo,'zo      ','zo      ')
+      CALL writeg1d(1,nlay,wh,'wh      ','wh      ')
+      CALL writeg1d(1,nlay,wu,'wu      ','wu      ')
+      CALL writeg1d(1,nlay,wv,'wv      ','wv      ')
+      CALL writeg1d(1,nlay,wo,'w15uo     ','wXo     ')
+      CALL writeg1d(1,nlay,zdhadj,'zdhadj      ','zdhadj      ')
+      CALL writeg1d(1,nlay,pduadj,'pduadj      ','pduadj      ')
+      CALL writeg1d(1,nlay,pdvadj,'pdvadj      ','pdvadj      ')
+      CALL writeg1d(1,nlay,pdoadj,'pdoadj      ','pdoadj      ')
+      CALL writeg1d(1,nlay,entr  ,'entr        ','entr        ')
+      CALL writeg1d(1,nlay,detr  ,'detr        ','detr        ')
+      CALL writeg1d(1,nlay,fm    ,'fm          ','fm          ')
+
+      CALL writeg1d(1,nlay,pdtadj,'pdtadj    ','pdtadj    ')
+      CALL writeg1d(1,nlay,pplay,'pplay     ','pplay     ')
+      CALL writeg1d(1,nlay,pplev,'pplev     ','pplev     ')
+
+c   recalcul des flux en diagnostique...
+c     print*,'PAS DE TEMPS ',ptimestep
+       call dt2F(pplev,pplay,pt,pdtadj,wh)
+      CALL writeg1d(1,nlay,wh,'wh2     ','wh2     ')
+#endif
+123   continue
+! #define troisD
+#ifdef troisD
+c       if (sorties) then
+      print*,'Debut des wrgradsfi'
+
+c      print*,'16 OK convect8'
+         call wrgradsfi(1,nlay,wd,'wd        ','wd        ')
+         call wrgradsfi(1,nlay,zwa,'wa        ','wa        ')
+         call wrgradsfi(1,nlay,fracd,'fracd     ','fracd     ')
+         call wrgradsfi(1,nlay,fraca,'fraca     ','fraca     ')
+         call wrgradsfi(1,nlay,xxx,'xxx       ','xxx       ')
+         call wrgradsfi(1,nlay,wa_moy,'wam       ','wam       ')
+c      print*,'WA6 ',wa_moy
+         call wrgradsfi(1,nlay,zla,'la        ','la        ')
+         call wrgradsfi(1,nlay,zld,'ld        ','ld        ')
+         call wrgradsfi(1,nlay,pt,'pt        ','pt        ')
+         call wrgradsfi(1,nlay,zh,'zh        ','zh        ')
+         call wrgradsfi(1,nlay,zha,'zha        ','zha        ')
+         call wrgradsfi(1,nlay,zua,'zua        ','zua        ')
+         call wrgradsfi(1,nlay,zva,'zva        ','zva        ')
+         call wrgradsfi(1,nlay,zu,'zu        ','zu        ')
+         call wrgradsfi(1,nlay,zv,'zv        ','zv        ')
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,wh,'wh        ','wh        ')
+         call wrgradsfi(1,nlay,wu,'wu        ','wu        ')
+         call wrgradsfi(1,nlay,wv,'wv        ','wv        ')
+         call wrgradsfi(1,nlay,wo,'wo        ','wo        ')
+         call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+         call wrgradsfi(1,nlay,zdhadj,'zdhadj    ','zdhadj    ')
+         call wrgradsfi(1,nlay,pduadj,'pduadj    ','pduadj    ')
+         call wrgradsfi(1,nlay,pdvadj,'pdvadj    ','pdvadj    ')
+         call wrgradsfi(1,nlay,pdoadj,'pdoadj    ','pdoadj    ')
+         call wrgradsfi(1,nlay,entr,'entr      ','entr      ')
+         call wrgradsfi(1,nlay,detr,'detr      ','detr      ')
+         call wrgradsfi(1,nlay,fm,'fm        ','fm        ')
+         call wrgradsfi(1,nlay,fmc,'fmc       ','fmc       ')
+         call wrgradsfi(1,nlay,zw2,'zw2       ','zw2       ')
+         call wrgradsfi(1,nlay,ztva,'ztva      ','ztva      ')
+         call wrgradsfi(1,nlay,ztv,'ztv       ','ztv       ')
+
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,larg_cons,'Lc        ','Lc        ')
+         call wrgradsfi(1,nlay,larg_detr,'Ldetr     ','Ldetr     ')
+
+cCR:nouveaux diagnostiques
+      call wrgradsfi(1,nlay,entr_star  ,'entr_star   ','entr_star   ')     
+      call wrgradsfi(1,nlay,f_star    ,'f_star   ','f_star   ')
+      call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+      call wrgradsfi(1,1,zmix,'zmix      ','zmix      ') 
+      zsortie1d(:)=lmax(:)
+      call wrgradsfi(1,1,zsortie1d,'lmax      ','lmax      ')
+      call wrgradsfi(1,1,wmax,'wmax      ','wmax      ')
+      zsortie1d(:)=lmix(:)
+      call wrgradsfi(1,1,zsortie1d,'lmix      ','lmix      ')
+      zsortie1d(:)=lentr(:)
+      call wrgradsfi(1,1,zsortie1d,'lentr      ','lentr     ')
+
+c      print*,'17 OK convect8'
+
+         do k=1,klev/10
+            write(str2,'(i2.2)') k
+            str10='wa'//str2
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=wa(ig,k,l)
+               enddo
+            enddo   
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=larg_part(ig,k,l)
+               enddo
+            enddo
+            str10='la'//str2
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+         enddo
+
+
+c     print*,'18 OK convect8'
+c      endif
+      print*,'Fin des wrgradsfi'
+#endif
+
+      endif
+
+c     if(wa_moy(1,4).gt.1.e-10) stop
+
+c      print*,'19 OK convect8'
+      return
+      end
+
Index: LMDZ4/trunk/libf/phylmd/thermcell_out1d.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_out1d.h	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_out1d.h	(revision 878)
@@ -0,0 +1,23 @@
+      CALL writeg1d(1,nlay,fraca,'fraca      ','fraca      ')
+      CALL writeg1d(1,nlay,pt,'pt      ','pt      ')
+      CALL writeg1d(1,nlay,zh,'zh      ','zh      ')
+      CALL writeg1d(1,nlay,zha,'zha      ','zha      ')
+      CALL writeg1d(1,nlay,zu,'zu      ','zu      ')
+      CALL writeg1d(1,nlay,zv,'zv      ','zv      ')
+      CALL writeg1d(1,nlay,zo,'zo      ','zo      ')
+      CALL writeg1d(1,nlay,zdhadj,'zdhadj      ','zdhadj      ')
+      CALL writeg1d(1,nlay,pduadj,'pduadj      ','pduadj      ')
+      CALL writeg1d(1,nlay,pdvadj,'pdvadj      ','pdvadj      ')
+      CALL writeg1d(1,nlay,pdoadj,'pdoadj      ','pdoadj      ')
+      CALL writeg1d(1,nlay,entr  ,'entr        ','entr        ')
+      CALL writeg1d(1,nlay,detr  ,'detr        ','detr        ')
+      CALL writeg1d(1,nlay,fm    ,'fm          ','fm          ')
+
+      CALL writeg1d(1,nlay,pdtadj,'pdtadj    ','pdtadj    ')
+      CALL writeg1d(1,nlay,pplay,'pplay     ','pplay     ')
+      CALL writeg1d(1,nlay,pplev,'pplev     ','pplev     ')
+
+!   recalcul des flux en diagnostique...
+!     print*,'PAS DE TEMPS ',ptimestep
+!       call dt2F(pplev,pplay,pt,pdtadj,wh)
+!      CALL writeg1d(1,nlay,wh,'wh2     ','wh2     ')
Index: LMDZ4/trunk/libf/phylmd/thermcell_out3d.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_out3d.h	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_out3d.h	(revision 878)
@@ -0,0 +1,72 @@
+!       if (sorties) then
+      print*,'Debut des wrgradsfi'
+
+!      print*,'16 OK convect8'
+         call wrgradsfi(1,nlay,fraca,'fraca     ','fraca     ')
+         call wrgradsfi(1,nlay,pt,'pt        ','pt        ')
+         call wrgradsfi(1,nlay,zh,'zh        ','zh        ')
+         call wrgradsfi(1,nlay,zha,'zha        ','zha        ')
+         call wrgradsfi(1,nlay,zua,'zua        ','zua        ')
+         call wrgradsfi(1,nlay,zva,'zva        ','zva        ')
+         call wrgradsfi(1,nlay,zu,'zu        ','zu        ')
+         call wrgradsfi(1,nlay,zv,'zv        ','zv        ')
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+         call wrgradsfi(1,nlay,zdhadj,'zdhadj    ','zdhadj    ')
+         call wrgradsfi(1,nlay,pduadj,'pduadj    ','pduadj    ')
+         call wrgradsfi(1,nlay,pdvadj,'pdvadj    ','pdvadj    ')
+         call wrgradsfi(1,nlay,pdoadj,'pdoadj    ','pdoadj    ')
+         call wrgradsfi(1,nlay,entr,'entr      ','entr      ')
+         call wrgradsfi(1,nlay,detr,'detr      ','detr      ')
+         call wrgradsfi(1,nlay,fm,'fm        ','fm        ')
+         call wrgradsfi(1,nlay,zw2,'zw2       ','zw2       ')
+         call wrgradsfi(1,nlay,w_est,'w_est      ','w_est      ')
+!on sort les moments
+         call wrgradsfi(1,nlay,thetath2,'zh2       ','zh2       ')
+         call wrgradsfi(1,nlay,wth2,'w2       ','w2       ')
+         call wrgradsfi(1,nlay,wth3,'w3       ','w3       ')
+         call wrgradsfi(1,nlay,q2,'q2       ','q2       ')
+!
+         call wrgradsfi(1,nlay,ztva,'ztva      ','ztva      ')
+         call wrgradsfi(1,nlay,ztv,'ztv       ','ztv       ')
+
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,zoa,'zoa        ','zoa        ')
+
+!nouveaux diagnostiques
+         call wrgradsfi(1,nlay,zthl,'zthl        ','zthl        ')
+         call wrgradsfi(1,nlay,zta,'zta        ','zta        ')
+         call wrgradsfi(1,nlay,zl,'zl        ','zl        ')
+         call wrgradsfi(1,nlay,zdthladj,'zdthladj    ',  &
+     &        'zdthladj    ')
+         call wrgradsfi(1,nlay,ztla,'ztla      ','ztla      ')
+         call wrgradsfi(1,nlay,zqta,'zqta      ','zqta      ')
+         call wrgradsfi(1,nlay,zqla,'zqla      ','zqla      ')
+         call wrgradsfi(1,nlay,deltaz,'deltaz      ','deltaz      ')
+!nouveaux diagnostiques
+      call wrgradsfi(1,nlay,entr_star  ,'entr_star   ','entr_star   ')
+      call wrgradsfi(1,nlay,detr_star  ,'detr_star   ','detr_star   ')     
+      call wrgradsfi(1,nlay,f_star    ,'f_star   ','f_star   ')
+      call wrgradsfi(1,nlay,zqsat    ,'zqsat   ','zqsat   ')
+      call wrgradsfi(1,nlay,zqsatth    ,'qsath   ','qsath   ')
+      call wrgradsfi(1,nlay,alim_star    ,'alim_star   ','alim_star   ')
+      call wrgradsfi(1,nlay,alim    ,'alim   ','alim   ')
+      call wrgradsfi(1,1,f,'f      ','f      ')
+      call wrgradsfi(1,1,alim_star_tot,'a_s_t      ','a_s_t      ')
+      call wrgradsfi(1,1,alim_star2,'a_2      ','a_2      ')
+      call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+      call wrgradsfi(1,1,zmax_sec,'z_sec      ','z_sec      ')
+      call wrgradsfi(1,1,zmix,'zmix      ','zmix      ') 
+      call wrgradsfi(1,1,nivcon,'nivcon      ','nivcon      ')
+      call wrgradsfi(1,1,zcon,'zcon      ','zcon      ')
+      call wrgradsfi(1,1,zcon2,'zcon2      ','zcon2      ')
+      zsortie1d(:)=lmax(:)
+      call wrgradsfi(1,1,zsortie1d,'lmax      ','lmax      ')
+      call wrgradsfi(1,1,wmax,'wmax      ','wmax      ')
+      call wrgradsfi(1,1,wmax_sec,'w_sec      ','w_sec      ')
+      zsortie1d(:)=lmix(:)
+      call wrgradsfi(1,1,zsortie1d,'lmix      ','lmix      ')
+      zsortie1d(:)=lentr(:)
+      call wrgradsfi(1,1,zsortie1d,'lentr      ','lentr     ')
+
+      print*,'Fin des wrgradsfi'
Index: LMDZ4/trunk/libf/phylmd/thermcell_plume.F90
===================================================================
--- LMDZ4/trunk/libf/phylmd/thermcell_plume.F90	(revision 878)
+++ LMDZ4/trunk/libf/phylmd/thermcell_plume.F90	(revision 878)
@@ -0,0 +1,386 @@
+      SUBROUTINE thermcell_plume(ngrid,klev,ztv,zthl,po,zl,rhobarz,  &
+     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,  &
+     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
+     &           ztla,zqla,zqta,zha,zw2,zqsatth,lmix,linter,lev_out)
+
+!--------------------------------------------------------------------------
+!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
+!--------------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+
+      INTEGER ngrid,klev
+      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 ztva(ngrid,klev)
+      REAL ztla(ngrid,klev)
+      REAL zqla(ngrid,klev)
+      REAL zqta(ngrid,klev)
+      REAL zha(ngrid,klev)
+
+      REAL detr_star(ngrid,klev)
+      REAL entr_star(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 linter(ngrid)
+      INTEGER lmix(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
+
+      Zsat=.false.
+! Initialisation
+      RLvCp = RLVTT/RCPD
+     
+      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
+
+!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)
+         enddo
+      enddo 
+      do k=1,klev
+        do ig=1,ngrid
+           detr_star(ig,k)=0.
+           entr_star(ig,k)=0.
+           detr(ig,k)=0.
+           entr(ig,k)=0.
+        enddo
+      enddo
+      if (lev_out.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 (lev_out.ge.1) print*,'8 OK convect8'
+      do ig=1,ngrid
+         linter(ig)=1.
+         lmix(ig)=1
+         wmaxa(ig)=0.
+      enddo
+
+!-----------------------------------------------------------------------------------
+!boucle de calcul de la vitesse verticale dans le thermique
+!-----------------------------------------------------------------------------------
+      do l=1,klev-1
+         do ig=1,ngrid
+            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
+               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
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      if (l.gt.2) 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) &
+     &      *(zlev(ig,3)-zlev(ig,2))
+
+
+!---------------------------------------------------------------------------
+!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)
+        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)  &
+     &                   *(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
+          if ((w_est(ig,l+1).gt.w_est(ig,l)).and.  &
+     &       (zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
+     &       (zqla(ig,l-1).lt.1.e-10)) 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 (lev_out.ge.20) print*,'coucou calcul detr 1'
+          else if ((zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
+     &            (zqla(ig,l-1).lt.1.e-10)) 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 (lev_out.ge.20) print*,'coucou calcul detr 2'
+          else
+             detr_star(ig,l)=0.002*f0(ig)*f_star(ig,l)  &
+     &                      *(zlev(ig,l+1)-zlev(ig,l))
+        if (lev_out.ge.20) print*,'coucou calcul detr 3'
+             
+          endif
+          detr_star(ig,l)=detr_star(ig,l)/f0(ig)
+!
+!calcul de entr_star
+!
+! 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(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.
+         entr_star(ig,l)=max(detr_star(ig,l)-alim_star(ig,l),0.)
+         detr_star(ig,l)=entr_star(ig,l)
+        endif
+
+!
+        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)
+           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)=detr_star(ig,l)
+            endif
+        endif
+
+      else
+         detr_star(ig,l)=0.
+         entr_star(ig,l)=0.
+      endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 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 (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
+!    
+! 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)  &
+     &                 /(f_star(ig,l+1)+detr_star(ig,l))**2+             &
+     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+     &                 *(zlev(ig,l+1)-zlev(ig,l))
+               
+            endif
+        endif
+!
+!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+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
+            lmix(ig)=l+1
+            wmaxa(ig)=wa_moy(ig,l+1)
+        endif
+        enddo
+      enddo
+
+
+      return 
+      end
Index: LMDZ4/trunk/libf/phylmd/write_histISCCP.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/write_histISCCP.h	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/write_histISCCP.h	(revision 878)
@@ -20,5 +20,5 @@
 cIM: champ 3d : (lon,lat,pres) pour un tau fixe
 c
-       CALL histwrite_phy(nid_isccp,"cldISCCP_"//taulev(k)//verticaxe(n),
+      CALL histwrite_phy(nid_isccp,"cldISCCP_"//taulev(k)//verticaxe(n),
      .                  itau_w,zx_tmp_fi3d)
         ENDDO !k
Index: LMDZ4/trunk/libf/phylmd/write_histday.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/write_histday.h	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/write_histday.h	(revision 878)
@@ -30,4 +30,9 @@
      &                   pctsrf_new(:,is_ter))
 c
+
+      CALL histwrite_phy(nid_day,"dthmin",itau_w,dthmin)
+      CALL histwrite_phy(nid_day,"weakinv",itau_w,weak_inversion)
+
+
 cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
       CALL histwrite_phy(nid_day,"tsol",itau_w,zxtsol)
@@ -486,4 +491,14 @@
      $                     zx_tmp_fi2d) 
 C 
+! FH Sorties specifiques pour Mellor et Yamada
+      if (iflag_pbl>1 .and. lev_histday.gt.10 ) then
+
+        CALL histwrite_phy(nid_day,"tke_"//clnsurf(nsrf),itau_w,
+     $      pbl_tke(:,1:klev,nsrf))
+
+        CALL histwrite_phy(nid_day,"tke_max_"//clnsurf(nsrf),itau_w,
+     $      pbl_tke(:,1:klev,nsrf))
+	endif
+
       END DO  
 c=================================================================
Index: LMDZ4/trunk/libf/phylmd/write_histmth.h
===================================================================
--- LMDZ4/trunk/libf/phylmd/write_histmth.h	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/write_histmth.h	(revision 878)
@@ -681,4 +681,22 @@
       IF(lev_histmth.GE.4) THEN
 c
+c  FH Sorties pour la couche limite
+      CALL histwrite_phy(nid_mth,"kz",itau_w,ycoefh)
+      CALL histwrite_phy(nid_mth,"kz_max",itau_w,ycoefh)
+
+      if(iflag_pbl>1) then
+      zx_tmp_fi3d=0.
+      do nsrf=1,nbsrf
+         do k=1,klev
+          zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k)
+     ,    +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
+         enddo
+      enddo
+      CALL histwrite_phy(nid_mth,"tke",itau_w,zx_tmp_fi3d)
+      CALL histwrite_phy(nid_mth,"tke_max",itau_w,zx_tmp_fi3d)
+      endif
+
+
+
 cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, clwcon0, zx_tmp_3d)
       CALL histwrite_phy(nid_mth,"clwcon",itau_w,clwcon0)
@@ -757,11 +775,20 @@
 c
 cIM: 101003 : K/30min ==> K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
+cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      CALL histwrite_phy(nid_mth,"dtajs",itau_w,zx_tmp_fi3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
+cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      CALL histwrite_phy(nid_mth,"dqajs",itau_w,zx_tmp_fi3d)
+c
+cIM: 101003 : K/30min ==> K/s
       zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)/pdtphys
 cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite_phy(nid_mth,"dtajs",itau_w,zx_tmp_fi3d)
+      CALL histwrite_phy(nid_mth,"dtthe",itau_w,zx_tmp_fi3d)
 c
       zx_tmp_fi3d(1:klon,1:klev)=d_q_ajs(1:klon,1:klev)/pdtphys
 cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite_phy(nid_mth,"dqajs",itau_w,zx_tmp_fi3d)
+      CALL histwrite_phy(nid_mth,"dqthe",itau_w,zx_tmp_fi3d)
 c
 cIM: 101003 : K/day ==> K/s
@@ -951,13 +978,8 @@
       CALL histwrite_phy(nid_mth,"dtcon",itau_w,zx_tmp_fi3d)
 c
-c temperature tendency due to dry convective processes
-       DO l=1, klev
-       DO i=1, klon
-        zx_tmp_fi3d(i,l)=d_t_ajs(i,l)/pdtphys
-       ENDDO !i
-       ENDDO !l
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite_phy(nid_mth,"dtajs",itau_w,zx_tmp_fi3d)
+
+
+
+
 c
 c  temperature tendency due to large scale precipitation
@@ -1690,4 +1712,22 @@
       IF(lev_histmth.GE.4) THEN
 c
+c  FH Sorties pour la couche limite
+      CALL histwrite_phy(nid_mth,"kz",itau_w,ycoefh)
+      CALL histwrite_phy(nid_mth,"kz_max",itau_w,ycoefh)
+
+      if(iflag_pbl>1) then
+      zx_tmp_fi3d=0.
+      do nsrf=1,nbsrf
+         do k=1,klev
+          zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k)
+     ,    +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
+         enddo
+      enddo
+      CALL histwrite_phy(nid_mth,"tke",itau_w,zx_tmp_fi3d)
+      CALL histwrite_phy(nid_mth,"tke_max",itau_w,zx_tmp_fi3d)
+      endif
+
+
+
 cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, clwcon0, zx_tmp_3d)
       CALL histwrite_phy(nid_mth,"clwcon",itau_w,clwcon0)
@@ -1756,8 +1796,22 @@
 cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
       CALL histwrite_phy(nid_mth,"ratqs",itau_w,ratqs)
+cIM: 101003 : K/30min ==> K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
+cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      CALL histwrite_phy(nid_mth,"dtajs",itau_w,zx_tmp_fi3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
+cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      CALL histwrite_phy(nid_mth,"dqajs",itau_w,zx_tmp_fi3d)
+c
+cIM: 101003 : K/30min ==> K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)/pdtphys
+cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      CALL histwrite_phy(nid_mth,"dtthe",itau_w,zx_tmp_fi3d)
 c
       zx_tmp_fi3d(1:klon,1:klev)=d_q_ajs(1:klon,1:klev)/pdtphys
 cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite_phy(nid_mth,"dqajs",itau_w,zx_tmp_fi3d)
+      CALL histwrite_phy(nid_mth,"dqthe",itau_w,zx_tmp_fi3d)
+c
 c
 cIM: 101003 : K/day ==> K/s
Index: LMDZ4/trunk/libf/phylmd/yamada4.F
===================================================================
--- LMDZ4/trunk/libf/phylmd/yamada4.F	(revision 868)
+++ LMDZ4/trunk/libf/phylmd/yamada4.F	(revision 878)
@@ -429,5 +429,5 @@
                                                           enddo
 
-       print*,'pblhmin ',pblhmin
+!      print*,'pblhmin ',pblhmin
 CTest a remettre 21 11 02
 c test abd 13 05 02      if(0.eq.1) then
@@ -458,20 +458,28 @@
 c   Diagnostique pour stokage
 
+      if(1.eq.0)then
       rino=rif
-      smyam(:,1:klev)=sm(:,1:klev)
-      styam=sm(:,1:klev)*alpha(:,1:klev)
-      lyam(1:klon,1:klev)=l(:,1:klev)
-      knyam(1:klon,1:klev)=kn(:,1:klev)
+      smyam(1:ngrid,1)=0.
+      styam(1:ngrid,1)=0.
+      lyam(1:ngrid,1)=0.
+      knyam(1:ngrid,1)=0.
+      w2yam(1:ngrid,1)=0.
+      t2yam(1:ngrid,1)=0.
+
+      smyam(1:ngrid,2:klev)=sm(1:ngrid,2:klev)
+      styam(1:ngrid,2:klev)=sm(1:ngrid,2:klev)*alpha(1:ngrid,2:klev)
+      lyam(1:ngrid,2:klev)=l(1:ngrid,2:klev)
+      knyam(1:ngrid,2:klev)=kn(1:ngrid,2:klev)
 
 c   Estimations de w'2 et T'2 d'apres Abdela et McFarlane
 
-        if(1.eq.0)then
-      w2yam=q2(:,1:klev)*0.24
-     s    +lyam(:,1:klev)*5.17*kn(:,1:klev)*n2(:,1:klev)
-     s   /sqrt(q2(:,1:klev))
-
-      t2yam=9.1*kn(:,1:klev)*dtetadz(:,1:klev)**2/sqrt(q2(:,1:klev))
-     s  *lyam(:,1:klev)
-	endif
+      w2yam(1:ngrid,2:klev)=q2(1:ngrid,2:klev)*0.24
+     s    +lyam(1:ngrid,2:klev)*5.17*kn(1:ngrid,2:klev)
+     s    *n2(1:ngrid,2:klev)/sqrt(q2(1:ngrid,2:klev))
+
+      t2yam(1:ngrid,2:klev)=9.1*kn(1:ngrid,2:klev)
+     s    *dtetadz(1:ngrid,2:klev)**2
+     s    /sqrt(q2(1:ngrid,2:klev))*lyam(1:ngrid,2:klev)
+      endif
 
 c     print*,'OKFIN'
