Index: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcellV0_main.F90
===================================================================
--- LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcellV0_main.F90	(revision 1329)
+++ LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcellV0_main.F90	(revision 1330)
@@ -225,22 +225,8 @@
 !Initialisation
 !
-!    IF (1.eq.0) THEN
-!     do ig=1,klon      
-!FH/IM 130308     if ((debut).or.((.not.debut).and.(f0(ig).lt.1.e-10))) then
-!     if ((.not.debut).and.(f0(ig).lt.1.e-10)) then
-!           f0(ig)=1.e-5
-!           zmax0(ig)=40.
-!v1d        therm=.false.
-!     endif
-!     enddo 
-!    ENDIF !(1.eq.0) THEN
      if (prt_level.ge.10)write(lunout,*)                                &
     &     'WARNING thermcell_main f0=max(f0,1.e-2)'
      do ig=1,klon
-      if (prt_level.ge.20) then
-       print*,'th_main ig f0',ig,f0(ig)
-      endif
          f0(ig)=max(f0(ig),1.e-2)
-!IMmarche pas ?!       if (f0(ig)<1.e-2) f0(ig)=1.e-2
      enddo
 
@@ -637,7 +623,4 @@
             zf2=zf/(1.-zf)
 !
-      if (prt_level.ge.10) print*,'14e OK convect8 ig,l,zf,zf2',ig,l,zf,zf2
-!
-      if (prt_level.ge.10) print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)
             thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
             if(zw2(ig,l).gt.1.e-10) then
@@ -649,5 +632,4 @@
             wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
      &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
-      if (prt_level.ge.10) print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l)
             q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
 !test: on calcul q2/po=ratqsc
@@ -655,6 +637,16 @@
          enddo
       enddo
-!calcul de ale_bl et alp_bl
-!pour le calcul d'une valeur intégrée entre la surface et lmax
+
+      if (prt_level.ge.10) then
+          print*,'14e OK convect8 ig,l,zf,zf2',ig,l,zf,zf2
+          ig=igout
+          do l=1,nlay
+             print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)
+          enddo
+          do l=1,nlay
+             print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l)
+          enddo
+      endif
+
       do ig=1,ngrid
       alp_int(ig)=0.
Index: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_env.F90
===================================================================
--- LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_env.F90	(revision 1329)
+++ LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_env.F90	(revision 1330)
@@ -1,4 +1,4 @@
       SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
-     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
+     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
 
 !--------------------------------------------------------------
@@ -31,23 +31,22 @@
       REAL zu(ngrid,nlay)
       REAL zv(ngrid,nlay)
-      REAL zqsat(ngrid,nlay)
+      REAL pqsat(ngrid,nlay)
 
-      INTEGER ig,l,ll
+      INTEGER ig,ll
 
-      real zcor,zdelta,zcvm5,qlbef
-      real Tbef,qsatbef
-      real dqsat_dT,DT,num,denom
-      REAL RLvCp,DDT0
-      PARAMETER (DDT0=.01)
-      LOGICAL Zsat
+      real dqsat_dT
+      real RLvCp
 
-      Zsat=.false.
-      RLvCp = RLVTT/RCPD
+logical mask(ngrid,nlay)
 
-!
-! 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
+
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! Initialisations :
+!------------------
+
+print*,'THERMCELL ENV OPTIMISE '
+mask(:,:)=.true.
+RLvCp = RLVTT/RCPD
+
 !
 ! calcul des caracteristiques de l environnement
@@ -57,82 +56,43 @@
             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
+! Condensation :
+!---------------
+! Calcul de l'humidite a saturation et de la condensation
+
+call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
+DO ll=1,nlay
+   DO ig=1,ngrid
+      zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
+      zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
+      zo(ig,ll) = po(ig,ll)-zl(ig,ll)
+   ENDDO
+ENDDO
 !
 !
 !-----------------------------------------------------------------------
-!   incrementation eventuelle de tendances precedentes:
-!   ---------------------------------------------------
 
       if (prt_level.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)
+      DO ll=1,nlay
+         DO ig=1,ngrid
+             zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
+             zu(ig,ll)=pu(ig,ll)
+             zv(ig,ll)=pv(ig,ll)
 !attention zh est maintenant le profil de T et plus le profil de theta !
+! Quelle horreur ! A eviter.
 !
 !   T-> Theta
-            ztv(ig,l)=zh(ig,l)/zpspsk(ig,l)
+            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
 !Theta_v
-            ztv(ig,l)=ztv(ig,l)*(1.+RETV*(zo(ig,l))  &
-     &           -zl(ig,l))
+            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
 !Thetal
-            zthl(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
 !            
-1015     CONTINUE
-1010  CONTINUE
+         ENDDO
+      ENDDO
  
       RETURN
Index: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_flux2.F90
===================================================================
--- LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_flux2.F90	(revision 1329)
+++ LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_flux2.F90	(revision 1330)
@@ -41,5 +41,5 @@
       REAL zfm
 
-      integer igout
+      integer igout,lout
       integer lev_out
       integer lunout1
@@ -49,4 +49,6 @@
       REAL fomass_max,alphamax
       save fomass_max,alphamax
+
+      logical check_debug,labort_gcm
 
       character (len=20) :: modname='thermcell_flux2'
@@ -84,6 +86,10 @@
 ! Verification de la nullite des entrainement et detrainement au dessus
 ! de lmax(ig)
-!-------------------------------------------------------------------------
-
+! Active uniquement si check_debug=.true. ou prt_level>=10
+!-------------------------------------------------------------------------
+
+      check_debug=.false..or.prt_level>=10
+
+      if (check_debug) then
       do l=1,klev
          do ig=1,ngrid
@@ -102,4 +108,5 @@
                     print*,'detr_star(ig,l)',detr_star(ig,l)
                     abort_message = ''
+                    labort_gcm=.true.
                     CALL abort_gcm (modname,abort_message,1)
                endif
@@ -107,4 +114,5 @@
          enddo
       enddo
+      endif
 
 !-------------------------------------------------------------------------
@@ -259,10 +267,23 @@
 
 !     do l=1,klev
+
+
+
+         labort_gcm=.false.
          do ig=1,ngrid
             if (entr(ig,l)<0.) then
-               print*,'N1 ig,l,entr',ig,l,entr(ig,l)
-               abort_message = 'entr negatif'
-               CALL abort_gcm (modname,abort_message,1)
-            endif
+               labort_gcm=.true.
+               igout=ig
+               lout=l
+            endif
+         enddo
+
+         if (labort_gcm) then
+            print*,'N1 ig,l,entr',igout,lout,entr(igout,lout)
+            abort_message = 'entr negatif'
+            CALL abort_gcm (modname,abort_message,1)
+         endif
+
+         do ig=1,ngrid
             if (detr(ig,l).gt.fm(ig,l)) then
                ncorecfm6=ncorecfm6+1
@@ -287,13 +308,23 @@
                entr(ig,l)=0.
             endif
-
+         enddo
+
+         labort_gcm=.false.
+         do ig=1,ngrid
             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)
-               abort_message = 'probleme dans thermcell flux'
-               CALL abort_gcm (modname,abort_message,1)
-            endif
-         enddo
+               labort_gcm=.true.
+               igout=ig
+            endif
+         enddo
+         if (labort_gcm) then
+            ig=igout
+            print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
+            print*,'entr(ig,l)',entr(ig,l)
+            print*,'fm(ig,l)',fm(ig,l)
+            abort_message = 'probleme dans thermcell flux'
+            CALL abort_gcm (modname,abort_message,1)
+         endif
+
+
 !     enddo
       endif
@@ -313,8 +344,17 @@
                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
+         enddo
+
+         labort_gcm=.false.
+         do ig=1,ngrid
             if (detr(ig,l).lt.0.) then
+               labort_gcm=.true.
+               igout=ig
+            endif
+        enddo
+        if (labort_gcm) then
+               ig=igout
                print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig)
                print*,'detr(ig,l)',detr(ig,l)
@@ -322,6 +362,5 @@
                abort_message = 'probleme dans thermcell flux'
                CALL abort_gcm (modname,abort_message,1)
-            endif
-        enddo
+        endif
 !    enddo
 
@@ -388,4 +427,5 @@
 
       if (1.eq.1) then
+      labort_gcm=.false.
       do l=1,klev-1
          do ig=1,ngrid
@@ -408,4 +448,20 @@
                    else
                       if(l.ge.lmax(ig).and.0.eq.1) then
+                         igout=ig
+                         lout=l
+                         labort_gcm=.true.
+                      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
+      if (labort_gcm) then
+                         ig=igout
+                         l=lout
                          print*,'ig,l',ig,l
                          print*,'eee0',eee0
@@ -424,14 +480,5 @@
                          abort_message = 'probleme dans thermcell_flux'
                          CALL abort_gcm (modname,abort_message,1)
-                      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
       endif
 !                  
