Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/clcdrag.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/clcdrag.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/clcdrag.F90	(revision 418)
@@ -0,0 +1,101 @@
+      SUBROUTINE clcdrag(klon, knon, nsrf, zxli, &
+                         u, v, t, q, zgeop, &
+                         ts, qsurf, rugos, &
+                         pcfm, pcfh)
+      IMPLICIT NONE
+! ================================================================= c
+!
+! Objet : calcul des cdrags pour le moment (pcfm) et 
+!         les flux de chaleur sensible et latente (pcfh).   
+!
+! ================================================================= c
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
+! zxli----input-L- calcul des cdrags selon Laurent Li
+! u-------input-R- vent zonal au 1er niveau du modele
+! v-------input-R- vent meridien au 1er niveau du modele
+! t-------input-R- temperature de l'air au 1er niveau du modele
+! q-------input-R- humidite de l'air au 1er niveau du modele
+! zgeop---input-R- geopotentiel au 1er niveau du modele
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite de l'air a la surface
+! rugos---input-R- rugosite
+!
+! pcfm---output-R- cdrag pour le moment 
+! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli
+      REAL, intent(in), dimension(klon) :: u, v, t, q, zgeop
+      REAL, intent(in), dimension(klon) :: ts, qsurf
+      REAL, intent(in), dimension(klon) :: rugos
+      REAL, intent(out), dimension(klon) :: pcfm, pcfh
+! ================================================================= c
+!
+#include "YOMCST.inc"
+#include "YOETHF.inc"
+#include "indicesol.inc"
+!
+! Quelques constantes et options:
+      REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
+!
+! Variables locales :
+      INTEGER :: i
+      REAL :: zdu2, ztsolv, ztvd, zscf
+      REAL :: zucf, zcr
+      REAL :: friv, frih
+      REAL, dimension(klon) :: zcfm1, zcfm2
+      REAL, dimension(klon) :: zcfh1, zcfh2
+      REAL, dimension(klon) :: zcdn
+      REAL, dimension(klon) :: zri
+!
+! Fonctions thermodynamiques et fonctions d'instabilite
+      REAL :: fsta, fins, x
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+! ================================================================= c
+!
+! Calculer le frottement au sol (Cdrag)
+!
+      DO i = 1, knon
+        zdu2 = max(cepdu2,u(i)**2+v(i)**2)
+        ztsolv = ts(i) * (1.0+RETV*qsurf(i))
+        ztvd = (t(i)+zgeop(i)/RCPD/(1.+RVTMP2*q(i))) &
+             *(1.+RETV*q(i))
+        zri(i) = zgeop(i)*(ztvd-ztsolv)/(zdu2*ztvd)
+        zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*rugos(i))))**2
+!
+        IF (zri(i) .ge. 0.) THEN      ! situation stable
+          zri(i) = min(20.,zri(i))
+          IF (.NOT.zxli) THEN
+            zscf = SQRT(1.+cd*ABS(zri(i)))
+            FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
+            zcfm1(i) = zcdn(i) * FRIV
+            FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
+            zcfh1(i) = zcdn(i) * FRIH
+            pcfm(i) = zcfm1(i)
+            pcfh(i) = zcfh1(i)
+          ELSE
+            pcfm(i) = zcdn(i)* fsta(zri(i))
+            pcfh(i) = zcdn(i)* fsta(zri(i))
+          ENDIF
+        ELSE                          ! situation instable
+          IF (.NOT.zxli) THEN
+            zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
+                 *(1.0+zgeop(i)/(RG*rugos(i)))))
+            zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
+            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
+            pcfm(i) = zcfm2(i)
+            pcfh(i) = zcfh2(i)
+          ELSE
+            pcfm(i) = zcdn(i)* fins(zri(i))
+            pcfh(i) = zcdn(i)* fins(zri(i))
+          ENDIF
+          zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
+          IF(nsrf.EQ.is_oce) pcfh(i) = zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
+        ENDIF
+      END DO
+      RETURN
+      END SUBROUTINE clcdrag
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/clouds_gno.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/clouds_gno.F	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/clouds_gno.F	(revision 418)
@@ -0,0 +1,250 @@
+C
+C================================================================================
+C
+      SUBROUTINE CLOUDS_GNO(klon,ND,R,RS,QSUB,PTCONV,RATQSC,CLDF)
+      IMPLICIT NONE
+C     
+C--------------------------------------------------------------------------------
+C
+C Inputs:
+C
+C  ND----------: Number of vertical levels
+C  R--------ND-: Domain-averaged mixing ratio of total water 
+C  RS-------ND-: Mean saturation humidity mixing ratio within the gridbox
+C  QSUB-----ND-: Mixing ratio of condensed water within clouds associated
+C                with SUBGRID-SCALE condensation processes (here, it is
+C                predicted by the convection scheme)
+C Outputs:
+C
+C  PTCONV-----ND-: Point convectif = TRUE
+C  RATQSC-----ND-: Largeur normalisee de la distribution
+C  CLDF-----ND-: Fraction nuageuse
+C
+C--------------------------------------------------------------------------------
+
+
+      INTEGER klon,ND
+      REAL R(klon,ND),  RS(klon,ND), QSUB(klon,ND)
+      LOGICAL PTCONV(klon,ND)
+      REAL RATQSC(klon,ND)
+      REAL CLDF(klon,ND)
+
+c -- parameters controlling the iteration:
+c --    nmax    : maximum nb of iterations (hopefully never reached)
+c --    epsilon : accuracy of the numerical resolution 
+c --    vmax    : v-value above which we use an asymptotic expression for ERF(v)
+
+      INTEGER nmax
+      PARAMETER ( nmax = 10) 
+      REAL epsilon, vmax0, vmax(klon)
+      PARAMETER ( epsilon = 0.02, vmax0 = 2.0 ) 
+
+      REAL min_mu, min_Q
+      PARAMETER ( min_mu =  1.e-12, min_Q=1.e-12 )
+     
+      INTEGER i,K, n, m
+      REAL mu(klon), qsat(klon), delta(klon), beta(klon) 
+      real zu2(klon),zv2(klon)
+      REAL xx(klon), aux(klon), coeff(klon), block(klon)
+      REAL  dist(klon), fprime(klon), det(klon)
+      REAL pi, u(klon), v(klon), erfu(klon), erfv(klon)
+      REAL  xx1(klon), xx2(klon)
+      real erf,kkk
+c lconv = true si le calcul a converge (entre autre si qsub < min_q)
+       LOGICAL lconv(klon)
+
+
+      pi = ACOS(-1.)
+
+      ptconv=.false.
+      ratqsc=0.
+
+
+      DO 500 K = 1, ND
+
+                                    do i=1,klon ! vector
+      mu(i) = R(i,K)
+      mu(i) = MAX(mu(i),min_mu)
+      qsat(i) = RS(i,K) 
+      qsat(i) = MAX(qsat(i),min_mu)
+      delta(i) = log(mu(i)/qsat(i))
+                                    enddo ! vector
+
+C
+C ***          There is no subgrid-scale condensation;        ***
+C ***   the scheme becomes equivalent to an "all-or-nothing"  *** 
+C ***             large-scale condensation scheme.            ***
+C
+
+C
+C ***     Some condensation is produced at the subgrid-scale       ***
+C ***                                                              ***
+C ***       PDF = generalized log-normal distribution (GNO)        ***
+C ***   (k<0 because a lower bound is considered for the PDF)      ***
+C ***                                                              ***
+C ***  -> Determine x (the parameter k of the GNO PDF) such        ***
+C ***  that the contribution of subgrid-scale processes to         ***
+C ***  the in-cloud water content is equal to QSUB(K)              ***
+C ***  (equations (13), (14), (15) + Appendix B of the paper)      ***
+C ***                                                              ***
+C ***    Here, an iterative method is used for this purpose        ***
+C ***    (other numerical methods might be more efficient)         ***
+C ***                                                              ***
+C ***          NB: the "error function" is called ERF              ***
+C ***                 (ERF in double precision)                   ***
+C
+
+c  On commence par eliminer les cas pour lesquels on n'a pas
+c  suffisamment d'eau nuageuse.
+
+                                    do i=1,klon ! vector
+
+      IF ( QSUB(i,K) .lt. min_Q ) THEN
+        ptconv(i,k)=.false.
+        ratqsc(i,k)=0.
+        lconv(i)  = .true.
+
+c   Rien on a deja initialise
+
+      ELSE 
+
+        lconv(i)  = .FALSE. 
+        vmax(i) = vmax0
+
+        beta(i) = QSUB(i,K)/mu(i) + EXP( -MIN(0.0,delta(i)) )
+
+c --  roots of equation v > vmax:
+
+        det(i) = delta(i) + vmax(i)**2.
+        if (det(i).LE.0.0) vmax(i) = vmax0 + 1.0
+        det(i) = delta(i) + vmax(i)**2.
+
+        if (det(i).LE.0.) then
+          xx(i) = -0.0001
+        else 
+         xx1(i)=-SQRT(2.)*vmax(i)*(1.0-SQRT(1.0+delta(i)/(vmax(i)**2.)))
+         xx2(i)=-SQRT(2.)*vmax(i)*(1.0+SQRT(1.0+delta(i)/(vmax(i)**2.)))
+         xx(i) = 1.01 * xx1(i)
+         if ( xx1(i) .GE. 0.0 ) xx(i) = 0.5*xx2(i)
+        endif
+        if (delta(i).LT.0.) xx(i) = -0.5*SQRT(log(2.)) 
+
+      ENDIF
+
+                                    enddo       ! vector
+
+c----------------------------------------------------------------------
+c   Debut des nmax iterations pour trouver la solution.
+c----------------------------------------------------------------------
+
+      DO n = 1, nmax 
+
+                                    do i=1,klon ! vector
+        if (.not.lconv(i)) then
+
+          u(i) = delta(i)/(xx(i)*sqrt(2.)) + xx(i)/(2.*sqrt(2.))
+          v(i) = delta(i)/(xx(i)*sqrt(2.)) - xx(i)/(2.*sqrt(2.))
+
+          IF ( v(i) .GT. vmax(i) ) THEN 
+
+            IF (     ABS(u(i))  .GT. vmax(i) 
+     :          .AND.  delta(i) .LT. 0. ) THEN
+
+c -- use asymptotic expression of erf for u and v large:
+c ( -> analytic solution for xx )
+
+             aux(i) = 2.0*delta(i)*(1.-beta(i)*EXP(delta(i)))
+     :                       /(1.+beta(i)*EXP(delta(i)))
+             if (aux(i).lt.0.) then
+                print*,'AUX(',i,',',k,')<0',aux(i),delta(i),beta(i)
+                aux(i)=0.
+             endif
+             xx(i) = -SQRT(aux(i))
+             block(i) = EXP(-v(i)*v(i)) / v(i) / SQRT(pi)
+             dist(i) = 0.0
+             fprime(i) = 1.0
+
+            ELSE
+
+c -- erfv -> 1.0, use an asymptotic expression of erfv for v large:
+
+             erfu(i) = ERF(u(i))
+c  !!! ATTENTION : rajout d'un seuil pour l'exponentiel
+             aux(i) = SQRT(pi)*(1.0-erfu(i))*EXP(min(v(i)*v(i),100.))
+             coeff(i) = 1.0 - 1./2./(v(i)**2.) + 3./4./(v(i)**4.)
+             block(i) = coeff(i) * EXP(-v(i)*v(i)) / v(i) / SQRT(pi)
+             dist(i) = v(i) * aux(i) / coeff(i) - beta(i)
+             fprime(i) = 2.0 / xx(i) * (v(i)**2.)
+     :           * ( coeff(i)*EXP(-delta(i)) - u(i) * aux(i) )
+     :           / coeff(i) / coeff(i)
+            
+            ENDIF ! ABS(u)
+
+          ELSE
+
+c -- general case:
+
+           erfu(i) = ERF(u(i))
+           erfv(i) = ERF(v(i))
+           block(i) = 1.0-erfv(i)
+           dist(i) = (1.0 - erfu(i)) / (1.0 - erfv(i)) - beta(i)
+           zu2(i)=u(i)*u(i)
+           zv2(i)=v(i)*v(i)
+           if(zu2(i).gt.20..or. zv2(i).gt.20.) then
+              print*,'ATTENTION !!! xx(',i,') =', xx(i)
+           print*,'ATTENTION !!! klon,ND,R,RS,QSUB,PTCONV,RATQSC,CLDF',
+     .klon,ND,R(i,k),RS(i,k),QSUB(i,k),PTCONV(i,k),RATQSC(i,k),
+     .CLDF(i,k)
+              print*,'ATTENTION !!! zu2 zv2 =',zu2(i),zv2(i)
+              zu2(i)=20.
+              zv2(i)=20.
+             fprime(i) = 0.
+           else
+             fprime(i) = 2. /SQRT(pi) /xx(i) /(1.0-erfv(i))**2.
+     :           * (   (1.0-erfv(i))*v(i)*EXP(-zu2(i))
+     :               - (1.0-erfu(i))*u(i)*EXP(-zv2(i)) )
+           endif
+          ENDIF ! x
+
+c -- test numerical convergence:
+
+c         print*,'avant test ',i,k,lconv(i),u(i),v(i)
+          if ( ABS(dist(i)/beta(i)) .LT. epsilon ) then 
+c           print*,'v-u **2',(v(i)-u(i))**2
+c           print*,'exp v-u **2',exp((v(i)-u(i))**2)
+            ptconv(i,K) = .TRUE. 
+            lconv(i)=.true.
+c  borne pour l'exponentielle
+            ratqsc(i,k)=min(2.*(v(i)-u(i))**2,20.)
+            ratqsc(i,k)=sqrt(exp(ratqsc(i,k))-1.)
+            CLDF(i,K) = 0.5 * block(i)
+cccccccccccccccccccccccc
+c           kkk=-sqrt(log(1.+ratqsc(i,k)**2))
+c           u(i)=delta(i)/(kkk*sqrt(2.))-kkk/(2.*sqrt(2.))
+c           v(i)=delta(i)/(kkk*sqrt(2.))+kkk/(2.*sqrt(2.))
+c           erfu(i)=erf(u(i))
+c           erfv(i)=erf(v(i))
+c           print*,'SIG ',k,qsub(i,k)
+c    s      ,mu(i)*((1.-erfv(i))/(1.-erfu(i))-qsat(i)/mu(i))
+c    s      ,0.5*erfu(i)
+cccccccccccccccccccccccc
+          else
+            xx(i) = xx(i) - dist(i)/fprime(i)
+          endif
+c         print*,'apres test ',i,k,lconv(i)
+
+        endif ! lconv
+                                    enddo       ! vector
+
+c----------------------------------------------------------------------
+c   Fin des nmax iterations pour trouver la solution.
+        ENDDO ! n
+c----------------------------------------------------------------------
+
+500   CONTINUE  ! K
+
+       RETURN
+       END
+
+
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/coefcdrag.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/coefcdrag.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/coefcdrag.F90	(revision 418)
@@ -0,0 +1,137 @@
+      SUBROUTINE coefcdrag (klon, knon, nsrf, zxli, &
+                            speed, t, q, zgeop, psol, &
+                            ts, qsurf, rugos, okri, ri1, &
+                            cdram, cdrah, cdran, zri1, pref)
+      IMPLICIT none
+!-------------------------------------------------------------------------
+! Objet : calcul des cdrags pour le moment (cdram) et les flux de chaleur 
+!         sensible et latente (cdrah), du cdrag neutre (cdran), 
+!         du nombre de Richardson entre la surface et le niveau de reference 
+!         (zri1) et de la pression au niveau de reference (pref).    
+!
+! I. Musat, 01.07.2002
+!-------------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
+! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+! speed---input-R- module du vent au 1er niveau du modele
+! t-------input-R- temperature de l'air au 1er niveau du modele
+! q-------input-R- humidite de l'air au 1er niveau du modele
+! zgeop---input-R- geopotentiel au 1er niveau du modele
+! psol----input-R- pression au sol 
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite de l'air a la surface
+! rugos---input-R- rugosite
+! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce 
+!                  et zref par rapport au Ri entre la sfce et la 1ere couche
+! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche
+!
+! cdram--output-R- cdrag pour le moment
+! cdrah--output-R- cdrag pour les flux de chaleur latente et sensible
+! cdran--output-R- cdrag neutre
+! zri1---output-R- nb. Richardson entre la surface et la couche zgeop/RG
+! pref---output-R- pression au niveau zgeop/RG
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli 
+      REAL, dimension(klon), intent(in) :: speed, t, q, zgeop, psol
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, ri1 
+      LOGICAL, intent(in) :: okri    
+!
+      REAL, dimension(klon), intent(out) :: cdram, cdrah, cdran, zri1, pref
+!-------------------------------------------------------------------------
+!
+#include "YOMCST.inc"
+#include "YOETHF.inc"
+#include "indicesol.inc"
+! Quelques constantes :
+      REAL, parameter :: RKAR=0.40, CB=5.0, CC=5.0, CD=5.0
+!
+! Variables locales :
+      INTEGER :: i
+      REAL, dimension(klon) :: zdu2, zdphi, ztsolv, ztvd
+      REAL, dimension(klon) :: zscf, friv, frih, zucf, zcr
+      REAL, dimension(klon) :: zcfm1, zcfh1
+      REAL, dimension(klon) :: zcfm2, zcfh2
+      REAL, dimension(klon) :: trm0, trm1
+!-------------------------------------------------------------------------
+      REAL :: fsta, fins, x
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+!-------------------------------------------------------------------------
+!
+      DO i = 1, knon
+!
+       zdphi(i) = zgeop(i)
+       zdu2(i) = speed(i)**2
+       pref(i) = exp(log(psol(i)) - zdphi(i)/(RD*t(i)* &
+                 (1.+ RETV * max(q(i),0.0))))
+       ztsolv(i) = ts(i)
+       ztvd(i) = t(i) * (psol(i)/pref(i))**RKAPPA
+       trm0(i) = 1. + RETV * max(qsurf(i),0.0)
+       trm1(i) = 1. + RETV * max(q(i),0.0)
+       ztsolv(i) = ztsolv(i) * trm0(i)
+       ztvd(i) = ztvd(i) * trm1(i)
+       zri1(i) = zdphi(i)*(ztvd(i)-ztsolv(i))/(zdu2(i)*ztvd(i))
+!
+! on teste zri1 par rapport au Richardson de la 1ere couche ri1 
+!
+       IF (okri) THEN
+         IF (ri1(i).GE.0.0.AND.zri1(i).LT.0.0) THEN
+           zri1(i) = ri1(i)
+         ELSE IF(ri1(i).LT.0.0.AND.zri1(i).GE.0.0) THEN
+           zri1(i) = ri1(i)
+         ENDIF 
+       ENDIF
+! 
+       cdran(i) = (RKAR/log(1.+zdphi(i)/(RG*rugos(i))))**2
+
+       IF (zri1(i) .ge. 0.) THEN 
+!
+! situation stable : pour eviter les inconsistances dans les cas 
+! tres stables on limite zri1 a 20. cf Hess et al. (1995)
+!
+         zri1(i) = min(20.,zri1(i))
+!
+         IF (.NOT.zxli) THEN
+           zscf(i) = SQRT(1.+CD*ABS(zri1(i)))
+           friv(i) = max(1. / (1.+2.*CB*zri1(i)/ zscf(i)), 0.1)
+           zcfm1(i) = cdran(i) * friv(i)
+           frih(i) = max(1./ (1.+3.*CB*zri1(i)*zscf(i)), 0.1 )
+           zcfh1(i) = cdran(i) * frih(i)
+           cdram(i) = zcfm1(i)
+           cdrah(i) = zcfh1(i)
+         ELSE
+           cdram(i) = cdran(i)* fsta(zri1(i))
+           cdrah(i) = cdran(i)* fsta(zri1(i))
+         ENDIF
+!
+       ELSE
+! 
+! situation instable
+!
+         IF (.NOT.zxli) THEN
+           zucf(i) = 1./(1.+3.0*CB*CC*cdran(i)*SQRT(ABS(zri1(i)) &
+                 *(1.0+zdphi(i)/(RG*rugos(i)))))
+           zcfm2(i) = cdran(i)*max((1.-2.0*CB*zri1(i)*zucf(i)),0.1)
+           zcfh2(i) = cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),0.1)
+           cdram(i) = zcfm2(i)
+           cdrah(i) = zcfh2(i)
+         ELSE
+           cdram(i) = cdran(i)* fins(zri1(i))
+           cdrah(i) = cdran(i)* fins(zri1(i))
+         ENDIF
+!
+! cdrah sur l'ocean cf. Miller et al. (1992)
+!
+         zcr(i) = (0.0016/(cdran(i)*SQRT(zdu2(i))))*ABS(ztvd(i)-ztsolv(i)) &
+               **(1./3.)
+         IF (nsrf.EQ.is_oce) cdrah(i) = cdran(i)*(1.0+zcr(i)**1.25) &
+                  **(1./1.25)
+       ENDIF
+!
+      END DO
+      RETURN 
+      END SUBROUTINE coefcdrag
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/coefcdrag_int.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/coefcdrag_int.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/coefcdrag_int.F90	(revision 418)
@@ -0,0 +1,22 @@
+MODULE coefcdrag_int
+
+  IMPLICIT NONE 
+
+  INTERFACE
+ 
+    SUBROUTINE coefcdrag (klon, knon, nsrf, zxli, &
+                          speed, t, q, zgeop, psol, &
+                          ts, qsurf, rugos, okri, ri1, &
+                          cdram, cdrah, cdran, zri1, pref)
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli
+      REAL, dimension(klon), intent(in) :: speed, t, q, zgeop, psol
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, ri1
+      LOGICAL, intent(in) :: okri
+      REAL, dimension(klon), intent(out) :: cdram, cdrah, cdran, zri1, pref
+
+    END SUBROUTINE coefcdrag
+
+  END INTERFACE
+
+END MODULE coefcdrag_int
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/concvl.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/concvl.F	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/concvl.F	(revision 418)
@@ -0,0 +1,173 @@
+      SUBROUTINE concvl (iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,
+     .             work1,work2,d_t,d_q,d_u,d_v,d_tra,
+     .             rain, snow, kbas, ktop,
+     .             upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,
+     .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
+     .             qcondc,wd)
+ 
+c
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: schema de convection de Emanuel (1991) interface
+c======================================================================
+c Arguments:
+c dtime--input-R-pas d'integration (s)
+c s-------input-R-la valeur "s" pour chaque couche
+c sigs----input-R-la valeur "sigma" de chaque couche
+c sig-----input-R-la valeur de "sigma" pour chaque niveau
+c psolpa--input-R-la pression au sol (en Pa)
+C pskapa--input-R-exponentiel kappa de psolpa
+c h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
+c q-------input-R-vapeur d'eau (en kg/kg)
+c
+c work*: input et output: deux variables de travail,
+c                            on peut les mettre a 0 au debut
+c ALE-----input-R-energie disponible pour soulevement
+c
+C d_h-----output-R-increment de l'enthalpie potentielle (h)
+c d_q-----output-R-increment de la vapeur d'eau
+c rain----output-R-la pluie (mm/s)
+c snow----output-R-la neige (mm/s)
+c upwd----output-R-saturated updraft mass flux (kg/m**2/s)
+c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
+c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
+c Cape----output-R-CAPE (J/kg)
+c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
+c                  adiabatiquement a partir du niveau 1 (K)
+c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
+c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
+c======================================================================
+c
+#include "dimensions.h"
+#include "dimphy.h"
+c
+      integer NTRAC
+      PARAMETER (NTRAC=nqmx-2)
+c
+       INTEGER iflag_con
+c
+       REAL dtime, paprs(klon,klev+1),pplay(klon,klev)
+       REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)
+       REAL tra(klon,klev,ntrac)
+       INTEGER ntra
+       REAL work1(klon,klev),work2(klon,klev)
+c
+       REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
+       REAL d_tra(klon,klev,ntrac)
+       REAL rain(klon),snow(klon)
+c
+       INTEGER kbas(klon),ktop(klon)
+       REAL em_ph(klon,klev+1),em_p(klon,klev)
+       REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev)
+       REAL Ma(klon,klev),cape(klon),tvp(klon,klev)
+       INTEGER iflag(klon)
+       REAL rflag(klon)
+       REAL pbase(klon),bbase(klon)
+       REAL dtvpdt1(klon,klev),dtvpdq1(klon,klev)
+       REAL dplcldt(klon),dplcldr(klon)
+       REAL qcondc(klon,klev)
+       REAL wd(klon)
+c
+       REAL zx_t,zdelta,zx_qs,zcor
+c
+       INTEGER noff, minorig
+       INTEGER i,k,itra
+       REAL qs(klon,klev)
+       REAL cbmf(klon)
+       SAVE cbmf
+       INTEGER ifrst
+       SAVE ifrst
+       DATA ifrst /0/
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+c
+c
+      IF (ifrst .EQ. 0) THEN
+         ifrst = 1
+         DO i = 1, klon
+          cbmf(i) = 0.
+         ENDDO
+      ENDIF
+
+      DO k = 1, klev+1
+         DO i=1,klon
+         em_ph(i,k) = paprs(i,k) / 100.0
+      ENDDO
+      ENDDO
+c
+      DO k = 1, klev
+         DO i=1,klon
+         em_p(i,k) = pplay(i,k) / 100.0
+      ENDDO
+      ENDDO
+
+c
+      if (iflag_con .eq. 4) then
+      DO k = 1, klev
+        DO i = 1, klon
+         zx_t = t(i,k)
+         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
+         zx_qs= MIN(0.5 , r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0)
+         zcor=1./(1.-retv*zx_qs)
+         qs(i,k)=zx_qs*zcor
+        ENDDO
+      ENDDO
+      else ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
+      DO k = 1, klev
+        DO i = 1, klon
+         zx_t = t(i,k)
+         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
+         zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0
+         zx_qs= MIN(0.5,zx_qs)
+         zcor=1./(1.-retv*zx_qs)
+         zx_qs=zx_qs*zcor
+         qs(i,k)=zx_qs
+        ENDDO
+      ENDDO
+      endif ! iflag_con
+c
+C------------------------------------------------------------------
+
+C Main driver for convection:
+C		iflag_con = 3  -> equivalent to convect3
+C		iflag_con = 4  -> equivalent to convect1/2
+
+      CALL cv_driver(klon,klev,klev+1,ntra,iflag_con,
+     :              t,q,qs,u,v,tra,
+     $              em_p,em_ph,iflag,
+     $              d_t,d_q,d_u,d_v,d_tra,rain,
+     $              cbmf,work1,work2,
+     $              dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape)
+
+C------------------------------------------------------------------
+
+      DO i = 1,klon
+        rain(i) = rain(i)/86400.
+        rflag(i)=iflag(i)
+      ENDDO
+
+      DO k = 1, klev
+        DO i = 1, klon
+           d_t(i,k) = dtime*d_t(i,k)
+           d_q(i,k) = dtime*d_q(i,k)
+           d_u(i,k) = dtime*d_u(i,k)
+           d_v(i,k) = dtime*d_v(i,k)
+        ENDDO
+      ENDDO
+ 
+c les traceurs ne sont pas mis dans cette version de convect4:
+      if (iflag_con.eq.4) then
+       DO itra = 1,ntra
+        DO k = 1, klev
+         DO i = 1, klon
+            d_tra(i,k,itra) = 0.
+         ENDDO
+        ENDDO
+       ENDDO
+      endif
+ 
+      RETURN
+      END
+ 
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/cv3_routines.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/cv3_routines.F	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/cv3_routines.F	(revision 418)
@@ -0,0 +1,3027 @@
+      SUBROUTINE cv3_param(nd,delt)
+      implicit none
+
+c------------------------------------------------------------
+c Set parameters for convectL for iflag_con = 3 
+c------------------------------------------------------------
+
+C
+C   ***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
+C   ***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
+C   ***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***     
+C   ***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
+C   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
+C   ***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***     
+C   ***                        OF CLOUD                         ***
+C
+C [TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
+C   ***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
+C   ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+C   ***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
+C   ***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
+C
+C   ***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
+C   ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+C   ***                     IT MUST BE LESS THAN 0              ***
+
+#include "cvparam3.h"
+
+      integer nd
+      real delt ! timestep (seconds)
+
+c noff: integer limit for convection (nd-noff)
+c minorig: First level of convection
+
+c -- limit levels for convection:
+
+      noff    = 1
+      minorig = 1
+      nl=nd-noff
+      nlp=nl+1
+      nlm=nl-1
+
+c -- "microphysical" parameters:
+
+      sigd   = 0.01
+      spfac  = 0.15
+      pbcrit = 150.0
+      ptcrit = 500.0
+      epmax  = 0.993
+
+      omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
+
+c -- misc:
+
+      dtovsh = -0.2 ! dT for overshoot
+      dpbase = -40. ! definition cloud base (400m above LCL)
+      dttrig = 5.   ! (loose) condition for triggering 
+
+c -- rate of approach to quasi-equilibrium:
+
+      dtcrit = -2.0
+      tau    = 8000.
+      beta   = 1.0 - delt/tau
+      alpha  = 1.5E-3 * delt/tau
+c increase alpha to compensate W decrease:
+      alpha  = alpha*1.5
+
+c -- interface cloud parameterization:
+
+      delta=0.01  ! cld
+
+c -- interface with boundary-layer (gust factor): (sb)
+
+      betad=10.0   ! original value (from convect 4.3)
+
+      return
+      end
+
+      SUBROUTINE cv3_prelim(len,nd,ndp1,t,q,p,ph
+     :                    ,lv,cpn,tv,gz,h,hm,th)
+      implicit none
+
+!=====================================================================
+! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+! "ori": from convect4.3 (vectorized)
+! "convect3": to be exactly consistent with convect3
+!=====================================================================
+
+c inputs:
+      integer len, nd, ndp1
+      real t(len,nd), q(len,nd), p(len,nd), ph(len,ndp1)
+
+c outputs:
+      real lv(len,nd), cpn(len,nd), tv(len,nd)
+      real gz(len,nd), h(len,nd), hm(len,nd)
+      real th(len,nd)
+
+c local variables:
+      integer k, i
+      real rdcp
+      real tvx,tvy ! convect3
+      real cpx(len,nd)
+
+#include "cvthermo.h"
+#include "cvparam3.h"
+
+
+c ori      do 110 k=1,nlp
+      do 110 k=1,nl ! convect3
+        do 100 i=1,len
+cdebug          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
+          lv(i,k)= lv0-clmcpv*(t(i,k)-273.15)
+          cpn(i,k)=cpd*(1.0-q(i,k))+cpv*q(i,k)
+          cpx(i,k)=cpd*(1.0-q(i,k))+cl*q(i,k)
+c ori          tv(i,k)=t(i,k)*(1.0+q(i,k)*epsim1)
+          tv(i,k)=t(i,k)*(1.0+q(i,k)/eps-q(i,k))
+          rdcp=(rrd*(1.-q(i,k))+q(i,k)*rrv)/cpn(i,k)
+          th(i,k)=t(i,k)*(1000.0/p(i,k))**rdcp
+ 100    continue
+ 110  continue
+c
+c gz = phi at the full levels (same as p).
+c
+      do 120 i=1,len
+        gz(i,1)=0.0
+ 120  continue
+c ori      do 140 k=2,nlp
+      do 140 k=2,nl ! convect3
+        do 130 i=1,len
+        tvx=t(i,k)*(1.+q(i,k)/eps-q(i,k))       !convect3
+        tvy=t(i,k-1)*(1.+q(i,k-1)/eps-q(i,k-1)) !convect3
+        gz(i,k)=gz(i,k-1)+0.5*rrd*(tvx+tvy)     !convect3
+     &          *(p(i,k-1)-p(i,k))/ph(i,k)      !convect3
+
+c ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
+c ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
+ 130    continue
+ 140  continue
+c
+c h  = phi + cpT (dry static energy).
+c hm = phi + cp(T-Tbase)+Lq
+c
+c ori      do 170 k=1,nlp
+      do 170 k=1,nl ! convect3
+        do 160 i=1,len
+          h(i,k)=gz(i,k)+cpn(i,k)*t(i,k)
+          hm(i,k)=gz(i,k)+cpx(i,k)*(t(i,k)-t(i,1))+lv(i,k)*q(i,k)
+ 160    continue
+ 170  continue
+
+      return
+      end
+
+      SUBROUTINE cv3_feed(len,nd,t,q,qs,p,ph,hm,gz
+     :                  ,nk,icb,icbmax,iflag,tnk,qnk,gznk,plcl)
+      implicit none
+
+C================================================================
+C Purpose: CONVECTIVE FEED
+C
+C Main differences with cv_feed:
+C   - ph added in input
+C	- here, nk(i)=minorig
+C	- icb defined differently (plcl compared with ph instead of p)
+C
+C Main differences with convect3:
+C 	- we do not compute dplcldt and dplcldr of CLIFT anymore 
+C	- values iflag different (but tests identical)
+C   - A,B explicitely defined (!...)
+C================================================================
+
+#include "cvparam3.h"
+
+c inputs:
+	  integer len, nd
+      real t(len,nd), q(len,nd), qs(len,nd), p(len,nd)
+      real hm(len,nd), gz(len,nd)
+      real ph(len,nd+1)
+
+c outputs:
+	  integer iflag(len), nk(len), icb(len), icbmax
+      real tnk(len), qnk(len), gznk(len), plcl(len)
+
+c local variables:
+      integer i, k
+      integer ihmin(len)
+      real work(len)
+      real pnk(len), qsnk(len), rh(len), chi(len)
+      real A, B ! convect3
+
+c@ !-------------------------------------------------------------------
+c@ ! --- Find level of minimum moist static energy
+c@ ! --- If level of minimum moist static energy coincides with
+c@ ! --- or is lower than minimum allowable parcel origin level,
+c@ ! --- set iflag to 6.
+c@ !-------------------------------------------------------------------
+c@ 
+c@       do 180 i=1,len
+c@        work(i)=1.0e12
+c@        ihmin(i)=nl
+c@  180  continue
+c@       do 200 k=2,nlp
+c@         do 190 i=1,len
+c@          if((hm(i,k).lt.work(i)).and.
+c@      &      (hm(i,k).lt.hm(i,k-1)))then
+c@            work(i)=hm(i,k)
+c@            ihmin(i)=k
+c@          endif
+c@  190    continue
+c@  200  continue
+c@       do 210 i=1,len
+c@         ihmin(i)=min(ihmin(i),nlm)
+c@         if(ihmin(i).le.minorig)then
+c@           iflag(i)=6
+c@         endif
+c@  210  continue
+c@ c
+c@ !-------------------------------------------------------------------
+c@ ! --- Find that model level below the level of minimum moist static
+c@ ! --- energy that has the maximum value of moist static energy
+c@ !-------------------------------------------------------------------
+c@  
+c@       do 220 i=1,len
+c@        work(i)=hm(i,minorig)
+c@        nk(i)=minorig
+c@  220  continue
+c@       do 240 k=minorig+1,nl
+c@         do 230 i=1,len
+c@          if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))then
+c@            work(i)=hm(i,k)
+c@            nk(i)=k
+c@          endif
+c@  230     continue
+c@  240  continue
+
+!-------------------------------------------------------------------
+! --- Origin level of ascending parcels for convect3:
+!-------------------------------------------------------------------
+
+         do 220 i=1,len
+          nk(i)=minorig
+  220    continue
+
+!-------------------------------------------------------------------
+! --- Check whether parcel level temperature and specific humidity
+! --- are reasonable
+!-------------------------------------------------------------------
+       do 250 i=1,len
+       if( (     ( t(i,nk(i)).lt.250.0    )
+     &       .or.( q(i,nk(i)).le.0.0      )     )
+c@      &       .or.( p(i,ihmin(i)).lt.400.0 )  )
+     &   .and.
+     &       ( iflag(i).eq.0) ) iflag(i)=7
+ 250   continue
+!-------------------------------------------------------------------
+! --- Calculate lifted condensation level of air at parcel origin level
+! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)
+!-------------------------------------------------------------------
+
+       A = 1669.0 ! convect3
+       B = 122.0  ! convect3
+
+       do 260 i=1,len
+
+        if (iflag(i).ne.7) then ! modif sb Jun7th 2002
+
+        tnk(i)=t(i,nk(i))
+        qnk(i)=q(i,nk(i))
+        gznk(i)=gz(i,nk(i))
+        pnk(i)=p(i,nk(i))
+        qsnk(i)=qs(i,nk(i))
+c
+        rh(i)=qnk(i)/qsnk(i)
+c ori        rh(i)=min(1.0,rh(i)) ! removed for convect3
+c ori        chi(i)=tnk(i)/(1669.0-122.0*rh(i)-tnk(i))
+        chi(i)=tnk(i)/(A-B*rh(i)-tnk(i)) ! convect3
+        plcl(i)=pnk(i)*(rh(i)**chi(i))
+        if(((plcl(i).lt.200.0).or.(plcl(i).ge.2000.0))
+     &   .and.(iflag(i).eq.0))iflag(i)=8
+ 
+        endif ! iflag=7  
+
+ 260   continue
+
+!-------------------------------------------------------------------
+! --- Calculate first level above lcl (=icb)
+!-------------------------------------------------------------------
+
+c@      do 270 i=1,len
+c@       icb(i)=nlm
+c@ 270  continue
+c@c
+c@      do 290 k=minorig,nl
+c@        do 280 i=1,len
+c@          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
+c@     &    icb(i)=min(icb(i),k)
+c@ 280    continue
+c@ 290  continue
+c@c
+c@      do 300 i=1,len
+c@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+c@ 300  continue
+
+      do 270 i=1,len
+       icb(i)=nlm
+ 270  continue
+c
+c la modification consiste a comparer plcl a ph et non a p:
+c icb est defini par :  ph(icb)<plcl<ph(icb-1)
+c@      do 290 k=minorig,nl
+      do 290 k=3,nl-1 ! modif pour que icb soit sup/egal a 2
+        do 280 i=1,len
+          if( ph(i,k).lt.plcl(i) ) icb(i)=min(icb(i),k)
+ 280    continue
+ 290  continue
+c
+      do 300 i=1,len
+c@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+        if((icb(i).eq.nlm).and.(iflag(i).eq.0))iflag(i)=9
+ 300  continue
+
+      do 400 i=1,len
+        icb(i) = icb(i)-1 ! icb sup ou egal a 2
+ 400  continue
+c
+c Compute icbmax.
+c
+      icbmax=2
+      do 310 i=1,len
+c!        icbmax=max(icbmax,icb(i))
+       if (iflag(i).lt.7) icbmax=max(icbmax,icb(i)) ! sb Jun7th02
+ 310  continue
+
+      return
+      end
+
+      SUBROUTINE cv3_undilute1(len,nd,t,q,qs,gz,plcl,p,nk,icb
+     :                       ,tp,tvp,clw,icbs)
+      implicit none
+
+!----------------------------------------------------------------
+! Equivalent de TLIFT entre NK et ICB+1 inclus
+!
+! Differences with convect4:
+!		- specify plcl in input
+!       - icbs is the first level above LCL (may differ from icb)
+!       - in the iterations, used x(icbs) instead x(icb)
+!       - many minor differences in the iterations
+!		- tvp is computed in only one time
+!		- icbs: first level above Plcl (IMIN de TLIFT) in output
+!       - if icbs=icb, compute also tp(icb+1),tvp(icb+1) & clw(icb+1)
+!----------------------------------------------------------------
+
+#include "cvthermo.h"
+#include "cvparam3.h"
+
+c inputs:
+      integer len, nd
+      integer nk(len), icb(len)
+      real t(len,nd), q(len,nd), qs(len,nd), gz(len,nd)
+      real p(len,nd) 
+      real plcl(len) ! convect3
+
+c outputs:
+      real tp(len,nd), tvp(len,nd), clw(len,nd)
+
+c local variables:
+      integer i, k
+      integer icb1(len), icbs(len), icbsmax2 ! convect3
+      real tg, qg, alv, s, ahg, tc, denom, es, rg
+      real ah0(len), cpp(len)
+      real tnk(len), qnk(len), gznk(len), ticb(len), gzicb(len)
+      real qsicb(len) ! convect3
+      real cpinv(len) ! convect3
+
+!-------------------------------------------------------------------
+! --- Calculates the lifted parcel virtual temperature at nk,
+! --- the actual temperature, and the adiabatic
+! --- liquid water content. The procedure is to solve the equation.
+!     cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+!-------------------------------------------------------------------
+
+      do 320 i=1,len
+        tnk(i)=t(i,nk(i))
+        qnk(i)=q(i,nk(i))
+        gznk(i)=gz(i,nk(i))
+c ori        ticb(i)=t(i,icb(i))
+c ori        gzicb(i)=gz(i,icb(i))
+ 320  continue
+c
+c   ***  Calculate certain parcel quantities, including static energy   ***
+c
+      do 330 i=1,len
+        ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
+     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
+        cpp(i)=cpd*(1.-qnk(i))+qnk(i)*cpv
+        cpinv(i)=1./cpp(i)
+ 330  continue
+c
+c   ***   Calculate lifted parcel quantities below cloud base   ***
+c
+        do i=1,len                      !convect3
+         icb1(i)=MAX(icb(i),2)          !convect3
+         icb1(i)=MIN(icb(i),nl)         !convect3
+c if icb is below LCL, start loop at ICB+1:
+c (icbs est le premier niveau au-dessus du LCL)
+         icbs(i)=icb1(i)                !convect3
+         if (plcl(i).lt.p(i,icb1(i))) then
+             icbs(i)=MIN(icbs(i)+1,nl)  !convect3
+         endif
+        enddo                           !convect3
+
+        do i=1,len                      !convect3
+         ticb(i)=t(i,icbs(i))           !convect3
+         gzicb(i)=gz(i,icbs(i))         !convect3
+         qsicb(i)=qs(i,icbs(i))         !convect3
+        enddo                           !convect3
+
+c
+c Re-compute icbsmax (icbsmax2):        !convect3
+c                                       !convect3
+      icbsmax2=2                        !convect3
+      do 310 i=1,len                    !convect3
+        icbsmax2=max(icbsmax2,icbs(i))  !convect3
+ 310  continue                          !convect3
+
+c initialization outputs:
+
+      do k=1,icbsmax2     ! convect3
+       do i=1,len         ! convect3
+        tp(i,k)  = 0.0    ! convect3
+        tvp(i,k) = 0.0    ! convect3
+        clw(i,k) = 0.0    ! convect3
+       enddo              ! convect3
+      enddo               ! convect3
+
+c tp and tvp below cloud base:
+
+        do 350 k=minorig,icbsmax2-1
+          do 340 i=1,len
+           tp(i,k)=tnk(i)-(gz(i,k)-gznk(i))*cpinv(i)
+           tvp(i,k)=tp(i,k)*(1.+qnk(i)/eps-qnk(i)) !whole thing (convect3)
+  340     continue
+  350   continue
+c
+c    ***  Find lifted parcel quantities above cloud base    ***
+c
+        do 360 i=1,len
+         tg=ticb(i)
+c ori         qg=qs(i,icb(i))
+         qg=qsicb(i) ! convect3
+cdebug         alv=lv0-clmcpv*(ticb(i)-t0)
+         alv=lv0-clmcpv*(ticb(i)-273.15)
+c
+c First iteration.
+c
+c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+          s=cpd*(1.-qnk(i))+cl*qnk(i)         ! convect3
+     :      +alv*alv*qg/(rrv*ticb(i)*ticb(i)) ! convect3
+          s=1./s
+c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
+          tg=tg+s*(ah0(i)-ahg)
+c ori          tg=max(tg,35.0)
+cdebug          tc=tg-t0
+          tc=tg-273.15
+          denom=243.5+tc
+          denom=MAX(denom,1.0) ! convect3
+c ori          if(tc.ge.0.0)then
+           es=6.112*exp(17.67*tc/denom)
+c ori          else
+c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+c ori          endif
+c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+          qg=eps*es/(p(i,icbs(i))-es*(1.-eps))
+c
+c Second iteration.
+c
+
+c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+c ori          s=1./s
+c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
+          tg=tg+s*(ah0(i)-ahg)
+c ori          tg=max(tg,35.0)
+cdebug          tc=tg-t0
+          tc=tg-273.15
+          denom=243.5+tc
+          denom=MAX(denom,1.0) ! convect3
+c ori          if(tc.ge.0.0)then
+           es=6.112*exp(17.67*tc/denom)
+c ori          else
+c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+c ori          end if
+c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+          qg=eps*es/(p(i,icbs(i))-es*(1.-eps))
+
+         alv=lv0-clmcpv*(ticb(i)-273.15)
+
+c ori c approximation here:
+c ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+c ori     &   -gz(i,icb(i))-alv*qg)/cpd
+
+c convect3: no approximation:
+         tp(i,icbs(i))=(ah0(i)-gz(i,icbs(i))-alv*qg)
+     :                /(cpd+(cl-cpd)*qnk(i))
+
+c ori         clw(i,icb(i))=qnk(i)-qg
+c ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
+         clw(i,icbs(i))=qnk(i)-qg
+         clw(i,icbs(i))=max(0.0,clw(i,icbs(i)))
+
+         rg=qg/(1.-qnk(i))
+c ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+c convect3: (qg utilise au lieu du vrai mixing ratio rg)
+         tvp(i,icbs(i))=tp(i,icbs(i))*(1.+qg/eps-qnk(i)) !whole thing
+
+  360   continue
+c
+c ori      do 380 k=minorig,icbsmax2
+c ori       do 370 i=1,len
+c ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
+c ori 370   continue
+c ori 380  continue
+c
+
+c -- The following is only for convect3:
+c
+c * icbs is the first level above the LCL:
+c    if plcl<p(icb), then icbs=icb+1
+c    if plcl>p(icb), then icbs=icb
+c
+c * the routine above computes tvp from minorig to icbs (included).
+c
+c * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
+c    must be known. This is the case if icbs=icb+1, but not if icbs=icb.
+c
+c * therefore, in the case icbs=icb, we compute tvp at level icb+1
+c   (tvp at other levels will be computed in cv3_undilute2.F)
+c
+
+        do i=1,len              
+         ticb(i)=t(i,icb(i)+1)   
+         gzicb(i)=gz(i,icb(i)+1) 
+         qsicb(i)=qs(i,icb(i)+1) 
+        enddo                   
+
+        do 460 i=1,len
+         tg=ticb(i)
+         qg=qsicb(i) ! convect3
+cdebug         alv=lv0-clmcpv*(ticb(i)-t0)
+         alv=lv0-clmcpv*(ticb(i)-273.15)
+c
+c First iteration.
+c
+c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+          s=cpd*(1.-qnk(i))+cl*qnk(i)         ! convect3
+     :      +alv*alv*qg/(rrv*ticb(i)*ticb(i)) ! convect3
+          s=1./s
+c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
+          tg=tg+s*(ah0(i)-ahg)
+c ori          tg=max(tg,35.0)
+cdebug          tc=tg-t0
+          tc=tg-273.15
+          denom=243.5+tc
+          denom=MAX(denom,1.0) ! convect3
+c ori          if(tc.ge.0.0)then
+           es=6.112*exp(17.67*tc/denom)
+c ori          else
+c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+c ori          endif
+c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+          qg=eps*es/(p(i,icb(i)+1)-es*(1.-eps))
+c
+c Second iteration.
+c
+
+c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+c ori          s=1./s
+c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
+          tg=tg+s*(ah0(i)-ahg)
+c ori          tg=max(tg,35.0)
+cdebug          tc=tg-t0
+          tc=tg-273.15
+          denom=243.5+tc
+          denom=MAX(denom,1.0) ! convect3
+c ori          if(tc.ge.0.0)then
+           es=6.112*exp(17.67*tc/denom)
+c ori          else
+c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+c ori          end if
+c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+          qg=eps*es/(p(i,icb(i)+1)-es*(1.-eps))
+
+         alv=lv0-clmcpv*(ticb(i)-273.15)
+
+c ori c approximation here:
+c ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+c ori     &   -gz(i,icb(i))-alv*qg)/cpd
+
+c convect3: no approximation:
+         tp(i,icb(i)+1)=(ah0(i)-gz(i,icb(i)+1)-alv*qg)
+     :                /(cpd+(cl-cpd)*qnk(i))
+
+c ori         clw(i,icb(i))=qnk(i)-qg
+c ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
+         clw(i,icb(i)+1)=qnk(i)-qg
+         clw(i,icb(i)+1)=max(0.0,clw(i,icb(i)+1))
+
+         rg=qg/(1.-qnk(i))
+c ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+c convect3: (qg utilise au lieu du vrai mixing ratio rg)
+         tvp(i,icb(i)+1)=tp(i,icb(i)+1)*(1.+qg/eps-qnk(i)) !whole thing
+
+  460   continue
+
+      return
+      end
+
+      SUBROUTINE cv3_trigger(len,nd,icb,plcl,p,th,tv,tvp
+     o                ,pbase,buoybase,iflag,sig,w0)
+      implicit none
+
+!-------------------------------------------------------------------
+! --- TRIGGERING
+!
+!	- computes the cloud base
+!   - triggering (crude in this version)
+!	- relaxation of sig and w0 when no convection
+!
+!	Caution1: if no convection, we set iflag=4 
+!              (it used to be 0 in convect3)
+!
+!	Caution2: at this stage, tvp (and thus buoy) are know up 
+!             through icb only!
+! -> the buoyancy below cloud base not (yet) set to the cloud base buoyancy
+!-------------------------------------------------------------------
+
+#include "cvparam3.h"
+
+c input:
+      integer len, nd
+      integer icb(len)
+      real plcl(len), p(len,nd)
+      real th(len,nd), tv(len,nd), tvp(len,nd)
+
+c output:
+      real pbase(len), buoybase(len)
+
+c input AND output:
+      integer iflag(len)
+      real sig(len,nd), w0(len,nd)
+
+c local variables:
+      integer i,k
+      real tvpbase, tvbase, tdif, ath, ath1
+
+c
+c ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
+c
+      do 100 i=1,len
+       pbase(i) = plcl(i) + dpbase
+       tvpbase = tvp(i,icb(i))*(pbase(i)-p(i,icb(i)+1))
+     :                        /(p(i,icb(i))-p(i,icb(i)+1))
+     :         + tvp(i,icb(i)+1)*(p(i,icb(i))-pbase(i))
+     :                          /(p(i,icb(i))-p(i,icb(i)+1))
+       tvbase = tv(i,icb(i))*(pbase(i)-p(i,icb(i)+1))
+     :                      /(p(i,icb(i))-p(i,icb(i)+1))
+     :        + tv(i,icb(i)+1)*(p(i,icb(i))-pbase(i))
+     :                        /(p(i,icb(i))-p(i,icb(i)+1))
+       buoybase(i) = tvpbase - tvbase
+100   continue 
+
+c
+c   ***   make sure that column is dry adiabatic between the surface  ***
+c   ***    and cloud base, and that lifted air is positively buoyant  ***
+c   ***                         at cloud base                         ***
+c   ***       if not, return to calling program after resetting       ***
+c   ***                        sig(i) and w0(i)                       ***
+c
+
+c oct3      do 200 i=1,len
+c oct3
+c oct3       tdif = buoybase(i)
+c oct3       ath1 = th(i,1)
+c oct3       ath  = th(i,icb(i)-1) - dttrig
+c oct3 
+c oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) then
+c oct3         do 60 k=1,nl
+c oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
+c oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
+c oct3            w0(i,k)  = beta*w0(i,k)
+c oct3   60    continue
+c oct3         iflag(i)=4 ! pour version vectorisee
+c oct3c convect3         iflag(i)=0
+c oct3cccc         return
+c oct3       endif
+c oct3
+c oct3200   continue
+ 
+c -- oct3: on reecrit la boucle 200 (pour la vectorisation)
+
+      do  60 k=1,nl
+      do 200 i=1,len
+
+       tdif = buoybase(i)
+       ath1 = th(i,1)
+       ath  = th(i,icb(i)-1) - dttrig
+
+       if (tdif.lt.dtcrit .or. ath.gt.ath1) then
+            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
+            sig(i,k) = AMAX1(sig(i,k),0.0)
+            w0(i,k)  = beta*w0(i,k)
+        iflag(i)=4 ! pour version vectorisee
+c convect3         iflag(i)=0
+       endif
+
+200   continue
+ 60   continue
+
+c fin oct3 --
+
+      return
+      end
+
+      SUBROUTINE cv3_compress( len,nloc,ncum,nd,ntra
+     :    ,iflag1,nk1,icb1,icbs1
+     :    ,plcl1,tnk1,qnk1,gznk1,pbase1,buoybase1
+     :    ,t1,q1,qs1,u1,v1,gz1,th1
+     :    ,tra1
+     :    ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1 
+     :    ,sig1,w01
+     o    ,iflag,nk,icb,icbs
+     o    ,plcl,tnk,qnk,gznk,pbase,buoybase
+     o    ,t,q,qs,u,v,gz,th
+     o    ,tra
+     o    ,h,lv,cpn,p,ph,tv,tp,tvp,clw 
+     o    ,sig,w0  )
+      implicit none
+
+#include "cvparam3.h"
+
+c inputs:
+      integer len,ncum,nd,ntra,nloc
+      integer iflag1(len),nk1(len),icb1(len),icbs1(len)
+      real plcl1(len),tnk1(len),qnk1(len),gznk1(len)
+      real pbase1(len),buoybase1(len)
+      real t1(len,nd),q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)
+      real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)
+      real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
+      real tvp1(len,nd),clw1(len,nd)
+      real th1(len,nd)
+      real sig1(len,nd), w01(len,nd)
+      real tra1(len,nd,ntra)
+
+c outputs:
+c en fait, on a nloc=len pour l'instant (cf cv_driver)
+      integer iflag(nloc),nk(nloc),icb(nloc),icbs(nloc)
+      real plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
+      real pbase(nloc),buoybase(nloc)
+      real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)
+      real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)
+      real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)
+      real tvp(nloc,nd),clw(nloc,nd)
+      real th(nloc,nd)
+      real sig(nloc,nd), w0(nloc,nd) 
+      real tra(nloc,nd,ntra)
+
+c local variables:
+      integer i,k,nn,j
+
+
+      do 110 k=1,nl+1
+       nn=0
+      do 100 i=1,len
+      if(iflag1(i).eq.0)then
+        nn=nn+1
+        sig(nn,k)=sig1(i,k)
+        w0(nn,k)=w01(i,k)
+        t(nn,k)=t1(i,k)
+        q(nn,k)=q1(i,k)
+        qs(nn,k)=qs1(i,k)
+        u(nn,k)=u1(i,k)
+        v(nn,k)=v1(i,k)
+        gz(nn,k)=gz1(i,k)
+        h(nn,k)=h1(i,k)
+        lv(nn,k)=lv1(i,k)
+        cpn(nn,k)=cpn1(i,k)
+        p(nn,k)=p1(i,k)
+        ph(nn,k)=ph1(i,k)
+        tv(nn,k)=tv1(i,k)
+        tp(nn,k)=tp1(i,k)
+        tvp(nn,k)=tvp1(i,k)
+        clw(nn,k)=clw1(i,k)
+        th(nn,k)=th1(i,k)
+      endif
+ 100    continue
+ 110  continue
+
+      do 121 j=1,ntra
+ccccc      do 111 k=1,nl+1
+      do 111 k=1,nd
+       nn=0
+      do 101 i=1,len
+      if(iflag1(i).eq.0)then
+       nn=nn+1
+       tra(nn,k,j)=tra1(i,k,j)
+      endif
+ 101  continue
+ 111  continue
+ 121  continue
+
+      if (nn.ne.ncum) then
+         print*,'strange! nn not equal to ncum: ',nn,ncum
+         stop
+      endif
+
+      nn=0
+      do 150 i=1,len
+      if(iflag1(i).eq.0)then
+      nn=nn+1
+      pbase(nn)=pbase1(i)
+      buoybase(nn)=buoybase1(i)
+      plcl(nn)=plcl1(i)
+      tnk(nn)=tnk1(i)
+      qnk(nn)=qnk1(i)
+      gznk(nn)=gznk1(i)
+      nk(nn)=nk1(i)
+      icb(nn)=icb1(i)
+      icbs(nn)=icbs1(i)
+      iflag(nn)=iflag1(i)
+      endif
+ 150  continue
+
+      return
+      end
+
+      SUBROUTINE cv3_undilute2(nloc,ncum,nd,icb,icbs,nk
+     :                       ,tnk,qnk,gznk,t,q,qs,gz
+     :                       ,p,h,tv,lv,pbase,buoybase,plcl
+     o                       ,inb,tp,tvp,clw,hp,ep,sigp,buoy)
+      implicit none
+
+C---------------------------------------------------------------------
+C Purpose:
+C     FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+C     &
+C     COMPUTE THE PRECIPITATION EFFICIENCIES AND THE 
+C     FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+C     &
+C     FIND THE LEVEL OF NEUTRAL BUOYANCY
+C
+C Main differences convect3/convect4:
+C	- icbs (input) is the first level above LCL (may differ from icb)
+C	- many minor differences in the iterations
+C	- condensed water not removed from tvp in convect3
+C   - vertical profile of buoyancy computed here (use of buoybase)
+C   - the determination of inb is different
+C   - no inb1, only inb in output
+C---------------------------------------------------------------------
+
+#include "cvthermo.h"
+#include "cvparam3.h"
+
+c inputs:
+      integer ncum, nd, nloc
+      integer icb(nloc), icbs(nloc), nk(nloc)
+      real t(nloc,nd), q(nloc,nd), qs(nloc,nd), gz(nloc,nd)
+      real p(nloc,nd)
+      real tnk(nloc), qnk(nloc), gznk(nloc)
+      real lv(nloc,nd), tv(nloc,nd), h(nloc,nd)
+      real pbase(nloc), buoybase(nloc), plcl(nloc)
+
+c outputs:
+      integer inb(nloc)
+      real tp(nloc,nd), tvp(nloc,nd), clw(nloc,nd)
+      real ep(nloc,nd), sigp(nloc,nd), hp(nloc,nd)
+      real buoy(nloc,nd)
+
+c local variables:
+      integer i, k
+      real tg,qg,ahg,alv,s,tc,es,denom,rg,tca,elacrit
+      real by, defrac, pden
+      real ah0(nloc), cape(nloc), capem(nloc), byp(nloc)
+      logical lcape(nloc)
+
+!=====================================================================
+! --- SOME INITIALIZATIONS
+!=====================================================================
+
+      do 170 k=1,nl
+      do 160 i=1,ncum
+       ep(i,k)=0.0
+       sigp(i,k)=spfac
+ 160  continue
+ 170  continue
+
+!=====================================================================
+! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+!=====================================================================
+c
+c ---       The procedure is to solve the equation.
+c              cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+c
+c   ***  Calculate certain parcel quantities, including static energy   ***
+c
+c
+      do 240 i=1,ncum
+         ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
+cdebug     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
+     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
+ 240  continue
+c
+c
+c    ***  Find lifted parcel quantities above cloud base    ***
+c
+c
+	do 300 k=minorig+1,nl
+	  do 290 i=1,ncum
+c ori	    if(k.ge.(icb(i)+1))then
+	    if(k.ge.(icbs(i)+1))then ! convect3
+	      tg=t(i,k)
+	      qg=qs(i,k)
+cdebug	      alv=lv0-clmcpv*(t(i,k)-t0)
+	      alv=lv0-clmcpv*(t(i,k)-273.15)
+c
+c First iteration.
+c
+c ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+           s=cpd*(1.-qnk(i))+cl*qnk(i)      ! convect3
+     :      +alv*alv*qg/(rrv*t(i,k)*t(i,k)) ! convect3
+	       s=1./s
+c ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+           ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gz(i,k) ! convect3
+	       tg=tg+s*(ah0(i)-ahg)
+c ori	       tg=max(tg,35.0)
+cdebug	       tc=tg-t0
+	       tc=tg-273.15
+	       denom=243.5+tc
+           denom=MAX(denom,1.0) ! convect3
+c ori	       if(tc.ge.0.0)then
+			es=6.112*exp(17.67*tc/denom)
+c ori	       else
+c ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+c ori	       endif
+			qg=eps*es/(p(i,k)-es*(1.-eps))
+c
+c Second iteration.
+c
+c ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+c ori	       s=1./s
+c ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+           ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gz(i,k) ! convect3
+	       tg=tg+s*(ah0(i)-ahg)
+c ori	       tg=max(tg,35.0)
+cdebug	       tc=tg-t0
+	       tc=tg-273.15
+	       denom=243.5+tc
+           denom=MAX(denom,1.0) ! convect3
+c ori	       if(tc.ge.0.0)then
+			es=6.112*exp(17.67*tc/denom)
+c ori	       else
+c ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+c ori	       endif
+			qg=eps*es/(p(i,k)-es*(1.-eps))
+c
+cdebug	       alv=lv0-clmcpv*(t(i,k)-t0)
+	       alv=lv0-clmcpv*(t(i,k)-273.15)
+c      print*,'cpd dans convect2 ',cpd
+c      print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
+c      print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
+
+c ori c approximation here:
+c ori        tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
+
+c convect3: no approximation:
+           tp(i,k)=(ah0(i)-gz(i,k)-alv*qg)/(cpd+(cl-cpd)*qnk(i))
+
+               clw(i,k)=qnk(i)-qg
+               clw(i,k)=max(0.0,clw(i,k))
+               rg=qg/(1.-qnk(i))
+c ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
+c convect3: (qg utilise au lieu du vrai mixing ratio rg):
+               tvp(i,k)=tp(i,k)*(1.+qg/eps-qnk(i)) ! whole thing
+            endif
+  290     continue
+  300   continue
+c
+!=====================================================================
+! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
+! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
+! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
+!=====================================================================
+c
+c ori      do 320 k=minorig+1,nl
+      do 320 k=1,nl ! convect3
+        do 310 i=1,ncum
+           pden=ptcrit-pbcrit
+           ep(i,k)=(plcl(i)-p(i,k)-pbcrit)/pden*epmax
+           ep(i,k)=amax1(ep(i,k),0.0)
+           ep(i,k)=amin1(ep(i,k),epmax)
+           sigp(i,k)=spfac
+c ori          if(k.ge.(nk(i)+1))then
+c ori            tca=tp(i,k)-t0
+c ori            if(tca.ge.0.0)then
+c ori              elacrit=elcrit
+c ori            else
+c ori              elacrit=elcrit*(1.0-tca/tlcrit)
+c ori            endif
+c ori            elacrit=max(elacrit,0.0)
+c ori            ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
+c ori            ep(i,k)=max(ep(i,k),0.0 )
+c ori            ep(i,k)=min(ep(i,k),1.0 )
+c ori            sigp(i,k)=sigs
+c ori          endif
+ 310    continue
+ 320  continue
+c
+!=====================================================================
+! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
+! --- VIRTUAL TEMPERATURE
+!=====================================================================
+c
+c dans convect3, tvp est calcule en une seule fois, et sans retirer
+c l'eau condensee (~> reversible CAPE)
+c
+c ori      do 340 k=minorig+1,nl
+c ori        do 330 i=1,ncum
+c ori        if(k.ge.(icb(i)+1))then
+c ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
+c oric         print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
+c oric         print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
+c ori        endif
+c ori 330    continue
+c ori 340  continue
+
+c ori      do 350 i=1,ncum
+c ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
+c ori 350  continue
+
+      do 350 i=1,ncum       ! convect3
+       tp(i,nlp)=tp(i,nl)   ! convect3
+ 350  continue              ! convect3
+c
+c=====================================================================
+c  --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
+c===================================================================== 
+
+c-- this is for convect3 only:
+
+c first estimate of buoyancy:
+
+      do 500 i=1,ncum
+       do 501 k=1,nl
+        buoy(i,k)=tvp(i,k)-tv(i,k) 
+ 501   continue
+ 500  continue
+
+c set buoyancy=buoybase for all levels below base
+c for safety, set buoy(icb)=buoybase
+
+      do 505 i=1,ncum
+       do 506 k=1,nl
+        if((k.ge.icb(i)).and.(k.le.nl).and.(p(i,k).ge.pbase(i)))then
+         buoy(i,k)=buoybase(i)
+        endif
+ 506   continue
+       buoy(icb(i),k)=buoybase(i)
+ 505  continue
+
+c-- end convect3
+
+c=====================================================================
+c  --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
+c  --- LEVEL OF NEUTRAL BUOYANCY
+c=====================================================================
+c
+c-- this is for convect3 only:
+
+      do 510 i=1,ncum
+       inb(i)=nl-1
+ 510  continue
+
+      do 530 i=1,ncum
+       do 535 k=1,nl-1
+        if ((k.ge.icb(i)).and.(buoy(i,k).lt.dtovsh)) then
+         inb(i)=MIN(inb(i),k)
+        endif
+ 535   continue
+ 530  continue
+
+c-- end convect3
+
+c ori      do 510 i=1,ncum
+c ori        cape(i)=0.0
+c ori        capem(i)=0.0
+c ori        inb(i)=icb(i)+1
+c ori        inb1(i)=inb(i)
+c ori 510  continue
+c
+c Originial Code
+c
+c     do 530 k=minorig+1,nl-1
+c       do 520 i=1,ncum
+c         if(k.ge.(icb(i)+1))then
+c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+c           byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+c           cape(i)=cape(i)+by
+c           if(by.ge.0.0)inb1(i)=k+1
+c           if(cape(i).gt.0.0)then
+c             inb(i)=k+1
+c             capem(i)=cape(i)
+c           endif
+c         endif
+c520    continue
+c530  continue
+c     do 540 i=1,ncum
+c         byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
+c         cape(i)=capem(i)+byp
+c         defrac=capem(i)-cape(i)
+c         defrac=max(defrac,0.001)
+c         frac(i)=-cape(i)/defrac
+c         frac(i)=min(frac(i),1.0)
+c         frac(i)=max(frac(i),0.0)
+c540   continue
+c
+c K Emanuel fix
+c
+c     call zilch(byp,ncum)
+c     do 530 k=minorig+1,nl-1
+c       do 520 i=1,ncum
+c         if(k.ge.(icb(i)+1))then
+c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+c           cape(i)=cape(i)+by
+c           if(by.ge.0.0)inb1(i)=k+1
+c           if(cape(i).gt.0.0)then
+c             inb(i)=k+1
+c             capem(i)=cape(i)
+c             byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+c           endif
+c         endif
+c520    continue
+c530  continue
+c     do 540 i=1,ncum
+c         inb(i)=max(inb(i),inb1(i))
+c         cape(i)=capem(i)+byp(i)
+c         defrac=capem(i)-cape(i)
+c         defrac=max(defrac,0.001)
+c         frac(i)=-cape(i)/defrac
+c         frac(i)=min(frac(i),1.0)
+c         frac(i)=max(frac(i),0.0)
+c540   continue
+c
+c J Teixeira fix
+c
+c ori      call zilch(byp,ncum)
+c ori      do 515 i=1,ncum
+c ori        lcape(i)=.true.
+c ori 515  continue
+c ori      do 530 k=minorig+1,nl-1
+c ori        do 520 i=1,ncum
+c ori          if(cape(i).lt.0.0)lcape(i)=.false.
+c ori          if((k.ge.(icb(i)+1)).and.lcape(i))then
+c ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+c ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+c ori            cape(i)=cape(i)+by
+c ori            if(by.ge.0.0)inb1(i)=k+1
+c ori            if(cape(i).gt.0.0)then
+c ori              inb(i)=k+1
+c ori              capem(i)=cape(i)
+c ori            endif
+c ori          endif
+c ori 520    continue
+c ori 530  continue
+c ori      do 540 i=1,ncum
+c ori          cape(i)=capem(i)+byp(i)
+c ori          defrac=capem(i)-cape(i)
+c ori          defrac=max(defrac,0.001)
+c ori          frac(i)=-cape(i)/defrac
+c ori          frac(i)=min(frac(i),1.0)
+c ori          frac(i)=max(frac(i),0.0)
+c ori 540  continue
+c
+c=====================================================================
+c ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
+c=====================================================================
+c
+      do i=1,ncum*nlp
+       hp(i,1)=h(i,1)
+      enddo
+
+      do 600 k=minorig+1,nl
+        do 590 i=1,ncum
+        if((k.ge.icb(i)).and.(k.le.inb(i)))then
+          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
+        endif
+ 590    continue
+ 600  continue
+
+        return
+        end
+
+      SUBROUTINE cv3_closure(nloc,ncum,nd,icb,inb
+     :                      ,pbase,p,ph,tv,buoy
+     o                      ,sig,w0,cape,m)
+      implicit none
+
+!===================================================================
+! ---  CLOSURE OF CONVECT3
+!
+! vectorization: S. Bony
+!===================================================================
+
+#include "cvthermo.h"
+#include "cvparam3.h"
+
+c input:
+      integer ncum, nd, nloc
+      integer icb(nloc), inb(nloc)
+      real pbase(nloc)
+      real p(nloc,nd), ph(nloc,nd+1)
+      real tv(nloc,nd), buoy(nloc,nd)
+
+c input/output:
+      real sig(nloc,nd), w0(nloc,nd)
+
+c output:
+      real cape(nloc)
+      real m(nloc,nd)
+
+c local variables:
+      integer i, j, k, icbmax
+      real deltap, fac, w, amu
+      real dtmin(nloc,nd), sigold(nloc,nd)
+
+
+c -------------------------------------------------------
+c -- Initialization
+c -------------------------------------------------------
+
+      do k=1,nl
+       do i=1,ncum
+        m(i,k)=0.0
+       enddo
+      enddo
+
+c -------------------------------------------------------
+c -- Reset sig(i) and w0(i) for i>inb and i<icb   
+c -------------------------------------------------------
+      
+c update sig and w0 above LNB:
+
+      do 100 k=1,nl-1
+       do 110 i=1,ncum
+        if ((inb(i).lt.(nl-1)).and.(k.ge.(inb(i)+1)))then
+         sig(i,k)=beta*sig(i,k)
+     :            +2.*alpha*buoy(i,inb(i))*ABS(buoy(i,inb(i)))
+         sig(i,k)=AMAX1(sig(i,k),0.0)
+         w0(i,k)=beta*w0(i,k)
+        endif
+ 110   continue
+ 100  continue
+
+c compute icbmax:
+
+      icbmax=2
+      do 200 i=1,ncum
+        icbmax=MAX(icbmax,icb(i))
+ 200  continue
+
+c update sig and w0 below cloud base:
+
+      do 300 k=1,icbmax
+       do 310 i=1,ncum
+        if (k.le.icb(i))then
+         sig(i,k)=beta*sig(i,k)-2.*alpha*buoy(i,icb(i))*buoy(i,icb(i))
+         sig(i,k)=amax1(sig(i,k),0.0)
+         w0(i,k)=beta*w0(i,k)
+        endif
+310    continue
+300    continue
+
+c!      if(inb.lt.(nl-1))then
+c!         do 85 i=inb+1,nl-1
+c!            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
+c!     1              abs(buoy(inb))
+c!            sig(i)=amax1(sig(i),0.0)
+c!            w0(i)=beta*w0(i)
+c!   85    continue
+c!      end if
+
+c!      do 87 i=1,icb
+c!         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
+c!         sig(i)=amax1(sig(i),0.0)
+c!         w0(i)=beta*w0(i)
+c!   87 continue
+
+c -------------------------------------------------------------
+c -- Reset fractional areas of updrafts and w0 at initial time
+c -- and after 10 time steps of no convection
+c -------------------------------------------------------------
+      
+      do 400 k=1,nl-1
+       do 410 i=1,ncum
+        if (sig(i,nd).lt.1.5.or.sig(i,nd).gt.12.0)then
+         sig(i,k)=0.0
+         w0(i,k)=0.0
+        endif
+ 410   continue
+ 400  continue
+
+c -------------------------------------------------------------
+c -- Calculate convective available potential energy (cape),  
+c -- vertical velocity (w), fractional area covered by    
+c -- undilute updraft (sig), and updraft mass flux (m)  
+c -------------------------------------------------------------
+
+      do 500 i=1,ncum
+       cape(i)=0.0
+ 500  continue
+
+c compute dtmin (minimum buoyancy between ICB and given level k):
+
+      do i=1,ncum
+       do k=1,nl
+         dtmin(i,k)=100.0 
+       enddo
+      enddo
+
+      do 550 i=1,ncum
+       do 560 k=1,nl
+         do 570 j=minorig,nl
+          if ( (k.ge.(icb(i)+1)).and.(k.le.inb(i)).and.
+     :         (j.ge.icb(i)).and.(j.le.(k-1)) )then
+           dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
+          endif
+ 570     continue
+ 560   continue
+ 550  continue
+
+c the interval on which cape is computed starts at pbase :
+
+      do 600 k=1,nl
+       do 610 i=1,ncum
+
+        if ((k.ge.(icb(i)+1)).and.(k.le.inb(i))) then
+
+         deltap = MIN(pbase(i),ph(i,k-1))-MIN(pbase(i),ph(i,k))
+         cape(i)=cape(i)+rrd*buoy(i,k-1)*deltap/p(i,k-1)
+         cape(i)=AMAX1(0.0,cape(i))
+         sigold(i,k)=sig(i,k)
+
+c         dtmin(i,k)=100.0
+c         do 97 j=icb(i),k-1 ! mauvaise vectorisation
+c          dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
+c  97     continue
+
+         sig(i,k)=beta*sig(i,k)+alpha*dtmin(i,k)*ABS(dtmin(i,k))
+         sig(i,k)=amax1(sig(i,k),0.0)
+         sig(i,k)=amin1(sig(i,k),0.01)
+         fac=AMIN1(((dtcrit-dtmin(i,k))/dtcrit),1.0)
+         w=(1.-beta)*fac*SQRT(cape(i))+beta*w0(i,k)
+         amu=0.5*(sig(i,k)+sigold(i,k))*w
+         m(i,k)=amu*0.007*p(i,k)*(ph(i,k)-ph(i,k+1))/tv(i,k)
+         w0(i,k)=w
+        endif
+
+ 610   continue
+ 600  continue
+
+      do 700 i=1,ncum
+       w0(i,icb(i))=0.5*w0(i,icb(i)+1)
+       m(i,icb(i))=0.5*m(i,icb(i)+1)
+     :             *(ph(i,icb(i))-ph(i,icb(i)+1))
+     :             /(ph(i,icb(i)+1)-ph(i,icb(i)+2))
+       sig(i,icb(i))=sig(i,icb(i)+1)
+       sig(i,icb(i)-1)=sig(i,icb(i))
+ 700  continue
+
+
+c!      cape=0.0
+c!      do 98 i=icb+1,inb
+c!         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
+c!         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
+c!         dcape=rrd*buoy(i-1)*deltap/p(i-1)
+c!         dlnp=deltap/p(i-1)
+c!         cape=amax1(0.0,cape)
+c!         sigold=sig(i)
+
+c!         dtmin=100.0
+c!         do 97 j=icb,i-1
+c!            dtmin=amin1(dtmin,buoy(j))
+c!   97    continue
+
+c!         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
+c!         sig(i)=amax1(sig(i),0.0)
+c!         sig(i)=amin1(sig(i),0.01)
+c!         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
+c!         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
+c!         amu=0.5*(sig(i)+sigold)*w
+c!         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
+c!         w0(i)=w
+c!   98 continue
+c!      w0(icb)=0.5*w0(icb+1)
+c!      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
+c!      sig(icb)=sig(icb+1)
+c!      sig(icb-1)=sig(icb)
+
+       return
+       end
+
+      SUBROUTINE cv3_mixing(nloc,ncum,nd,na,ntra,icb,nk,inb
+     :                    ,ph,t,rr,rs,u,v,tra,h,lv,qnk
+     :                    ,hp,tv,tvp,ep,clw,m,sig
+     :   ,ment,qent,uent,vent,sij,elij,ments,qents,traent)
+      implicit none
+
+!---------------------------------------------------------------------
+! a faire:
+! 	- changer rr(il,1) -> qnk(il)
+!   - vectorisation de la partie normalisation des flux (do 789...)
+!---------------------------------------------------------------------
+
+#include "cvthermo.h"
+#include "cvparam3.h"
+
+c inputs:
+      integer ncum, nd, na, ntra, nloc
+      integer icb(nloc), inb(nloc), nk(nloc)
+      real sig(nloc,nd)
+      real qnk(nloc)
+      real ph(nloc,nd+1)
+      real t(nloc,nd), rr(nloc,nd), rs(nloc,nd)
+      real u(nloc,nd), v(nloc,nd)
+      real tra(nloc,nd,ntra) ! input of convect3
+      real lv(nloc,na), h(nloc,na), hp(nloc,na)
+      real tv(nloc,na), tvp(nloc,na), ep(nloc,na), clw(nloc,na)
+      real m(nloc,na)        ! input of convect3
+
+c outputs:
+      real ment(nloc,na,na), qent(nloc,na,na)
+      real uent(nloc,na,na), vent(nloc,na,na)
+      real sij(nloc,na,na), elij(nloc,na,na)
+      real traent(nloc,nd,nd,ntra) 
+      real ments(nloc,nd,nd), qents(nloc,nd,nd)
+      real sigij(nloc,nd,nd)
+
+c local variables:
+      integer i, j, k, il, im, jm
+      integer num1, num2
+      integer nent(nloc,na)
+      real rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
+      real alt, smid, sjmin, sjmax, delp, delm
+      real asij(nloc), smax(nloc), scrit(nloc)
+      real asum(nloc,nd),bsum(nloc,nd),csum(nloc,nd)
+      real wgh
+      logical lwork(nloc)
+
+c=====================================================================
+c --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
+c=====================================================================
+
+c ori        do 360 i=1,ncum*nlp
+        do 361 j=1,nl
+        do 360 i=1,ncum
+          nent(i,j)=0
+c in convect3, m is computed in cv3_closure
+c ori          m(i,1)=0.0
+ 360    continue
+ 361    continue
+
+c ori      do 400 k=1,nlp
+c ori       do 390 j=1,nlp
+      do 400 j=1,nl
+       do 390 k=1,nl
+          do 385 i=1,ncum
+            qent(i,k,j)=rr(i,j)
+            uent(i,k,j)=u(i,j)
+            vent(i,k,j)=v(i,j)
+            elij(i,k,j)=0.0
+            ment(i,k,j)=0.0
+            sij(i,k,j)=0.0
+ 385      continue
+ 390    continue
+ 400  continue
+
+      do k=1,ntra
+       do j=1,nd  ! instead nlp
+        do i=1,nd ! instead nlp
+         do il=1,ncum
+            traent(il,i,j,k)=tra(il,j,k)
+         enddo
+        enddo
+       enddo
+      enddo
+
+c=====================================================================
+c --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
+c --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
+c --- FRACTION (sij)
+c=====================================================================
+
+      do 750 i=minorig+1, nl
+
+       do 710 j=minorig,nl
+        do 700 il=1,ncum
+         if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+     :      (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
+
+          rti=rr(il,1)-ep(il,i)*clw(il,i)
+          bf2=1.+lv(il,j)*lv(il,j)*rs(il,j)/(rrv*t(il,j)*t(il,j)*cpd)
+          anum=h(il,j)-hp(il,i)+(cpv-cpd)*t(il,j)*(rti-rr(il,j))
+          denom=h(il,i)-hp(il,i)+(cpd-cpv)*(rr(il,i)-rti)*t(il,j)
+          dei=denom
+          if(abs(dei).lt.0.01)dei=0.01
+          sij(il,i,j)=anum/dei
+          sij(il,i,i)=1.0
+          altem=sij(il,i,j)*rr(il,i)+(1.-sij(il,i,j))*rti-rs(il,j)
+          altem=altem/bf2
+          cwat=clw(il,j)*(1.-ep(il,j))
+          stemp=sij(il,i,j)
+          if((stemp.lt.0.0.or.stemp.gt.1.0.or.altem.gt.cwat)
+     :                 .and.j.gt.i)then
+           anum=anum-lv(il,j)*(rti-rs(il,j)-cwat*bf2)
+           denom=denom+lv(il,j)*(rr(il,i)-rti)
+           if(abs(denom).lt.0.01)denom=0.01
+           sij(il,i,j)=anum/denom
+           altem=sij(il,i,j)*rr(il,i)+(1.-sij(il,i,j))*rti-rs(il,j)
+           altem=altem-(bf2-1.)*cwat
+          end if
+         if(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)then
+          qent(il,i,j)=sij(il,i,j)*rr(il,i)+(1.-sij(il,i,j))*rti
+          uent(il,i,j)=sij(il,i,j)*u(il,i)+(1.-sij(il,i,j))*u(il,nk(il))
+          vent(il,i,j)=sij(il,i,j)*v(il,i)+(1.-sij(il,i,j))*v(il,nk(il))
+c!!!      do k=1,ntra
+c!!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+c!!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
+c!!!      end do
+          elij(il,i,j)=altem
+          elij(il,i,j)=amax1(0.0,elij(il,i,j))
+          ment(il,i,j)=m(il,i)/(1.-sij(il,i,j))
+          nent(il,i)=nent(il,i)+1
+         end if
+         sij(il,i,j)=amax1(0.0,sij(il,i,j))
+         sij(il,i,j)=amin1(1.0,sij(il,i,j))
+         endif ! new
+ 700   continue
+ 710  continue
+
+       do k=1,ntra
+        do j=minorig,nl
+         do il=1,ncum
+          if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
+            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
+          endif
+         enddo
+        enddo
+       enddo
+
+c
+c   ***   if no air can entrain at level i assume that updraft detrains  ***
+c   ***   at that level and calculate detrained air flux and properties  ***
+c
+
+c@      do 170 i=icb(il),inb(il)
+
+      do 740 il=1,ncum
+      if ((i.ge.icb(il)).and.(i.le.inb(il)).and.(nent(il,i).eq.0)) then 
+c@      if(nent(il,i).eq.0)then
+      ment(il,i,i)=m(il,i)
+      qent(il,i,i)=rr(il,nk(il))-ep(il,i)*clw(il,i)
+      uent(il,i,i)=u(il,nk(il))
+      vent(il,i,i)=v(il,nk(il))
+      elij(il,i,i)=clw(il,i)
+      sij(il,i,i)=1.0
+      end if
+ 740  continue
+ 750  continue
+ 
+      do j=1,ntra
+       do i=minorig+1,nl
+        do il=1,ncum
+         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
+          traent(il,i,i,j)=tra(il,nk(il),j)
+         endif
+        enddo
+       enddo
+      enddo
+
+      do 100 j=minorig,nl
+      do 101 i=minorig,nl
+      do 102 il=1,ncum
+      if ((j.ge.(icb(il)-1)).and.(j.le.inb(il))
+     :    .and.(i.ge.icb(il)).and.(i.le.inb(il)))then
+       sigij(il,i,j)=sij(il,i,j)
+      endif
+ 102  continue
+ 101  continue
+ 100  continue
+c@      enddo
+
+c@170   continue
+
+c=====================================================================
+c   ---  NORMALIZE ENTRAINED AIR MASS FLUXES
+c   ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
+c=====================================================================
+
+      call zilch(asum,ncum*nd)
+      call zilch(bsum,ncum*nd)
+      call zilch(csum,ncum*nd)
+
+      do il=1,ncum
+       lwork(il) = .FALSE.
+      enddo
+
+      DO 789 i=minorig+1,nl 
+
+      num1=0
+      do il=1,ncum
+       if ( i.ge.icb(il) .and. i.le.inb(il) ) num1=num1+1
+      enddo
+      if (num1.le.0) goto 789
+
+
+      do 781 il=1,ncum
+       if ( i.ge.icb(il) .and. i.le.inb(il) ) then
+        lwork(il)=(nent(il,i).ne.0)
+        qp=rr(il,1)-ep(il,i)*clw(il,i)
+        anum=h(il,i)-hp(il,i)-lv(il,i)*(qp-rs(il,i))
+     :           +(cpv-cpd)*t(il,i)*(qp-rr(il,i))
+        denom=h(il,i)-hp(il,i)+lv(il,i)*(rr(il,i)-qp)
+     :           +(cpd-cpv)*t(il,i)*(rr(il,i)-qp)
+        if(abs(denom).lt.0.01)denom=0.01
+        scrit(il)=anum/denom
+        alt=qp-rs(il,i)+scrit(il)*(rr(il,i)-qp)
+        if(scrit(il).le.0.0.or.alt.le.0.0)scrit(il)=1.0
+        smax(il)=0.0
+        asij(il)=0.0
+       endif
+781   continue
+
+      do 175 j=nl,minorig,-1
+
+      num2=0
+      do il=1,ncum
+       if ( i.ge.icb(il) .and. i.le.inb(il) .and.
+     :      j.ge.(icb(il)-1) .and. j.le.inb(il) 
+     :      .and. lwork(il) ) num2=num2+1
+      enddo
+      if (num2.le.0) goto 175
+
+      do 782 il=1,ncum
+      if ( i.ge.icb(il) .and. i.le.inb(il) .and.
+     :      j.ge.(icb(il)-1) .and. j.le.inb(il) 
+     :      .and. lwork(il) ) then
+
+       if(sij(il,i,j).gt.1.0e-16.and.sij(il,i,j).lt.0.95)then
+        wgh=1.0
+        if(j.gt.i)then
+         sjmax=amax1(sij(il,i,j+1),smax(il))
+         sjmax=amin1(sjmax,scrit(il))
+         smax(il)=amax1(sij(il,i,j),smax(il))
+         sjmin=amax1(sij(il,i,j-1),smax(il))
+         sjmin=amin1(sjmin,scrit(il))
+         if(sij(il,i,j).lt.(smax(il)-1.0e-16))wgh=0.0
+         smid=amin1(sij(il,i,j),scrit(il))
+        else
+         sjmax=amax1(sij(il,i,j+1),scrit(il))
+         smid=amax1(sij(il,i,j),scrit(il))
+         sjmin=0.0
+         if(j.gt.1)sjmin=sij(il,i,j-1)
+         sjmin=amax1(sjmin,scrit(il))
+        endif
+        delp=abs(sjmax-smid)
+        delm=abs(sjmin-smid)
+        asij(il)=asij(il)+wgh*(delp+delm)
+        ment(il,i,j)=ment(il,i,j)*(delp+delm)*wgh
+       endif
+      endif
+782   continue
+
+175   continue
+
+      do il=1,ncum
+       if (i.ge.icb(il).and.i.le.inb(il).and.lwork(il)) then
+        asij(il)=amax1(1.0e-16,asij(il))
+        asij(il)=1.0/asij(il)
+        asum(il,i)=0.0
+        bsum(il,i)=0.0
+        csum(il,i)=0.0
+       endif
+      enddo
+
+      do 180 j=minorig,nl
+       do il=1,ncum
+        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
+     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
+         ment(il,i,j)=ment(il,i,j)*asij(il)
+        endif
+       enddo
+180   continue
+
+      do 190 j=minorig,nl
+       do il=1,ncum
+        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
+     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
+         asum(il,i)=asum(il,i)+ment(il,i,j)
+         ment(il,i,j)=ment(il,i,j)*sig(il,j)
+         bsum(il,i)=bsum(il,i)+ment(il,i,j)
+        endif
+       enddo
+190   continue
+
+      do il=1,ncum
+       if (i.ge.icb(il).and.i.le.inb(il).and.lwork(il)) then
+        bsum(il,i)=amax1(bsum(il,i),1.0e-16)
+        bsum(il,i)=1.0/bsum(il,i)
+       endif
+      enddo
+
+      do 195 j=minorig,nl
+       do il=1,ncum
+        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
+     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
+         ment(il,i,j)=ment(il,i,j)*asum(il,i)*bsum(il,i)
+        endif
+       enddo
+195   continue
+
+      do 197 j=minorig,nl
+       do il=1,ncum
+        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
+     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
+         csum(il,i)=csum(il,i)+ment(il,i,j)
+        endif
+       enddo
+197   continue
+
+      do il=1,ncum
+       if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
+     :     .and. csum(il,i).lt.m(il,i) ) then
+        nent(il,i)=0
+        ment(il,i,i)=m(il,i)
+        qent(il,i,i)=rr(il,1)-ep(il,i)*clw(il,i)
+        uent(il,i,i)=u(il,nk(il))
+        vent(il,i,i)=v(il,nk(il))
+        elij(il,i,i)=clw(il,i)
+        sij(il,i,i)=1.0
+       endif
+      enddo ! il
+
+      do j=1,ntra
+       do il=1,ncum
+        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
+     :     .and. csum(il,i).lt.m(il,i) ) then
+         traent(il,i,i,j)=tra(il,nk(il),j)
+        endif
+       enddo
+      enddo
+
+789   continue
+      
+      do jm=1,nd
+       do im=1,nd
+        do 999 il=1,ncum
+         qents(il,im,jm)=qent(il,im,jm)
+         ments(il,im,jm)=ment(il,im,jm)
+999     continue
+       enddo
+      enddo
+
+      return
+      end
+
+
+      SUBROUTINE cv3_unsat(nloc,ncum,nd,na,ntra,icb,inb
+     :              ,t,rr,rs,gz,u,v,tra,p,ph
+     :              ,th,tv,lv,cpn,ep,sigp,clw
+     :              ,m,ment,elij,delt,plcl
+     :              ,mp,rp,up,vp,trap,wt,water,evap,b)
+      implicit none
+
+
+#include "cvthermo.h"
+#include "cvparam3.h"
+#include "cvflag.h"
+
+c inputs:
+      integer ncum, nd, na, ntra, nloc
+      integer icb(nloc), inb(nloc)
+      real delt, plcl(nloc)
+      real t(nloc,nd), rr(nloc,nd), rs(nloc,nd)
+      real u(nloc,nd), v(nloc,nd)
+      real tra(nloc,nd,ntra)
+      real p(nloc,nd), ph(nloc,nd+1)
+      real th(nloc,na), gz(nloc,na)
+      real lv(nloc,na), ep(nloc,na), sigp(nloc,na), clw(nloc,na)
+      real cpn(nloc,na), tv(nloc,na)
+      real m(nloc,na), ment(nloc,na,na), elij(nloc,na,na)
+
+c outputs:
+      real mp(nloc,na), rp(nloc,na), up(nloc,na), vp(nloc,na)
+      real water(nloc,na), evap(nloc,na), wt(nloc,na)
+      real trap(nloc,na,ntra)
+      real b(nloc,na)
+
+c local variables
+      integer i,j,k,il,num1
+      real tinv, delti
+      real awat, afac, afac1, afac2, bfac
+      real pr1, pr2, sigt, b6, c6, revap, tevap, delth
+      real amfac, amp2, xf, tf, fac2, ur, sru, fac, d, af, bf
+      real ampmax
+      real lvcp(nloc,na)
+      real wdtrain(nloc)
+      logical lwork(nloc)
+
+
+c------------------------------------------------------
+
+        delti = 1./delt
+        tinv=1./3.
+
+        do i=1,nl
+         do il=1,ncum
+          mp(il,i)=0.0
+          rp(il,i)=rr(il,i)
+          up(il,i)=u(il,i)
+          vp(il,i)=v(il,i)
+          wt(il,i)=0.001
+          water(il,i)=0.0
+          evap(il,i)=0.0
+          b(il,i)=0.0
+          lvcp(il,i)=lv(il,i)/cpn(il,i)
+         enddo
+        enddo
+
+        do k=1,ntra
+         do i=1,nd
+          do il=1,ncum
+           trap(il,i,k)=tra(il,i,k)
+          enddo
+         enddo
+        enddo
+
+c
+c   ***  check whether ep(inb)=0, if so, skip precipitating    ***
+c   ***             downdraft calculation                      ***
+c
+
+        do il=1,ncum
+          lwork(il)=.TRUE.
+          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
+        enddo
+
+        call zilch(wdtrain,ncum)
+ 
+        DO 400 i=nl+1,1,-1
+
+        num1=0
+        do il=1,ncum
+         if ( i.le.inb(il) .and. lwork(il) ) num1=num1+1
+        enddo
+        if (num1.le.0) goto 400
+
+c
+c   ***  integrate liquid water equation to find condensed water   ***
+c   ***                and condensed water flux                    ***
+c
+
+c
+c    ***                    begin downdraft loop                    ***
+c
+
+c
+c    ***              calculate detrained precipitation             ***
+c
+       do il=1,ncum
+        if (i.le.inb(il) .and. lwork(il)) then
+         if (cvflag_grav) then
+          wdtrain(il)=grav*ep(il,i)*m(il,i)*clw(il,i)
+         else
+          wdtrain(il)=10.0*ep(il,i)*m(il,i)*clw(il,i)
+         endif
+        endif
+       enddo
+
+       if(i.gt.1)then
+        do 320 j=1,i-1
+         do il=1,ncum
+          if (i.le.inb(il) .and. lwork(il)) then
+           awat=elij(il,j,i)-(1.-ep(il,i))*clw(il,i)
+           awat=amax1(awat,0.0)
+           if (cvflag_grav) then
+            wdtrain(il)=wdtrain(il)+grav*awat*ment(il,j,i)
+           else
+            wdtrain(il)=wdtrain(il)+10.0*awat*ment(il,j,i)
+           endif
+          endif
+         enddo
+320     continue
+       endif
+
+c
+c    ***    find rain water and evaporation using provisional   ***
+c    ***              estimates of rp(i)and rp(i-1)             ***
+c
+
+      do 999 il=1,ncum
+
+       if (i.le.inb(il) .and. lwork(il)) then
+
+      wt(il,i)=45.0
+
+      if(i.lt.inb(il))then
+       rp(il,i)=rp(il,i+1)
+     :       +(cpd*(t(il,i+1)-t(il,i))+gz(il,i+1)-gz(il,i))/lv(il,i)
+       rp(il,i)=0.5*(rp(il,i)+rr(il,i))
+      endif
+      rp(il,i)=amax1(rp(il,i),0.0)
+      rp(il,i)=amin1(rp(il,i),rs(il,i))
+      rp(il,inb(il))=rr(il,inb(il))
+
+      if(i.eq.1)then
+       afac=p(il,1)*(rs(il,1)-rp(il,1))/(1.0e4+2000.0*p(il,1)*rs(il,1))
+      else
+       rp(il,i-1)=rp(il,i)
+     :          +(cpd*(t(il,i)-t(il,i-1))+gz(il,i)-gz(il,i-1))/lv(il,i)
+       rp(il,i-1)=0.5*(rp(il,i-1)+rr(il,i-1))
+       rp(il,i-1)=amin1(rp(il,i-1),rs(il,i-1))
+       rp(il,i-1)=amax1(rp(il,i-1),0.0)
+       afac1=p(il,i)*(rs(il,i)-rp(il,i))/(1.0e4+2000.0*p(il,i)*rs(il,i))
+       afac2=p(il,i-1)*(rs(il,i-1)-rp(il,i-1))
+     :                /(1.0e4+2000.0*p(il,i-1)*rs(il,i-1))
+       afac=0.5*(afac1+afac2)
+      endif
+      if(i.eq.inb(il))afac=0.0
+      afac=amax1(afac,0.0)
+      bfac=1./(sigd*wt(il,i))
+c
+cjyg1
+ccc        sigt=1.0
+ccc        if(i.ge.icb)sigt=sigp(i)
+c prise en compte de la variation progressive de sigt dans
+c les couches icb et icb-1:
+c 	pour plcl<ph(i+1), pr1=0 & pr2=1
+c 	pour plcl>ph(i),   pr1=1 & pr2=0
+c 	pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
+c    sur le nuage, et pr2 est la proportion sous la base du
+c    nuage.
+      pr1=(plcl(il)-ph(il,i+1))/(ph(il,i)-ph(il,i+1))
+      pr1=max(0.,min(1.,pr1))
+      pr2=(ph(il,i)-plcl(il))/(ph(il,i)-ph(il,i+1))
+      pr2=max(0.,min(1.,pr2))
+      sigt=sigp(il,i)*pr1+pr2
+cjyg2
+c
+      b6=bfac*50.*sigd*(ph(il,i)-ph(il,i+1))*sigt*afac
+      c6=water(il,i+1)+bfac*wdtrain(il)
+     :                -50.*sigd*bfac*(ph(il,i)-ph(il,i+1))*evap(il,i+1)
+      if(c6.gt.0.0)then
+       revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
+       evap(il,i)=sigt*afac*revap
+       water(il,i)=revap*revap
+      else
+       evap(il,i)=-evap(il,i+1)
+     :            +0.02*(wdtrain(il)+sigd*wt(il,i)*water(il,i+1))
+     :                 /(sigd*(ph(il,i)-ph(il,i+1)))
+      end if
+c
+c    ***  calculate precipitating downdraft mass flux under     ***
+c    ***              hydrostatic approximation                 ***
+c
+      if (i.ne.1) then
+
+      tevap=amax1(0.0,evap(il,i))
+      delth=amax1(0.001,(th(il,i)-th(il,i-1)))
+      if (cvflag_grav) then
+       mp(il,i)=100.*ginv*lvcp(il,i)*sigd*tevap
+     :              *(p(il,i-1)-p(il,i))/delth
+      else
+       mp(il,i)=10.*lvcp(il,i)*sigd*tevap*(p(il,i-1)-p(il,i))/delth
+      endif
+c
+c    ***           if hydrostatic assumption fails,             ***
+c    ***   solve cubic difference equation for downdraft theta  ***
+c    ***  and mass flux from two simultaneous differential eqns ***
+c
+      amfac=sigd*sigd*70.0*ph(il,i)*(p(il,i-1)-p(il,i))
+     :          *(th(il,i)-th(il,i-1))/(tv(il,i)*th(il,i))
+      amp2=abs(mp(il,i+1)*mp(il,i+1)-mp(il,i)*mp(il,i))
+      if(amp2.gt.(0.1*amfac))then
+       xf=100.0*sigd*sigd*sigd*(ph(il,i)-ph(il,i+1))
+       tf=b(il,i)-5.0*(th(il,i)-th(il,i-1))*t(il,i)
+     :               /(lvcp(il,i)*sigd*th(il,i))
+       af=xf*tf+mp(il,i+1)*mp(il,i+1)*tinv
+       bf=2.*(tinv*mp(il,i+1))**3+tinv*mp(il,i+1)*xf*tf
+     :            +50.*(p(il,i-1)-p(il,i))*xf*tevap
+       fac2=1.0
+       if(bf.lt.0.0)fac2=-1.0
+       bf=abs(bf)
+       ur=0.25*bf*bf-af*af*af*tinv*tinv*tinv
+       if(ur.ge.0.0)then
+        sru=sqrt(ur)
+        fac=1.0
+        if((0.5*bf-sru).lt.0.0)fac=-1.0
+        mp(il,i)=mp(il,i+1)*tinv+(0.5*bf+sru)**tinv
+     :                  +fac*(abs(0.5*bf-sru))**tinv
+       else
+        d=atan(2.*sqrt(-ur)/(bf+1.0e-28))
+        if(fac2.lt.0.0)d=3.14159-d
+        mp(il,i)=mp(il,i+1)*tinv+2.*sqrt(af*tinv)*cos(d*tinv)
+       endif
+       mp(il,i)=amax1(0.0,mp(il,i))
+
+       if (cvflag_grav) then
+Cjyg : il y a vraisemblablement une erreur dans la ligne 2 suivante: 
+C il faut diviser par (mp(il,i)*sigd*grav) et non par (mp(il,i)+sigd*0.1). 
+C Et il faut bien revoir les facteurs 100.
+        b(il,i-1)=b(il,i)+100.0*(p(il,i-1)-p(il,i))*tevap
+     2   /(mp(il,i)+sigd*0.1)
+     3   -10.0*(th(il,i)-th(il,i-1))*t(il,i)/(lvcp(il,i)*sigd*th(il,i))
+       else
+        b(il,i-1)=b(il,i)+100.0*(p(il,i-1)-p(il,i))*tevap
+     2   /(mp(il,i)+sigd*0.1)
+     3   -10.0*(th(il,i)-th(il,i-1))*t(il,i)/(lvcp(il,i)*sigd*th(il,i))
+       endif
+       b(il,i-1)=amax1(b(il,i-1),0.0)
+      endif
+c
+c   ***         limit magnitude of mp(i) to meet cfl condition      ***
+c
+      ampmax=2.0*(ph(il,i)-ph(il,i+1))*delti
+      amp2=2.0*(ph(il,i-1)-ph(il,i))*delti
+      ampmax=amin1(ampmax,amp2)
+      mp(il,i)=amin1(mp(il,i),ampmax)
+c
+c    ***      force mp to decrease linearly to zero                 ***
+c    ***       between cloud base and the surface                   ***
+c
+      if(p(il,i).gt.p(il,icb(il)))then
+       mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
+      endif
+
+360   continue
+      endif ! i.eq.1
+c
+c    ***       find mixing ratio of precipitating downdraft     ***
+c
+
+      if (i.ne.inb(il)) then
+
+      rp(il,i)=rr(il,i)
+
+      if(mp(il,i).gt.mp(il,i+1))then
+
+       if (cvflag_grav) then
+        rp(il,i)=rp(il,i+1)*mp(il,i+1)+rr(il,i)*(mp(il,i)-mp(il,i+1))
+     :   +100.*ginv*0.5*sigd*(ph(il,i)-ph(il,i+1))
+     :                     *(evap(il,i+1)+evap(il,i))
+       else
+        rp(il,i)=rp(il,i+1)*mp(il,i+1)+rr(il,i)*(mp(il,i)-mp(il,i+1))
+     :   +5.*sigd*(ph(il,i)-ph(il,i+1))
+     :                      *(evap(il,i+1)+evap(il,i))
+       endif
+      rp(il,i)=rp(il,i)/mp(il,i)
+      up(il,i)=up(il,i+1)*mp(il,i+1)+u(il,i)*(mp(il,i)-mp(il,i+1))
+      up(il,i)=up(il,i)/mp(il,i)
+      vp(il,i)=vp(il,i+1)*mp(il,i+1)+v(il,i)*(mp(il,i)-mp(il,i+1))
+      vp(il,i)=vp(il,i)/mp(il,i)
+
+      do j=1,ntra
+      trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
+     :            +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
+      trap(il,i,j)=trap(il,i,j)/mp(il,i)
+      end do
+
+      else
+
+       if(mp(il,i+1).gt.1.0e-16)then
+        if (cvflag_grav) then
+         rp(il,i)=rp(il,i+1)
+     :            +100.*ginv*0.5*sigd*(ph(il,i)-ph(il,i+1))
+     :            *(evap(il,i+1)+evap(il,i))/mp(il,i+1)
+        else
+         rp(il,i)=rp(il,i+1)
+     :           +5.*sigd*(ph(il,i)-ph(il,i+1))
+     :           *(evap(il,i+1)+evap(il,i))/mp(il,i+1)
+        endif
+       up(il,i)=up(il,i+1)
+       vp(il,i)=vp(il,i+1)
+
+       do j=1,ntra
+       trap(il,i,j)=trap(il,i+1,j)
+       end do
+
+       endif
+      endif
+      rp(il,i)=amin1(rp(il,i),rs(il,i))
+      rp(il,i)=amax1(rp(il,i),0.0)
+
+      endif
+      endif
+999   continue
+
+400   continue
+
+       return
+       end
+
+      SUBROUTINE cv3_yield(nloc,ncum,nd,na,ntra 
+     :                    ,icb,inb,delt
+     :                    ,t,rr,u,v,tra,gz,p,ph,h,hp,lv,cpn,th
+     :                    ,ep,clw,m,tp,mp,rp,up,vp,trap
+     :                    ,wt,water,evap,b
+     :                    ,ment,qent,uent,vent,nent,elij,traent,sig
+     :                    ,tv,tvp
+     :                    ,iflag,precip,ft,fr,fu,fv,ftra
+     :                    ,upwd,dnwd,dnwd0,ma,mike,tls,tps,qcondc,wd)
+      implicit none
+
+#include "cvthermo.h"
+#include "cvparam3.h"
+#include "cvflag.h"
+
+c inputs:
+      integer ncum,nd,na,ntra,nloc
+      integer icb(nloc), inb(nloc)
+      real delt
+      real t(nloc,nd), rr(nloc,nd), u(nloc,nd), v(nloc,nd)
+      real tra(nloc,nd,ntra), sig(nloc,nd)
+      real gz(nloc,na), ph(nloc,nd+1), h(nloc,na), hp(nloc,na)
+      real th(nloc,na), p(nloc,nd), tp(nloc,na)
+      real lv(nloc,na), cpn(nloc,na), ep(nloc,na), clw(nloc,na)
+      real m(nloc,na), mp(nloc,na), rp(nloc,na), up(nloc,na)
+      real vp(nloc,na), wt(nloc,nd), trap(nloc,nd,ntra)
+      real water(nloc,na), evap(nloc,na), b(nloc,na)
+      real ment(nloc,na,na), qent(nloc,na,na), uent(nloc,na,na)
+      real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
+      real traent(nloc,na,na,ntra)
+      real tv(nloc,nd), tvp(nloc,nd)
+
+c input/output:
+      integer iflag(nloc)
+
+c outputs:
+      real precip(nloc)
+      real ft(nloc,nd), fr(nloc,nd), fu(nloc,nd), fv(nloc,nd)
+      real ftra(nloc,nd,ntra)
+      real upwd(nloc,nd), dnwd(nloc,nd), ma(nloc,nd)
+      real dnwd0(nloc,nd), mike(nloc,nd)
+      real tls(nloc,nd), tps(nloc,nd)
+      real qcondc(nloc,nd)                               ! cld
+      real wd(nloc)                                      ! gust
+
+c local variables:
+      integer i,k,il,n,j,num1
+      real rat, awat, delti
+      real ax, bx, cx, dx, ex
+      real cpinv, rdcp, dpinv
+      real lvcp(nloc,na), mke(nloc,na)
+      real am(nloc), work(nloc), ad(nloc), amp1(nloc)
+c!!      real up1(nloc), dn1(nloc)
+      real up1(nloc,nd,nd), dn1(nloc,nd,nd)
+      real asum(nloc), bsum(nloc), csum(nloc), dsum(nloc)
+      real qcond(nloc,nd), nqcond(nloc,nd), wa(nloc,nd)  ! cld
+      real siga(nloc,nd), sax(nloc,nd), mac(nloc,nd)      ! cld
+
+
+c-------------------------------------------------------------
+
+c initialization:
+
+      delti = 1.0/delt
+
+      do il=1,ncum
+       precip(il)=0.0
+       wd(il)=0.0     ! gust
+      enddo
+
+      do i=1,nd
+       do il=1,ncum
+         ft(il,i)=0.0
+         fr(il,i)=0.0
+         fu(il,i)=0.0
+         fv(il,i)=0.0
+         qcondc(il,i)=0.0                                ! cld
+         qcond(il,i)=0.0                                 ! cld
+         nqcond(il,i)=0.0                                ! cld
+       enddo 
+      enddo
+
+      do j=1,ntra
+       do i=1,nd
+        do il=1,ncum
+          ftra(il,i,j)=0.0
+        enddo
+       enddo 
+      enddo
+
+      do i=1,nl
+       do il=1,ncum
+         lvcp(il,i)=lv(il,i)/cpn(il,i)
+       enddo
+      enddo
+
+
+c
+c   ***  calculate surface precipitation in mm/day     ***
+c
+      do il=1,ncum 
+       if(ep(il,inb(il)).ge.0.0001)then 
+        if (cvflag_grav) then
+         precip(il)=wt(il,1)*sigd*water(il,1)*86400.*1000./(rowl*grav)
+        else
+         precip(il)=wt(il,1)*sigd*water(il,1)*8640.
+        endif
+       endif 
+      enddo 
+
+c
+c   ***  Calculate downdraft velocity scale    ***
+c   ***  NE PAS UTILISER POUR L'INSTANT ***
+c
+c!      do il=1,ncum
+c!        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il))
+c!     :                                  /(sigd*p(il,icb(il)))
+c!      enddo
+
+c
+c   ***  calculate tendencies of lowest level potential temperature  ***
+c   ***                      and mixing ratio                        ***
+c
+      do il=1,ncum
+       work(il)=1.0/(ph(il,1)-ph(il,2))
+       am(il)=0.0
+      enddo
+
+      do k=2,nl
+       do il=1,ncum
+        if (k.le.inb(il)) then
+         am(il)=am(il)+m(il,k)
+        endif
+       enddo
+      enddo
+
+      do il=1,ncum
+
+c convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
+      if (cvflag_grav) then
+      if((0.01*grav*work(il)*am(il)).ge.delti)iflag(il)=1!consist vect
+       ft(il,1)=0.01*grav*work(il)*am(il)*(t(il,2)-t(il,1)
+     :            +(gz(il,2)-gz(il,1))/cpn(il,1))
+      else
+       if((0.1*work(il)*am(il)).ge.delti)iflag(il)=1 !consistency vect
+       ft(il,1)=0.1*work(il)*am(il)*(t(il,2)-t(il,1)
+     :            +(gz(il,2)-gz(il,1))/cpn(il,1))
+      endif
+
+      ft(il,1)=ft(il,1)-0.5*lvcp(il,1)*sigd*(evap(il,1)+evap(il,2))
+
+      if (cvflag_grav) then
+       ft(il,1)=ft(il,1)-0.009*grav*sigd*mp(il,2)
+     :                             *t(il,1)*b(il,1)*work(il)
+      else
+       ft(il,1)=ft(il,1)-0.09*sigd*mp(il,2)*t(il,1)*b(il,1)*work(il)
+      endif
+
+      ft(il,1)=ft(il,1)+0.01*sigd*wt(il,1)*(cl-cpd)*water(il,2)*(t(il,2)
+     :-t(il,1))*work(il)/cpn(il,1)
+
+      if (cvflag_grav) then
+Cjyg1  Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
+c (sb: pour l'instant, on ne fait que le chgt concernant grav, pas evap) 
+       fr(il,1)=0.01*grav*mp(il,2)*(rp(il,2)-rr(il,1))*work(il)
+     :          +sigd*0.5*(evap(il,1)+evap(il,2))
+c+tard     :          +sigd*evap(il,1)
+
+       fr(il,1)=fr(il,1)+0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)
+
+       fu(il,1)=fu(il,1)+0.01*grav*work(il)*(mp(il,2)*(up(il,2)-u(il,1))
+     :         +am(il)*(u(il,2)-u(il,1)))
+       fv(il,1)=fv(il,1)+0.01*grav*work(il)*(mp(il,2)*(vp(il,2)-v(il,1))
+     :         +am(il)*(v(il,2)-v(il,1)))
+      else  ! cvflag_grav
+       fr(il,1)=0.1*mp(il,2)*(rp(il,2)-rr(il,1))*work(il)
+     :          +sigd*0.5*(evap(il,1)+evap(il,2))
+       fr(il,1)=fr(il,1)+0.1*am(il)*(rr(il,2)-rr(il,1))*work(il)
+       fu(il,1)=fu(il,1)+0.1*work(il)*(mp(il,2)*(up(il,2)-u(il,1))
+     :         +am(il)*(u(il,2)-u(il,1)))
+       fv(il,1)=fv(il,1)+0.1*work(il)*(mp(il,2)*(vp(il,2)-v(il,1))
+     :         +am(il)*(v(il,2)-v(il,1)))
+      endif ! cvflag_grav
+
+      enddo ! il
+
+      do j=1,ntra
+       do il=1,ncum
+        if (cvflag_grav) then
+         ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
+     :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
+     :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
+        else
+         ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
+     :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
+     :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
+        endif
+       enddo
+      enddo
+
+      do j=2,nl
+       do il=1,ncum
+        if (j.le.inb(il)) then
+         if (cvflag_grav) then
+          fr(il,1)=fr(il,1)
+     :       +0.01*grav*work(il)*ment(il,j,1)*(qent(il,j,1)-rr(il,1))
+          fu(il,1)=fu(il,1)
+     :       +0.01*grav*work(il)*ment(il,j,1)*(uent(il,j,1)-u(il,1))
+          fv(il,1)=fv(il,1)
+     :       +0.01*grav*work(il)*ment(il,j,1)*(vent(il,j,1)-v(il,1))
+         else   ! cvflag_grav
+          fr(il,1)=fr(il,1)
+     :         +0.1*work(il)*ment(il,j,1)*(qent(il,j,1)-rr(il,1))
+          fu(il,1)=fu(il,1)
+     :         +0.1*work(il)*ment(il,j,1)*(uent(il,j,1)-u(il,1))
+          fv(il,1)=fv(il,1)
+     :         +0.1*work(il)*ment(il,j,1)*(vent(il,j,1)-v(il,1))
+         endif  ! cvflag_grav
+        endif ! j
+       enddo
+      enddo
+
+      do k=1,ntra
+       do j=2,nl
+        do il=1,ncum
+         if (j.le.inb(il)) then
+
+          if (cvflag_grav) then
+           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
+     :                *(traent(il,j,1,k)-tra(il,1,k))
+          else
+           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
+     :                *(traent(il,j,1,k)-tra(il,1,k))
+          endif
+
+         endif
+        enddo
+       enddo
+      enddo
+
+c
+c   ***  calculate tendencies of potential temperature and mixing ratio  ***
+c   ***               at levels above the lowest level                   ***
+c
+c   ***  first find the net saturated updraft and downdraft mass fluxes  ***
+c   ***                      through each level                          ***
+c
+
+      do 500 i=2,nl+1 ! newvecto: mettre nl au lieu nl+1?
+
+       num1=0
+       do il=1,ncum
+        if(i.le.inb(il))num1=num1+1
+       enddo
+       if(num1.le.0)go to 500
+
+       call zilch(amp1,ncum)
+       call zilch(ad,ncum)
+
+      do 440 k=i+1,nl+1
+       do 441 il=1,ncum
+        if (i.le.inb(il) .and. k.le.(inb(il)+1)) then
+         amp1(il)=amp1(il)+m(il,k)
+        endif
+ 441   continue
+ 440  continue
+
+      do 450 k=1,i
+       do 451 j=i+1,nl+1
+        do 452 il=1,ncum
+         if (i.le.inb(il) .and. j.le.(inb(il)+1)) then
+          amp1(il)=amp1(il)+ment(il,k,j)
+         endif
+452     continue
+451    continue
+450   continue
+
+      do 470 k=1,i-1
+       do 471 j=i,nl+1 ! newvecto: nl au lieu nl+1?
+        do 472 il=1,ncum
+        if (i.le.inb(il) .and. j.le.inb(il)) then
+         ad(il)=ad(il)+ment(il,j,k)
+        endif
+472     continue
+471    continue
+470   continue
+  
+      do 1350 il=1,ncum
+      if (i.le.inb(il)) then
+       dpinv=1.0/(ph(il,i)-ph(il,i+1))
+       cpinv=1.0/cpn(il,i)
+
+c convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
+      if (cvflag_grav) then
+       if((0.01*grav*dpinv*amp1(il)).ge.delti)iflag(il)=1 ! vecto
+      else
+       if((0.1*dpinv*amp1(il)).ge.delti)iflag(il)=1 ! vecto
+      endif
+
+      if (cvflag_grav) then
+       ft(il,i)=0.01*grav*dpinv*(amp1(il)*(t(il,i+1)-t(il,i)
+     :    +(gz(il,i+1)-gz(il,i))*cpinv)
+     :    -ad(il)*(t(il,i)-t(il,i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
+     :    -0.5*sigd*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
+       rat=cpn(il,i-1)*cpinv
+       ft(il,i)=ft(il,i)-0.009*grav*sigd*(mp(il,i+1)*t(il,i)*b(il,i)
+     :   -mp(il,i)*t(il,i-1)*rat*b(il,i-1))*dpinv
+       ft(il,i)=ft(il,i)+0.01*grav*dpinv*ment(il,i,i)*(hp(il,i)-h(il,i)
+     :    +t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
+      else  ! cvflag_grav
+       ft(il,i)=0.1*dpinv*(amp1(il)*(t(il,i+1)-t(il,i)
+     :    +(gz(il,i+1)-gz(il,i))*cpinv)
+     :    -ad(il)*(t(il,i)-t(il,i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
+     :    -0.5*sigd*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
+       rat=cpn(il,i-1)*cpinv
+       ft(il,i)=ft(il,i)-0.09*sigd*(mp(il,i+1)*t(il,i)*b(il,i)
+     :   -mp(il,i)*t(il,i-1)*rat*b(il,i-1))*dpinv
+       ft(il,i)=ft(il,i)+0.1*dpinv*ment(il,i,i)*(hp(il,i)-h(il,i)
+     :    +t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
+      endif ! cvflag_grav
+
+
+      ft(il,i)=ft(il,i)+0.01*sigd*wt(il,i)*(cl-cpd)*water(il,i+1)
+     :           *(t(il,i+1)-t(il,i))*dpinv*cpinv
+
+      if (cvflag_grav) then
+       fr(il,i)=0.01*grav*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i))
+     :           -ad(il)*(rr(il,i)-rr(il,i-1)))
+       fu(il,i)=fu(il,i)+0.01*grav*dpinv*(amp1(il)*(u(il,i+1)-u(il,i))
+     :             -ad(il)*(u(il,i)-u(il,i-1)))
+       fv(il,i)=fv(il,i)+0.01*grav*dpinv*(amp1(il)*(v(il,i+1)-v(il,i))
+     :             -ad(il)*(v(il,i)-v(il,i-1)))
+      else  ! cvflag_grav
+       fr(il,i)=0.1*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i))
+     :           -ad(il)*(rr(il,i)-rr(il,i-1)))
+       fu(il,i)=fu(il,i)+0.1*dpinv*(amp1(il)*(u(il,i+1)-u(il,i))
+     :             -ad(il)*(u(il,i)-u(il,i-1)))
+       fv(il,i)=fv(il,i)+0.1*dpinv*(amp1(il)*(v(il,i+1)-v(il,i))
+     :             -ad(il)*(v(il,i)-v(il,i-1)))
+      endif ! cvflag_grav
+
+      endif ! i
+1350  continue
+
+      do k=1,ntra
+       do il=1,ncum
+        if (i.le.inb(il)) then
+         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+         cpinv=1.0/cpn(il,i)
+         if (cvflag_grav) then
+           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
+     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
+     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
+         else
+           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
+     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
+     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
+         endif
+        endif
+       enddo
+      enddo
+
+      do 480 k=1,i-1
+       do 1370 il=1,ncum
+        if (i.le.inb(il)) then
+         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+         cpinv=1.0/cpn(il,i)
+
+      awat=elij(il,k,i)-(1.-ep(il,i))*clw(il,i)
+      awat=amax1(awat,0.0)
+
+      if (cvflag_grav) then
+      fr(il,i)=fr(il,i)
+     :   +0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-awat-rr(il,i))
+      fu(il,i)=fu(il,i)
+     :         +0.01*grav*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
+      fv(il,i)=fv(il,i)
+     :         +0.01*grav*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
+      else  ! cvflag_grav
+      fr(il,i)=fr(il,i)
+     :   +0.1*dpinv*ment(il,k,i)*(qent(il,k,i)-awat-rr(il,i))
+      fu(il,i)=fu(il,i)
+     :   +0.01*grav*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
+      fv(il,i)=fv(il,i)
+     :   +0.1*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
+      endif ! cvflag_grav
+
+c (saturated updrafts resulting from mixing)        ! cld
+        qcond(il,i)=qcond(il,i)+(elij(il,k,i)-awat) ! cld
+        nqcond(il,i)=nqcond(il,i)+1.                ! cld
+      endif ! i
+1370  continue
+480   continue
+
+      do j=1,ntra
+       do k=1,i-1
+        do il=1,ncum
+         if (i.le.inb(il)) then
+          dpinv=1.0/(ph(il,i)-ph(il,i+1))
+          cpinv=1.0/cpn(il,i)
+          if (cvflag_grav) then
+           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
+     :        *(traent(il,k,i,j)-tra(il,i,j))
+          else
+           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
+     :        *(traent(il,k,i,j)-tra(il,i,j))
+          endif
+         endif
+        enddo
+       enddo
+      enddo
+
+      do 490 k=i,nl+1
+       do 1380 il=1,ncum
+        if (i.le.inb(il) .and. k.le.inb(il)) then
+         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+         cpinv=1.0/cpn(il,i)
+
+         if (cvflag_grav) then
+         fr(il,i)=fr(il,i)
+     :         +0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
+         fu(il,i)=fu(il,i)
+     :         +0.01*grav*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
+         fv(il,i)=fv(il,i)
+     :         +0.01*grav*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
+         else  ! cvflag_grav 
+         fr(il,i)=fr(il,i)
+     :         +0.1*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
+         fu(il,i)=fu(il,i)
+     :         +0.1*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
+         fv(il,i)=fv(il,i)
+     :         +0.1*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
+         endif ! cvflag_grav 
+        endif ! i and k
+1380   continue
+490   continue
+
+      do j=1,ntra
+       do k=i,nl+1
+        do il=1,ncum
+         if (i.le.inb(il) .and. k.le.inb(il)) then
+          dpinv=1.0/(ph(il,i)-ph(il,i+1))
+          cpinv=1.0/cpn(il,i)
+          if (cvflag_grav) then
+           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
+     :         *(traent(il,k,i,j)-tra(il,i,j))
+          else
+           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
+     :             *(traent(il,k,i,j)-tra(il,i,j))
+          endif
+         endif ! i and k
+        enddo
+       enddo
+      enddo
+
+      do 1400 il=1,ncum
+       if (i.le.inb(il)) then
+        dpinv=1.0/(ph(il,i)-ph(il,i+1))
+        cpinv=1.0/cpn(il,i)
+
+        if (cvflag_grav) then
+c sb: on ne fait pas encore la correction permettant de mieux
+c conserver l'eau:
+         fr(il,i)=fr(il,i)+0.5*sigd*(evap(il,i)+evap(il,i+1))
+     :        +0.01*grav*(mp(il,i+1)*(rp(il,i+1)-rr(il,i))-mp(il,i)
+     :               *(rp(il,i)-rr(il,i-1)))*dpinv
+
+         fu(il,i)=fu(il,i)+0.01*grav*(mp(il,i+1)*(up(il,i+1)-u(il,i))
+     :             -mp(il,i)*(up(il,i)-u(il,i-1)))*dpinv
+         fv(il,i)=fv(il,i)+0.01*grav*(mp(il,i+1)*(vp(il,i+1)-v(il,i))
+     :             -mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
+        else  ! cvflag_grav
+         fr(il,i)=fr(il,i)+0.5*sigd*(evap(il,i)+evap(il,i+1))
+     :        +0.1*(mp(il,i+1)*(rp(il,i+1)-rr(il,i))-mp(il,i)
+     :               *(rp(il,i)-rr(il,i-1)))*dpinv
+         fu(il,i)=fu(il,i)+0.1*(mp(il,i+1)*(up(il,i+1)-u(il,i))
+     :             -mp(il,i)*(up(il,i)-u(il,i-1)))*dpinv
+         fv(il,i)=fv(il,i)+0.1*(mp(il,i+1)*(vp(il,i+1)-v(il,i))
+     :             -mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
+        endif ! cvflag_grav
+
+      endif ! i
+1400  continue
+
+c sb: interface with the cloud parameterization:          ! cld
+
+      do k=i+1,nl
+       do il=1,ncum 
+        if (k.le.inb(il) .and. i.le.inb(il)) then         ! cld
+C (saturated downdrafts resulting from mixing)            ! cld
+          qcond(il,i)=qcond(il,i)+elij(il,k,i)            ! cld
+          nqcond(il,i)=nqcond(il,i)+1.                    ! cld
+        endif                                             ! cld
+       enddo                                              ! cld
+      enddo                                               ! cld
+
+C (particular case: no detraining level is found)         ! cld
+      do il=1,ncum                                        ! cld
+       if (i.le.inb(il) .and. nent(il,i).eq.0) then       ! cld
+          qcond(il,i)=qcond(il,i)+(1.-ep(il,i))*clw(il,i) ! cld
+          nqcond(il,i)=nqcond(il,i)+1.                    ! cld
+       endif                                              ! cld
+      enddo                                               ! cld
+
+      do il=1,ncum                                        ! cld
+       if (i.le.inb(il) .and. nqcond(il,i).ne.0.) then    ! cld
+          qcond(il,i)=qcond(il,i)/nqcond(il,i)            ! cld
+       endif                                              ! cld
+      enddo
+
+      do j=1,ntra
+       do il=1,ncum
+        if (i.le.inb(il)) then
+         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+         cpinv=1.0/cpn(il,i)
+
+         if (cvflag_grav) then
+          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
+     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
+     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
+         else
+          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
+     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
+     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
+         endif
+        endif ! i
+       enddo
+      enddo 
+
+
+500   continue
+
+
+c   ***   move the detrainment at level inb down to level inb-1   ***
+c   ***        in such a way as to preserve the vertically        ***
+c   ***          integrated enthalpy and water tendencies         ***
+c
+      do 503 il=1,ncum
+
+      ax=0.1*ment(il,inb(il),inb(il))*(hp(il,inb(il))-h(il,inb(il))
+     : +t(il,inb(il))*(cpv-cpd)
+     : *(rr(il,inb(il))-qent(il,inb(il),inb(il))))
+     :  /(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
+      ft(il,inb(il))=ft(il,inb(il))-ax
+      ft(il,inb(il)-1)=ft(il,inb(il)-1)+ax*cpn(il,inb(il))
+     :    *(ph(il,inb(il))-ph(il,inb(il)+1))/(cpn(il,inb(il)-1)
+     :    *(ph(il,inb(il)-1)-ph(il,inb(il))))
+
+      bx=0.1*ment(il,inb(il),inb(il))*(qent(il,inb(il),inb(il))
+     :    -rr(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+      fr(il,inb(il))=fr(il,inb(il))-bx
+      fr(il,inb(il)-1)=fr(il,inb(il)-1)
+     :   +bx*(ph(il,inb(il))-ph(il,inb(il)+1))
+     :      /(ph(il,inb(il)-1)-ph(il,inb(il)))
+
+      cx=0.1*ment(il,inb(il),inb(il))*(uent(il,inb(il),inb(il))
+     :       -u(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+      fu(il,inb(il))=fu(il,inb(il))-cx
+      fu(il,inb(il)-1)=fu(il,inb(il)-1)
+     :     +cx*(ph(il,inb(il))-ph(il,inb(il)+1))
+     :        /(ph(il,inb(il)-1)-ph(il,inb(il)))
+
+      dx=0.1*ment(il,inb(il),inb(il))*(vent(il,inb(il),inb(il))
+     :      -v(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+      fv(il,inb(il))=fv(il,inb(il))-dx
+      fv(il,inb(il)-1)=fv(il,inb(il)-1)
+     :    +dx*(ph(il,inb(il))-ph(il,inb(il)+1))
+     :       /(ph(il,inb(il)-1)-ph(il,inb(il)))
+
+503   continue
+
+      do j=1,ntra
+       do il=1,ncum
+        ex=0.1*ment(il,inb(il),inb(il)) 
+     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+       enddo
+      enddo
+
+c
+c   ***    homoginize tendencies below cloud base    ***
+c
+c
+      do il=1,ncum
+       asum(il)=0.0
+       bsum(il)=0.0
+       csum(il)=0.0
+       dsum(il)=0.0
+      enddo
+
+      do i=1,nl
+       do il=1,ncum
+        if (i.le.(icb(il)-1)) then
+      asum(il)=asum(il)+ft(il,i)*(ph(il,i)-ph(il,i+1))
+      bsum(il)=bsum(il)+fr(il,i)*(lv(il,i)+(cl-cpd)*(t(il,i)-t(il,1)))
+     :                  *(ph(il,i)-ph(il,i+1))
+      csum(il)=csum(il)+(lv(il,i)+(cl-cpd)*(t(il,i)-t(il,1)))
+     :                      *(ph(il,i)-ph(il,i+1))
+      dsum(il)=dsum(il)+t(il,i)*(ph(il,i)-ph(il,i+1))/th(il,i)
+        endif 
+       enddo
+      enddo
+
+c!!!      do 700 i=1,icb(il)-1
+      do i=1,nl
+       do il=1,ncum
+        if (i.le.(icb(il)-1)) then
+         ft(il,i)=asum(il)*t(il,i)/(th(il,i)*dsum(il))
+         fr(il,i)=bsum(il)/csum(il)
+        endif
+       enddo
+      enddo
+
+c
+c   ***           reset counter and return           ***
+c
+      do il=1,ncum
+       sig(il,nd)=2.0
+      enddo
+
+
+      do i=1,nd
+       do il=1,ncum
+        upwd(il,i)=0.0
+        dnwd(il,i)=0.0
+       enddo
+      enddo
+      
+      do i=1,nl
+       do il=1,ncum
+        dnwd0(il,i)=-mp(il,i)
+       enddo
+      enddo
+      do i=nl+1,nd
+       do il=1,ncum
+        dnwd0(il,i)=0.
+       enddo
+      enddo
+
+
+      do i=1,nl
+       do il=1,ncum
+        if (i.ge.icb(il) .and. i.le.inb(il)) then
+          upwd(il,i)=0.0
+          dnwd(il,i)=0.0
+        endif
+       enddo
+      enddo
+
+      do i=1,nl
+       do k=1,nl
+        do il=1,ncum
+          up1(il,k,i)=0.0
+          dn1(il,k,i)=0.0
+        enddo
+       enddo
+      enddo
+
+      do i=1,nl
+       do k=i,nl
+        do n=1,i-1
+         do il=1,ncum
+          if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) then
+             up1(il,k,i)=up1(il,k,i)+ment(il,n,k)
+             dn1(il,k,i)=dn1(il,k,i)-ment(il,k,n)
+          endif
+         enddo
+        enddo
+       enddo
+      enddo
+
+      do i=1,nl
+       do k=i,nl
+        do il=1,ncum
+         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) then
+            upwd(il,i)=upwd(il,i)+m(il,k)+up1(il,k,i)
+            dnwd(il,i)=dnwd(il,i)+dn1(il,k,i)
+         endif
+        enddo
+       enddo
+      enddo
+
+
+c!!!      DO il=1,ncum
+c!!!      do i=icb(il),inb(il)
+c!!!     
+c!!!      upwd(il,i)=0.0
+c!!!      dnwd(il,i)=0.0
+c!!!      do k=i,inb(il)
+c!!!      up1=0.0
+c!!!      dn1=0.0
+c!!!      do n=1,i-1
+c!!!      up1=up1+ment(il,n,k)
+c!!!      dn1=dn1-ment(il,k,n)
+c!!!      enddo
+c!!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
+c!!!      dnwd(il,i)=dnwd(il,i)+dn1
+c!!!      enddo
+c!!!      enddo
+c!!!
+c!!!      ENDDO
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        determination de la variation de flux ascendant entre
+c        deux niveau non dilue mike
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      do i=1,nl
+       do il=1,ncum
+        mike(il,i)=m(il,i)
+       enddo
+      enddo
+
+      do i=nl+1,nd
+       do il=1,ncum
+        mike(il,i)=0.
+       enddo
+      enddo
+
+      do i=1,nd
+       do il=1,ncum
+        ma(il,i)=0
+       enddo
+      enddo
+
+      do i=1,nl
+       do j=i,nl
+        do il=1,ncum
+         ma(il,i)=ma(il,i)+m(il,j)
+        enddo
+       enddo
+      enddo
+
+      do i=nl+1,nd
+       do il=1,ncum
+        ma(il,i)=0.
+       enddo
+      enddo
+
+      do i=1,nl
+       do il=1,ncum
+        if (i.le.(icb(il)-1)) then
+         ma(il,i)=0
+        endif
+       enddo
+      enddo
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        icb represente de niveau ou se trouve la
+c        base du nuage , et inb le top du nuage
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      do i=1,nd
+       do il=1,ncum
+        mke(il,i)=upwd(il,i)+dnwd(il,i)
+       enddo
+      enddo
+
+      do i=1,nd
+       DO 999 il=1,ncum
+        rdcp=(rrd*(1.-rr(il,i))-rr(il,i)*rrv)
+     :        /(cpd*(1.-rr(il,i))+rr(il,i)*cpv)
+        tls(il,i)=t(il,i)*(1000.0/p(il,i))**rdcp
+        tps(il,i)=tp(il,i)
+999    CONTINUE
+      enddo
+
+c
+c   *** diagnose the in-cloud mixing ratio   ***            ! cld
+c   ***           of condensed water         ***            ! cld
+c                                                           ! cld
+
+       do i=1,nd                                            ! cld
+        do il=1,ncum                                        ! cld
+         mac(il,i)=0.0                                      ! cld
+         wa(il,i)=0.0                                       ! cld
+         siga(il,i)=0.0                                     ! cld
+         sax(il,i)=0.0                                      ! cld
+        enddo                                               ! cld
+       enddo                                                ! cld
+
+       do i=minorig, nl                                     ! cld
+        do k=i+1,nl+1                                       ! cld
+         do il=1,ncum                                       ! cld
+          if (i.le.inb(il) .and. k.le.(inb(il)+1)) then     ! cld
+            mac(il,i)=mac(il,i)+m(il,k)                     ! cld
+          endif                                             ! cld
+         enddo                                              ! cld
+        enddo                                               ! cld
+       enddo                                                ! cld
+
+       do i=1,nl                                            ! cld
+        do j=1,i                                            ! cld
+         do il=1,ncum                                       ! cld
+          if (i.ge.icb(il) .and. i.le.(inb(il)-1)           ! cld
+     :      .and. j.ge.icb(il) ) then                       ! cld
+           sax(il,i)=sax(il,i)+rrd*(tvp(il,j)-tv(il,j))     ! cld
+     :        *(ph(il,j)-ph(il,j+1))/p(il,j)                ! cld
+          endif                                             ! cld
+         enddo                                              ! cld
+        enddo                                               ! cld
+       enddo                                                ! cld
+
+       do i=1,nl                                            ! cld
+        do il=1,ncum                                        ! cld
+         if (i.ge.icb(il) .and. i.le.(inb(il)-1)            ! cld
+     :       .and. sax(il,i).gt.0.0 ) then                  ! cld
+           wa(il,i)=sqrt(2.*sax(il,i))                      ! cld
+         endif                                              ! cld
+        enddo                                               ! cld
+       enddo                                                ! cld
+            
+       do i=1,nl                                            ! cld
+        do il=1,ncum                                        ! cld
+         if (wa(il,i).gt.0.0)                               ! cld
+     :     siga(il,i)=mac(il,i)/wa(il,i)                    ! cld
+     :         *rrd*tvp(il,i)/p(il,i)/100./delta            ! cld
+          siga(il,i) = min(siga(il,i),1.0)                  ! cld
+          qcondc(il,i)=siga(il,i)*clw(il,i)*(1.-ep(il,i))   ! cld
+     :           + (1.-siga(il,i))*qcond(il,i)              ! cld
+        enddo                                               ! cld
+       enddo                                                ! cld
+
+        return
+        end
+
+
+      SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
+     :         ,iflag
+     :         ,precip,sig,w0
+     :         ,ft,fq,fu,fv,ftra
+     :         ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
+     :         ,iflag1
+     :         ,precip1,sig1,w01
+     :         ,ft1,fq1,fu1,fv1,ftra1
+     :         ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1
+     :                               )
+      implicit none
+
+#include "cvparam3.h"
+
+c inputs:
+      integer len, ncum, nd, ntra, nloc
+      integer idcum(nloc)
+      integer iflag(nloc)
+      real precip(nloc)
+      real sig(nloc,nd), w0(nloc,nd)
+      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
+      real ftra(nloc,nd,ntra)
+      real Ma(nloc,nd)
+      real upwd(nloc,nd),dnwd(nloc,nd),dnwd0(nloc,nd)
+      real qcondc(nloc,nd)
+      real wd(nloc),cape(nloc)
+
+c outputs:
+      integer iflag1(len)
+      real precip1(len)
+      real sig1(len,nd), w01(len,nd)
+      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
+      real ftra1(len,nd,ntra)
+      real Ma1(len,nd)
+      real upwd1(len,nd),dnwd1(len,nd),dnwd01(len,nd)
+      real qcondc1(nloc,nd)
+      real wd1(nloc),cape1(nloc)
+
+c local variables:
+      integer i,k,j
+
+        do 2000 i=1,ncum
+         precip1(idcum(i))=precip(i)
+         iflag1(idcum(i))=iflag(i)
+         wd1(idcum(i))=wd(i)
+         cape1(idcum(i))=cape(i)
+ 2000   continue
+
+        do 2020 k=1,nl
+          do 2010 i=1,ncum
+            sig1(idcum(i),k)=sig(i,k)
+            w01(idcum(i),k)=w0(i,k)
+            ft1(idcum(i),k)=ft(i,k)
+            fq1(idcum(i),k)=fq(i,k)
+            fu1(idcum(i),k)=fu(i,k)
+            fv1(idcum(i),k)=fv(i,k)
+            Ma1(idcum(i),k)=Ma(i,k)
+            upwd1(idcum(i),k)=upwd(i,k)
+            dnwd1(idcum(i),k)=dnwd(i,k)
+            dnwd01(idcum(i),k)=dnwd0(i,k)
+            qcondc1(idcum(i),k)=qcondc(i,k)
+ 2010     continue
+ 2020   continue
+
+        do 2200 i=1,ncum
+          sig1(idcum(i),nd)=sig(i,nd)
+2200    continue
+
+
+        do 2100 j=1,ntra
+c oct3         do 2110 k=1,nl
+         do 2110 k=1,nd ! oct3
+          do 2120 i=1,ncum
+            ftra1(idcum(i),k,j)=ftra(i,k,j)
+ 2120     continue
+ 2110    continue
+ 2100   continue
+
+        return
+        end
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/cv_driver.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/cv_driver.F	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/cv_driver.F	(revision 418)
@@ -0,0 +1,670 @@
+      SUBROUTINE cv_driver(len,nd,ndp1,ntra,iflag_con,
+     &                   t1,q1,qs1,u1,v1,tra1,
+     &                   p1,ph1,iflag1,ft1,fq1,fu1,fv1,ftra1,
+     &                   precip1,
+     &                   cbmf1,sig1,w01,
+     &                   delt,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1)
+C
+      implicit none
+C
+C.............................START PROLOGUE............................
+C
+C PARAMETERS:
+C      Name            Type         Usage            Description
+C   ----------      ----------     -------  ----------------------------
+C
+C      len           Integer        Input        first (i) dimension
+C      nd            Integer        Input        vertical (k) dimension
+C      ndp1          Integer        Input        nd + 1
+C      ntra          Integer        Input        number of tracors
+C      iflag_con     Integer        Input        version of convect (3/4)
+C      t1            Real           Input        temperature
+C      q1            Real           Input        specific hum
+C      qs1           Real           Input        sat specific hum
+C      u1            Real           Input        u-wind
+C      v1            Real           Input        v-wind
+C      tra1          Real           Input        tracors
+C      p1            Real           Input        full level pressure
+C      ph1           Real           Input        half level pressure
+C      iflag1        Integer        Output       flag for Emanuel conditions
+C      ft1           Real           Output       temp tend
+C      fq1           Real           Output       spec hum tend
+C      fu1           Real           Output       u-wind tend
+C      fv1           Real           Output       v-wind tend
+C      ftra1         Real           Output       tracor tend
+C      precip1       Real           Output       precipitation
+C      cbmf1         Real           Output       cloud base mass flux
+C      sig1          Real           In/Out       section adiabatic updraft
+C      w01           Real           In/Out       vertical velocity within adiab updraft
+C      delt          Real           Input        time step
+C      Ma1           Real           Output       mass flux adiabatic updraft
+C      upwd1         Real           Output       total upward mass flux (adiab+mixed)
+C      dnwd1         Real           Output       saturated downward mass flux (mixed)
+C      dnwd01        Real           Output       unsaturated downward mass flux 
+C      qcondc1       Real           Output       in-cld mixing ratio of condensed water
+C      wd1           Real           Output       downdraft velocity scale for sfc fluxes
+C      cape1         Real           Output       CAPE
+C
+C S. Bony, Mar 2002:
+C 	* Several modules corresponding to different physical processes
+C 	* Several versions of convect may be used:
+C  		- iflag_con=3: version lmd  (previously named convect3) 
+C  		- iflag_con=4: version 4.3b (vect. version, previously convect1/2) 
+C   + tard: 	- iflag_con=5: version lmd with ice (previously named convectg) 
+C S. Bony, Oct 2002:
+C	* Vectorization of convect3 (ie version lmd)
+C
+C..............................END PROLOGUE.............................
+c
+c
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer len
+      integer nd
+      integer ndp1
+      integer noff
+      integer iflag_con
+      integer ntra
+      real t1(len,nd)
+      real q1(len,nd)
+      real qs1(len,nd)
+      real u1(len,nd)
+      real v1(len,nd)
+      real p1(len,nd)
+      real ph1(len,ndp1)
+      integer iflag1(len)
+      real ft1(len,nd)
+      real fq1(len,nd)
+      real fu1(len,nd)
+      real fv1(len,nd)
+      real precip1(len)
+      real cbmf1(len)
+      real Ma1(len,nd)
+      real upwd1(len,nd)
+      real dnwd1(len,nd)
+      real dnwd01(len,nd)
+
+      real qcondc1(len,nd)     ! cld
+      real wd1(len)            ! gust
+      real cape1(len)     
+
+      real tra1(len,nd,ntra)
+      real ftra1(len,nd,ntra)
+
+      real delt
+
+!-------------------------------------------------------------------
+! --- ARGUMENTS
+!-------------------------------------------------------------------
+! --- On input:
+!
+!  t:   Array of absolute temperature (K) of dimension ND, with first
+!       index corresponding to lowest model level. Note that this array
+!       will be altered by the subroutine if dry convective adjustment
+!       occurs and if IPBL is not equal to 0.
+!
+!  q:   Array of specific humidity (gm/gm) of dimension ND, with first
+!       index corresponding to lowest model level. Must be defined
+!       at same grid levels as T. Note that this array will be altered
+!       if dry convective adjustment occurs and if IPBL is not equal to 0.
+!
+!  qs:  Array of saturation specific humidity of dimension ND, with first
+!       index corresponding to lowest model level. Must be defined
+!       at same grid levels as T. Note that this array will be altered
+!       if dry convective adjustment occurs and if IPBL is not equal to 0.
+!
+!  u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
+!       index corresponding with the lowest model level. Defined at
+!       same levels as T. Note that this array will be altered if
+!       dry convective adjustment occurs and if IPBL is not equal to 0.
+!
+!  v:   Same as u but for meridional velocity.
+!
+!  tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
+!       where NTRA is the number of different tracers. If no
+!       convective tracer transport is needed, define a dummy
+!       input array of dimension (ND,1). Tracers are defined at
+!       same vertical levels as T. Note that this array will be altered
+!       if dry convective adjustment occurs and if IPBL is not equal to 0.
+!
+!  p:   Array of pressure (mb) of dimension ND, with first
+!       index corresponding to lowest model level. Must be defined
+!       at same grid levels as T.
+!
+!  ph:  Array of pressure (mb) of dimension ND+1, with first index
+!       corresponding to lowest level. These pressures are defined at
+!       levels intermediate between those of P, T, Q and QS. The first
+!       value of PH should be greater than (i.e. at a lower level than)
+!       the first value of the array P.
+!
+!  nl:  The maximum number of levels to which convection can penetrate, plus 1.
+!       NL MUST be less than or equal to ND-1.
+!
+!  delt: The model time step (sec) between calls to CONVECT
+!
+!----------------------------------------------------------------------------
+! ---   On Output:
+!
+!  iflag: An output integer whose value denotes the following:
+!       VALUE   INTERPRETATION
+!       -----   --------------
+!         0     Moist convection occurs.
+!         1     Moist convection occurs, but a CFL condition
+!               on the subsidence warming is violated. This
+!               does not cause the scheme to terminate.
+!         2     Moist convection, but no precip because ep(inb) lt 0.0001
+!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
+!         4     No moist convection; atmosphere is not
+!               unstable
+!         6     No moist convection because ihmin le minorig.
+!         7     No moist convection because unreasonable
+!               parcel level temperature or specific humidity.
+!         8     No moist convection: lifted condensation
+!               level is above the 200 mb level.
+!         9     No moist convection: cloud base is higher
+!               then the level NL-1.
+!
+!  ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
+!        grid levels as T, Q, QS and P.
+!
+!  fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
+!        defined at same grid levels as T, Q, QS and P.
+!
+!  fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
+!        defined at same grid levels as T.
+!
+!  fv:   Same as FU, but for forcing of meridional velocity.
+!
+!  ftra: Array of forcing of tracer content, in tracer mixing ratio per
+!        second, defined at same levels as T. Dimensioned (ND,NTRA).
+!
+!  precip: Scalar convective precipitation rate (mm/day).
+!
+!  wd:   A convective downdraft velocity scale. For use in surface
+!        flux parameterizations. See convect.ps file for details.
+!
+!  tprime: A convective downdraft temperature perturbation scale (K).
+!          For use in surface flux parameterizations. See convect.ps
+!          file for details.
+!
+!  qprime: A convective downdraft specific humidity
+!          perturbation scale (gm/gm).
+!          For use in surface flux parameterizations. See convect.ps
+!          file for details.
+!
+!  cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
+!        BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
+!        ITS NEXT CALL. That is, the value of CBMF must be "remembered"
+!        by the calling program between calls to CONVECT.
+!
+!  det:   Array of detrainment mass flux of dimension ND.
+!
+!-------------------------------------------------------------------
+c
+c  Local arrays
+c
+
+      integer i,k,n,il,j
+      integer icbmax
+      integer nk1(klon)
+      integer icb1(klon)
+      integer icbs1(klon)
+
+      real plcl1(klon)
+      real tnk1(klon)
+      real qnk1(klon)
+      real gznk1(klon)
+      real pnk1(klon)
+      real qsnk1(klon)
+      real pbase1(klon)
+      real buoybase1(klon)
+
+      real lv1(klon,klev)
+      real cpn1(klon,klev)
+      real tv1(klon,klev)
+      real gz1(klon,klev)
+      real hm1(klon,klev)
+      real h1(klon,klev)
+      real tp1(klon,klev)
+      real tvp1(klon,klev)
+      real clw1(klon,klev)
+      real sig1(klon,klev)
+      real w01(klon,klev)
+      real th1(klon,klev)
+c
+      integer ncum
+c
+c (local) compressed fields:
+c
+      integer nloc
+      parameter (nloc=klon) ! pour l'instant
+
+      integer idcum(nloc)
+      integer iflag(nloc),nk(nloc),icb(nloc)
+      integer nent(nloc,klev)
+      integer icbs(nloc)
+      integer inb(nloc), inbis(nloc)
+
+      real cbmf(nloc),plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
+      real t(nloc,klev),q(nloc,klev),qs(nloc,klev)
+      real u(nloc,klev),v(nloc,klev)
+      real gz(nloc,klev),h(nloc,klev),lv(nloc,klev),cpn(nloc,klev)
+      real p(nloc,klev),ph(nloc,klev+1),tv(nloc,klev),tp(nloc,klev)
+      real clw(nloc,klev)
+      real dph(nloc,klev)
+      real pbase(nloc), buoybase(nloc), th(nloc,klev)
+      real tvp(nloc,klev)
+      real sig(nloc,klev), w0(nloc,klev)
+      real hp(nloc,klev), ep(nloc,klev), sigp(nloc,klev)
+      real frac(nloc), buoy(nloc,klev)
+      real cape(nloc)
+      real m(nloc,klev), ment(nloc,klev,klev), qent(nloc,klev,klev)
+      real uent(nloc,klev,klev), vent(nloc,klev,klev)
+      real ments(nloc,klev,klev), qents(nloc,klev,klev)
+      real sij(nloc,klev,klev), elij(nloc,klev,klev)
+      real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
+      real wt(nloc,klev), water(nloc,klev), evap(nloc,klev)
+      real b(nloc,klev), ft(nloc,klev), fq(nloc,klev)
+      real fu(nloc,klev), fv(nloc,klev)
+      real upwd(nloc,klev), dnwd(nloc,klev), dnwd0(nloc,klev)
+      real Ma(nloc,klev), mike(nloc,klev), tls(nloc,klev)
+      real tps(nloc,klev), qprime(nloc), tprime(nloc)
+      real precip(nloc)
+      real tra(nloc,klev,ntra), trap(nloc,klev,ntra)
+      real ftra(nloc,klev,ntra), traent(nloc,klev,klev,ntra)
+      real qcondc(nloc,klev)  ! cld
+      real wd(nloc)           ! gust
+
+!-------------------------------------------------------------------
+! --- SET CONSTANTS AND PARAMETERS
+!-------------------------------------------------------------------
+
+c -- set simulation flags:
+c   (common cvflag)
+
+       CALL cv_flag
+
+c -- set thermodynamical constants:
+c 	(common cvthermo)
+
+       CALL cv_thermo(iflag_con)
+
+c -- set convect parameters 
+c
+c 	includes microphysical parameters and parameters that 
+c  	control the rate of approach to quasi-equilibrium) 
+c 	(common cvparam)
+
+      if (iflag_con.eq.3) then
+       CALL cv3_param(nd,delt)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_param(nd)
+      endif
+
+!---------------------------------------------------------------------
+! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
+!---------------------------------------------------------------------
+
+      do 20 k=1,nd
+        do 10 i=1,len
+         ft1(i,k)=0.0
+         fq1(i,k)=0.0
+         fu1(i,k)=0.0
+         fv1(i,k)=0.0
+         tvp1(i,k)=0.0
+         tp1(i,k)=0.0
+         clw1(i,k)=0.0
+         gz1(i,k) = 0.
+
+         Ma1(i,k)=0.0
+         upwd1(i,k)=0.0
+         dnwd1(i,k)=0.0
+         dnwd01(i,k)=0.0
+         qcondc1(i,k)=0.0
+ 10     continue
+ 20   continue
+
+      do 30 j=1,ntra
+       do 31 k=1,nd
+        do 32 i=1,len
+         ftra1(i,k,j)=0.0
+ 32     continue    
+ 31    continue    
+ 30   continue    
+
+      do 60 i=1,len
+        precip1(i)=0.0
+        iflag1(i)=0
+        wd1(i)=0.0
+        cape1(i)=0.0
+ 60   continue
+
+      if (iflag_con.eq.3) then
+        do il=1,len
+         sig1(il,nd)=sig1(il,nd)+1.
+         sig1(il,nd)=amin1(sig1(il,nd),12.1)
+        enddo
+      endif
+
+!--------------------------------------------------------------------
+! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+!--------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_prelim(len,nd,ndp1,t1,q1,p1,ph1            ! nd->na
+     o               ,lv1,cpn1,tv1,gz1,h1,hm1,th1)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_prelim(len,nd,ndp1,t1,q1,p1,ph1
+     o               ,lv1,cpn1,tv1,gz1,h1,hm1)
+      endif
+
+!--------------------------------------------------------------------
+! --- CONVECTIVE FEED
+!--------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_feed(len,nd,t1,q1,qs1,p1,ph1,hm1,gz1           ! nd->na
+     o         ,nk1,icb1,icbmax,iflag1,tnk1,qnk1,gznk1,plcl1)
+      endif 
+
+      if (iflag_con.eq.4) then
+       CALL cv_feed(len,nd,t1,q1,qs1,p1,hm1,gz1
+     o         ,nk1,icb1,icbmax,iflag1,tnk1,qnk1,gznk1,plcl1)
+      endif 
+
+!--------------------------------------------------------------------
+! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part 
+! (up through ICB for convect4, up through ICB+1 for convect3)
+!     Calculates the lifted parcel virtual temperature at nk, the
+!     actual temperature, and the adiabatic liquid water content. 
+!--------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_undilute1(len,nd,t1,q1,qs1,gz1,plcl1,p1,nk1,icb1  ! nd->na
+     o                        ,tp1,tvp1,clw1,icbs1)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_undilute1(len,nd,t1,q1,qs1,gz1,p1,nk1,icb1,icbmax
+     :                        ,tp1,tvp1,clw1)
+      endif
+
+!-------------------------------------------------------------------
+! --- TRIGGERING
+!-------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_trigger(len,nd,icb1,plcl1,p1,th1,tv1,tvp1      ! nd->na
+     o                 ,pbase1,buoybase1,iflag1,sig1,w01)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_trigger(len,nd,icb1,cbmf1,tv1,tvp1,iflag1)
+      endif
+
+!=====================================================================
+! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
+!=====================================================================
+
+      ncum=0
+      do 400 i=1,len
+        if(iflag1(i).eq.0)then
+           ncum=ncum+1
+           idcum(ncum)=i
+        endif
+ 400  continue
+
+c       print*,'klon, ncum = ',len,ncum
+
+      IF (ncum.gt.0) THEN
+
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! --- COMPRESS THE FIELDS
+!		(-> vectorization over convective gridpoints)
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+      if (iflag_con.eq.3) then
+       CALL cv3_compress( len,nloc,ncum,nd,ntra
+     :    ,iflag1,nk1,icb1,icbs1
+     :    ,plcl1,tnk1,qnk1,gznk1,pbase1,buoybase1
+     :    ,t1,q1,qs1,u1,v1,gz1,th1
+     :    ,tra1
+     :    ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1 
+     :    ,sig1,w01
+     o    ,iflag,nk,icb,icbs
+     o    ,plcl,tnk,qnk,gznk,pbase,buoybase
+     o    ,t,q,qs,u,v,gz,th
+     o    ,tra
+     o    ,h,lv,cpn,p,ph,tv,tp,tvp,clw 
+     o    ,sig,w0  )
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_compress( len,nloc,ncum,nd
+     :    ,iflag1,nk1,icb1
+     :    ,cbmf1,plcl1,tnk1,qnk1,gznk1
+     :    ,t1,q1,qs1,u1,v1,gz1
+     :    ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1
+     o    ,iflag,nk,icb
+     o    ,cbmf,plcl,tnk,qnk,gznk
+     o    ,t,q,qs,u,v,gz,h,lv,cpn,p,ph,tv,tp,tvp,clw 
+     o    ,dph )
+      endif
+
+!-------------------------------------------------------------------
+! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
+! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+! ---   &
+! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
+! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+! ---   &
+! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
+!-------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_undilute2(nloc,ncum,nd,icb,icbs,nk        !na->nd
+     :                        ,tnk,qnk,gznk,t,q,qs,gz
+     :                        ,p,h,tv,lv,pbase,buoybase,plcl
+     o                        ,inb,tp,tvp,clw,hp,ep,sigp,buoy)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_undilute2(nloc,ncum,nd,icb,nk
+     :                        ,tnk,qnk,gznk,t,q,qs,gz
+     :                        ,p,dph,h,tv,lv
+     o             ,inb,inbis,tp,tvp,clw,hp,ep,sigp,frac)
+      endif
+
+!-------------------------------------------------------------------
+! --- CLOSURE
+!-------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_closure(nloc,ncum,nd,icb,inb              ! na->nd
+     :                       ,pbase,p,ph,tv,buoy
+     o                       ,sig,w0,cape,m)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_closure(nloc,ncum,nd,nk,icb
+     :                ,tv,tvp,p,ph,dph,plcl,cpn
+     o                ,iflag,cbmf)
+      endif
+
+!-------------------------------------------------------------------
+! --- MIXING
+!-------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_mixing(nloc,ncum,nd,nd,ntra,icb,nk,inb    ! na->nd
+     :                     ,ph,t,q,qs,u,v,tra,h,lv,qnk
+     :                     ,hp,tv,tvp,ep,clw,m,sig
+     o ,ment,qent,uent,vent,sij,elij,ments,qents,traent)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_mixing(nloc,ncum,nd,icb,nk,inb,inbis
+     :                     ,ph,t,q,qs,u,v,h,lv,qnk
+     :                     ,hp,tv,tvp,ep,clw,cbmf
+     o                     ,m,ment,qent,uent,vent,nent,sij,elij)
+      endif
+
+!-------------------------------------------------------------------
+! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
+!-------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_unsat(nloc,ncum,nd,nd,ntra,icb,inb    ! na->nd
+     :               ,t,q,qs,gz,u,v,tra,p,ph
+     :               ,th,tv,lv,cpn,ep,sigp,clw
+     :               ,m,ment,elij,delt,plcl
+     o          ,mp,qp,up,vp,trap,wt,water,evap,b)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_unsat(nloc,ncum,nd,inb,t,q,qs,gz,u,v,p,ph
+     :                   ,h,lv,ep,sigp,clw,m,ment,elij
+     o                   ,iflag,mp,qp,up,vp,wt,water,evap)
+      endif
+
+!-------------------------------------------------------------------
+! --- YIELD
+!     (tendencies, precipitation, variables of interface with other
+!      processes, etc)
+!-------------------------------------------------------------------
+
+      if (iflag_con.eq.3) then
+       CALL cv3_yield(nloc,ncum,nd,nd,ntra            ! na->nd
+     :                     ,icb,inb,delt
+     :                     ,t,q,u,v,tra,gz,p,ph,h,hp,lv,cpn,th
+     :                     ,ep,clw,m,tp,mp,qp,up,vp,trap
+     :                     ,wt,water,evap,b
+     :                     ,ment,qent,uent,vent,nent,elij,traent,sig
+     :                     ,tv,tvp
+     o                     ,iflag,precip,ft,fq,fu,fv,ftra
+     o                     ,upwd,dnwd,dnwd0,ma,mike,tls,tps,qcondc,wd)
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_yield(nloc,ncum,nd,nk,icb,inb,delt
+     :              ,t,q,u,v,gz,p,ph,h,hp,lv,cpn
+     :              ,ep,clw,frac,m,mp,qp,up,vp
+     :              ,wt,water,evap
+     :              ,ment,qent,uent,vent,nent,elij
+     :              ,tv,tvp
+     o              ,iflag,wd,qprime,tprime
+     o              ,precip,cbmf,ft,fq,fu,fv,Ma,qcondc)
+      endif
+
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! --- UNCOMPRESS THE FIELDS
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+
+      if (iflag_con.eq.3) then
+       CALL cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
+     :          ,iflag
+     :          ,precip,sig,w0
+     :          ,ft,fq,fu,fv,ftra
+     :          ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
+     o          ,iflag1
+     o          ,precip1,sig1,w01
+     o          ,ft1,fq1,fu1,fv1,ftra1
+     o          ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1 )
+      endif
+
+      if (iflag_con.eq.4) then
+       CALL cv_uncompress(nloc,len,ncum,nd,idcum
+     :          ,iflag
+     :          ,precip,cbmf
+     :          ,ft,fq,fu,fv
+     :          ,Ma,qcondc            
+     o          ,iflag1
+     o          ,precip1,cbmf1
+     o          ,ft1,fq1,fu1,fv1
+     o          ,Ma1,qcondc1 )           
+      endif
+
+      ENDIF ! ncum>0
+
+9999  continue
+
+      return
+      end
+
+!==================================================================
+      SUBROUTINE cv_flag
+      implicit none
+
+#include "cvflag.h"
+
+c -- si .TRUE., on rend la gravite plus explicite et eventuellement
+c differente de 10.0 dans convect3: 
+      cvflag_grav = .FALSE.
+
+      return
+      end
+
+!==================================================================
+      SUBROUTINE cv_thermo(iflag_con)
+	  implicit none
+
+c-------------------------------------------------------------
+c Set thermodynamical constants for convectL
+c-------------------------------------------------------------
+
+#include "YOMCST.h" 
+#include "cvthermo.h" 
+
+      integer iflag_con
+
+
+c original set from convect:
+      if (iflag_con.eq.4) then
+       cpd=1005.7
+       cpv=1870.0
+       cl=4190.0
+       rrv=461.5
+       rrd=287.04
+       lv0=2.501E6
+       g=9.8
+       t0=273.15
+       grav=g
+      endif
+
+c constants consistent with LMDZ:
+      if (iflag_con.eq.3) then
+       cpd = RCPD
+       cpv = RCPV
+       cl  = RCW
+       rrv = RV
+       rrd = RD
+       lv0 = RLVTT
+       g   = RG     ! not used in convect3
+c ori      t0  = RTT
+       t0  = 273.15 ! convect3 (RTT=273.16)
+       grav= 10.    ! implicitely or explicitely used in convect3
+      endif
+
+      rowl=1000.0 !(a quelle variable de YOMCST cela correspond-il?)
+
+      clmcpv=cl-cpv
+      clmcpd=cl-cpd
+      cpdmcp=cpd-cpv
+      cpvmcpd=cpv-cpd
+      cpvmcl=cl-cpv ! for convect3
+      eps=rrd/rrv
+      epsi=1.0/eps
+      epsim1=epsi-1.0
+c      ginv=1.0/g
+      ginv=1.0/grav
+      hrd=0.5*rrd
+
+      return
+      end
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/cv_routines.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/cv_routines.F	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/cv_routines.F	(revision 418)
@@ -0,0 +1,1752 @@
+      SUBROUTINE cv_param(nd)
+      implicit none
+
+c------------------------------------------------------------
+c Set parameters for convectL
+c (includes microphysical parameters and parameters that 
+c  control the rate of approach to quasi-equilibrium) 
+c------------------------------------------------------------
+
+C   *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
+C   ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
+C   ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
+C   ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
+C   ***               BETWEEN 0 C AND TLCRIT)                        ***
+C   ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
+C   ***                       FORMULATION                            ***
+C   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
+C   ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
+C   ***                        OF CLOUD                              ***
+C   ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
+C   ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
+C   ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
+C   ***                          OF RAIN                             ***
+C   ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
+C   ***                          OF SNOW                             ***
+C   ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
+C   ***                         TRANSPORT                            ***
+C   ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
+C   ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
+C   ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
+C   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
+C   ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
+C   ***                   (DAMP MUST BE LESS THAN 1)                 ***
+
+#include "cvparam.h"
+      integer nd
+
+c noff: integer limit for convection (nd-noff)
+c minorig: First level of convection
+
+      noff = 2
+      minorig = 2
+
+      nl=nd-noff
+      nlp=nl+1
+      nlm=nl-1
+
+      elcrit=0.0011
+      tlcrit=-55.0
+      entp=1.5
+      sigs=0.12
+      sigd=0.05
+      omtrain=50.0
+      omtsnow=5.5
+      coeffr=1.0
+      coeffs=0.8
+      dtmax=0.9
+c
+      cu=0.70
+c
+      betad=10.0
+c
+      damp=0.1
+      alpha=0.2
+c
+      delta=0.01  ! cld
+c
+      return
+      end
+
+      SUBROUTINE cv_prelim(len,nd,ndp1,t,q,p,ph
+     :                    ,lv,cpn,tv,gz,h,hm)
+      implicit none
+
+!=====================================================================
+! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+!=====================================================================
+
+c inputs:
+      integer len, nd, ndp1
+      real t(len,nd), q(len,nd), p(len,nd), ph(len,ndp1)
+
+c outputs:
+      real lv(len,nd), cpn(len,nd), tv(len,nd)
+      real gz(len,nd), h(len,nd), hm(len,nd)
+
+c local variables:
+      integer k, i
+      real cpx(len,nd)
+
+#include "cvthermo.h"
+#include "cvparam.h"
+
+
+      do 110 k=1,nlp
+        do 100 i=1,len
+          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
+          cpn(i,k)=cpd*(1.0-q(i,k))+cpv*q(i,k)
+          cpx(i,k)=cpd*(1.0-q(i,k))+cl*q(i,k)
+          tv(i,k)=t(i,k)*(1.0+q(i,k)*epsim1)
+ 100    continue
+ 110  continue
+c
+c gz = phi at the full levels (same as p).
+c
+      do 120 i=1,len
+        gz(i,1)=0.0
+ 120  continue
+      do 140 k=2,nlp
+        do 130 i=1,len
+          gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
+     &         *(p(i,k-1)-p(i,k))/ph(i,k)
+ 130    continue
+ 140  continue
+c
+c h  = phi + cpT (dry static energy).
+c hm = phi + cp(T-Tbase)+Lq
+c
+      do 170 k=1,nlp
+        do 160 i=1,len
+          h(i,k)=gz(i,k)+cpn(i,k)*t(i,k)
+          hm(i,k)=gz(i,k)+cpx(i,k)*(t(i,k)-t(i,1))+lv(i,k)*q(i,k)
+ 160    continue
+ 170  continue
+
+      return
+      end
+
+      SUBROUTINE cv_feed(len,nd,t,q,qs,p,hm,gz
+     :                  ,nk,icb,icbmax,iflag,tnk,qnk,gznk,plcl)
+      implicit none
+
+C================================================================
+C Purpose: CONVECTIVE FEED
+C================================================================
+
+#include "cvparam.h"
+
+c inputs:
+	  integer len, nd
+      real t(len,nd), q(len,nd), qs(len,nd), p(len,nd)
+      real hm(len,nd), gz(len,nd)
+
+c outputs:
+	  integer iflag(len), nk(len), icb(len), icbmax
+      real tnk(len), qnk(len), gznk(len), plcl(len)
+
+c local variables:
+      integer i, k
+      integer ihmin(len)
+      real work(len)
+      real pnk(len), qsnk(len), rh(len), chi(len)
+
+!-------------------------------------------------------------------
+! --- Find level of minimum moist static energy
+! --- If level of minimum moist static energy coincides with
+! --- or is lower than minimum allowable parcel origin level,
+! --- set iflag to 6.
+!-------------------------------------------------------------------
+
+      do 180 i=1,len
+       work(i)=1.0e12
+       ihmin(i)=nl
+ 180  continue
+      do 200 k=2,nlp
+        do 190 i=1,len
+         if((hm(i,k).lt.work(i)).and.
+     &      (hm(i,k).lt.hm(i,k-1)))then
+           work(i)=hm(i,k)
+           ihmin(i)=k
+         endif
+ 190    continue
+ 200  continue
+      do 210 i=1,len
+        ihmin(i)=min(ihmin(i),nlm)
+        if(ihmin(i).le.minorig)then
+          iflag(i)=6
+        endif
+ 210  continue
+c
+!-------------------------------------------------------------------
+! --- Find that model level below the level of minimum moist static
+! --- energy that has the maximum value of moist static energy
+!-------------------------------------------------------------------
+ 
+      do 220 i=1,len
+       work(i)=hm(i,minorig)
+       nk(i)=minorig
+ 220  continue
+      do 240 k=minorig+1,nl
+        do 230 i=1,len
+         if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))then
+           work(i)=hm(i,k)
+           nk(i)=k
+         endif
+ 230     continue
+ 240  continue
+!-------------------------------------------------------------------
+! --- Check whether parcel level temperature and specific humidity
+! --- are reasonable
+!-------------------------------------------------------------------
+       do 250 i=1,len
+       if(((t(i,nk(i)).lt.250.0).or.
+     &      (q(i,nk(i)).le.0.0).or.
+     &      (p(i,ihmin(i)).lt.400.0)).and.
+     &      (iflag(i).eq.0))iflag(i)=7
+ 250   continue
+!-------------------------------------------------------------------
+! --- Calculate lifted condensation level of air at parcel origin level
+! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)
+!-------------------------------------------------------------------
+       do 260 i=1,len
+        tnk(i)=t(i,nk(i))
+        qnk(i)=q(i,nk(i))
+        gznk(i)=gz(i,nk(i))
+        pnk(i)=p(i,nk(i))
+        qsnk(i)=qs(i,nk(i))
+c
+        rh(i)=qnk(i)/qsnk(i)
+        rh(i)=min(1.0,rh(i))
+        chi(i)=tnk(i)/(1669.0-122.0*rh(i)-tnk(i))
+        plcl(i)=pnk(i)*(rh(i)**chi(i))
+        if(((plcl(i).lt.200.0).or.(plcl(i).ge.2000.0))
+     &   .and.(iflag(i).eq.0))iflag(i)=8
+ 260   continue
+!-------------------------------------------------------------------
+! --- Calculate first level above lcl (=icb)
+!-------------------------------------------------------------------
+      do 270 i=1,len
+       icb(i)=nlm
+ 270  continue
+c
+      do 290 k=minorig,nl
+        do 280 i=1,len
+          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
+     &    icb(i)=min(icb(i),k)
+ 280    continue
+ 290  continue
+c
+      do 300 i=1,len
+        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+ 300  continue
+c
+c Compute icbmax.
+c
+      icbmax=2
+      do 310 i=1,len
+        icbmax=max(icbmax,icb(i))
+ 310  continue
+
+      return
+      end
+
+      SUBROUTINE cv_undilute1(len,nd,t,q,qs,gz,p,nk,icb,icbmax
+     :                       ,tp,tvp,clw)
+      implicit none
+
+#include "cvthermo.h"
+#include "cvparam.h"
+
+c inputs:
+      integer len, nd
+      integer nk(len), icb(len), icbmax
+      real t(len,nd), q(len,nd), qs(len,nd), gz(len,nd)
+      real p(len,nd)
+
+c outputs:
+      real tp(len,nd), tvp(len,nd), clw(len,nd)
+
+c local variables:
+      integer i, k
+      real tg, qg, alv, s, ahg, tc, denom, es, rg
+      real ah0(len), cpp(len)
+      real tnk(len), qnk(len), gznk(len), ticb(len), gzicb(len)
+
+!-------------------------------------------------------------------
+! --- Calculates the lifted parcel virtual temperature at nk,
+! --- the actual temperature, and the adiabatic
+! --- liquid water content. The procedure is to solve the equation.
+!     cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+!-------------------------------------------------------------------
+
+      do 320 i=1,len
+        tnk(i)=t(i,nk(i))
+        qnk(i)=q(i,nk(i))
+        gznk(i)=gz(i,nk(i))
+        ticb(i)=t(i,icb(i))
+        gzicb(i)=gz(i,icb(i))
+ 320  continue
+c
+c   ***  Calculate certain parcel quantities, including static energy   ***
+c
+      do 330 i=1,len
+        ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
+     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
+        cpp(i)=cpd*(1.-qnk(i))+qnk(i)*cpv
+ 330  continue
+c
+c   ***   Calculate lifted parcel quantities below cloud base   ***
+c
+        do 350 k=minorig,icbmax-1
+          do 340 i=1,len
+           tp(i,k)=tnk(i)-(gz(i,k)-gznk(i))/cpp(i)
+           tvp(i,k)=tp(i,k)*(1.+qnk(i)*epsi)
+  340     continue
+  350   continue
+c
+c    ***  Find lifted parcel quantities above cloud base    ***
+c
+        do 360 i=1,len
+         tg=ticb(i)
+         qg=qs(i,icb(i))
+         alv=lv0-clmcpv*(ticb(i)-t0)
+c
+c First iteration.
+c
+          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+          s=1./s
+          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+          tg=tg+s*(ah0(i)-ahg)
+          tg=max(tg,35.0)
+          tc=tg-t0
+          denom=243.5+tc
+          if(tc.ge.0.0)then
+           es=6.112*exp(17.67*tc/denom)
+          else
+           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          endif
+          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+c
+c Second iteration.
+c
+          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+          s=1./s
+          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+          tg=tg+s*(ah0(i)-ahg)
+          tg=max(tg,35.0)
+          tc=tg-t0
+          denom=243.5+tc
+          if(tc.ge.0.0)then
+           es=6.112*exp(17.67*tc/denom)
+          else
+           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          end if
+          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+c
+         alv=lv0-clmcpv*(ticb(i)-273.15)
+         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+     &   -gz(i,icb(i))-alv*qg)/cpd
+         clw(i,icb(i))=qnk(i)-qg
+         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
+         rg=qg/(1.-qnk(i))
+         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+  360   continue
+c
+      do 380 k=minorig,icbmax
+       do 370 i=1,len
+         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
+ 370   continue
+ 380  continue
+c
+      return
+      end
+
+      SUBROUTINE cv_trigger(len,nd,icb,cbmf,tv,tvp,iflag)
+      implicit none
+
+!-------------------------------------------------------------------
+! --- Test for instability.
+! --- If there was no convection at last time step and parcel
+! --- is stable at icb, then set iflag to 4.
+!-------------------------------------------------------------------
+ 
+#include "cvparam.h"
+
+c inputs:
+       integer len, nd, icb(len)
+       real cbmf(len), tv(len,nd), tvp(len,nd)
+
+c outputs:
+       integer iflag(len) ! also an input
+
+c local variables:
+       integer i
+
+
+      do 390 i=1,len
+        if((cbmf(i).eq.0.0) .and.(iflag(i).eq.0).and.
+     &  (tvp(i,icb(i)).le.(tv(i,icb(i))-dtmax)))iflag(i)=4
+ 390  continue
+ 
+      return
+      end
+
+      SUBROUTINE cv_compress( len,nloc,ncum,nd
+     :   ,iflag1,nk1,icb1
+     :   ,cbmf1,plcl1,tnk1,qnk1,gznk1
+     :   ,t1,q1,qs1,u1,v1,gz1
+     :   ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1
+     o   ,iflag,nk,icb
+     o   ,cbmf,plcl,tnk,qnk,gznk
+     o   ,t,q,qs,u,v,gz,h,lv,cpn,p,ph,tv,tp,tvp,clw 
+     o   ,dph          )
+      implicit none
+
+#include "cvparam.h"
+
+c inputs:
+      integer len,ncum,nd,nloc
+      integer iflag1(len),nk1(len),icb1(len)
+      real cbmf1(len),plcl1(len),tnk1(len),qnk1(len),gznk1(len)
+      real t1(len,nd),q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)
+      real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)
+      real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
+      real tvp1(len,nd),clw1(len,nd)
+
+c outputs:
+      integer iflag(nloc),nk(nloc),icb(nloc)
+      real cbmf(nloc),plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
+      real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)
+      real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)
+      real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)
+      real tvp(nloc,nd),clw(nloc,nd)
+      real dph(nloc,nd)
+
+c local variables:
+      integer i,k,nn
+
+
+      do 110 k=1,nl+1
+       nn=0
+      do 100 i=1,len
+      if(iflag1(i).eq.0)then
+        nn=nn+1
+        t(nn,k)=t1(i,k)
+        q(nn,k)=q1(i,k)
+        qs(nn,k)=qs1(i,k)
+        u(nn,k)=u1(i,k)
+        v(nn,k)=v1(i,k)
+        gz(nn,k)=gz1(i,k)
+        h(nn,k)=h1(i,k)
+        lv(nn,k)=lv1(i,k)
+        cpn(nn,k)=cpn1(i,k)
+        p(nn,k)=p1(i,k)
+        ph(nn,k)=ph1(i,k)
+        tv(nn,k)=tv1(i,k)
+        tp(nn,k)=tp1(i,k)
+        tvp(nn,k)=tvp1(i,k)
+        clw(nn,k)=clw1(i,k)
+      endif
+ 100    continue
+ 110  continue
+
+      if (nn.ne.ncum) then
+         print*,'strange! nn not equal to ncum: ',nn,ncum
+         stop
+      endif
+
+      nn=0
+      do 150 i=1,len
+      if(iflag1(i).eq.0)then
+      nn=nn+1
+      cbmf(nn)=cbmf1(i)
+      plcl(nn)=plcl1(i)
+      tnk(nn)=tnk1(i)
+      qnk(nn)=qnk1(i)
+      gznk(nn)=gznk1(i)
+      nk(nn)=nk1(i)
+      icb(nn)=icb1(i)
+      iflag(nn)=iflag1(i)
+      endif
+ 150  continue
+
+      do 170 k=1,nl
+       do 160 i=1,ncum
+        dph(i,k)=ph(i,k)-ph(i,k+1)
+ 160   continue
+ 170  continue
+
+      return
+      end
+
+      SUBROUTINE cv_undilute2(nloc,ncum,nd,icb,nk
+     :                       ,tnk,qnk,gznk,t,q,qs,gz
+     :                       ,p,dph,h,tv,lv
+     o                       ,inb,inb1,tp,tvp,clw,hp,ep,sigp,frac)
+      implicit none
+
+C---------------------------------------------------------------------
+C Purpose:
+C     FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+C     &
+C     COMPUTE THE PRECIPITATION EFFICIENCIES AND THE 
+C     FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+C     &
+C     FIND THE LEVEL OF NEUTRAL BUOYANCY
+C---------------------------------------------------------------------
+
+#include "cvthermo.h"
+#include "cvparam.h"
+
+c inputs:
+      integer ncum, nd, nloc
+      integer icb(nloc), nk(nloc)
+      real t(nloc,nd), q(nloc,nd), qs(nloc,nd), gz(nloc,nd)
+      real p(nloc,nd), dph(nloc,nd)
+      real tnk(nloc), qnk(nloc), gznk(nloc)
+      real lv(nloc,nd), tv(nloc,nd), h(nloc,nd)
+
+c outputs:
+      integer inb(nloc), inb1(nloc)
+      real tp(nloc,nd), tvp(nloc,nd), clw(nloc,nd)
+      real ep(nloc,nd), sigp(nloc,nd), hp(nloc,nd)
+      real frac(nloc)
+
+c local variables:
+      integer i, k
+      real tg,qg,ahg,alv,s,tc,es,denom,rg,tca,elacrit
+      real by, defrac
+      real ah0(nloc), cape(nloc), capem(nloc), byp(nloc)
+      logical lcape(nloc)
+
+!=====================================================================
+! --- SOME INITIALIZATIONS
+!=====================================================================
+
+      do 170 k=1,nl
+      do 160 i=1,ncum
+       ep(i,k)=0.0
+       sigp(i,k)=sigs
+ 160  continue
+ 170  continue
+
+!=====================================================================
+! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+!=====================================================================
+c
+c ---       The procedure is to solve the equation.
+c              cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+c
+c   ***  Calculate certain parcel quantities, including static energy   ***
+c
+c
+      do 240 i=1,ncum
+         ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
+     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
+ 240  continue
+c
+c
+c    ***  Find lifted parcel quantities above cloud base    ***
+c
+c
+	do 300 k=minorig+1,nl
+	  do 290 i=1,ncum
+	    if(k.ge.(icb(i)+1))then
+	      tg=t(i,k)
+	      qg=qs(i,k)
+	      alv=lv0-clmcpv*(t(i,k)-t0)
+c
+c First iteration.
+c
+	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+	       s=1./s
+	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+	       tg=tg+s*(ah0(i)-ahg)
+	       tg=max(tg,35.0)
+	       tc=tg-t0
+	       denom=243.5+tc
+	       if(tc.ge.0.0)then
+			es=6.112*exp(17.67*tc/denom)
+	       else
+			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+	       endif
+			qg=eps*es/(p(i,k)-es*(1.-eps))
+c
+c Second iteration.
+c
+	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+	       s=1./s
+	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+	       tg=tg+s*(ah0(i)-ahg)
+	       tg=max(tg,35.0)
+	       tc=tg-t0
+	       denom=243.5+tc
+	       if(tc.ge.0.0)then
+			es=6.112*exp(17.67*tc/denom)
+	       else
+			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+	       endif
+			qg=eps*es/(p(i,k)-es*(1.-eps))
+c
+	       alv=lv0-clmcpv*(t(i,k)-t0)
+c      print*,'cpd dans convect2 ',cpd
+c      print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
+c      print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
+        tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
+c              if (.not.cpd.gt.1000.) then
+c                  print*,'CPD=',cpd
+c                  stop
+c              endif
+               clw(i,k)=qnk(i)-qg
+               clw(i,k)=max(0.0,clw(i,k))
+               rg=qg/(1.-qnk(i))
+               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
+            endif
+  290     continue
+  300   continue
+c
+!=====================================================================
+! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
+! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
+! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
+!=====================================================================
+c
+      do 320 k=minorig+1,nl
+        do 310 i=1,ncum
+          if(k.ge.(nk(i)+1))then
+            tca=tp(i,k)-t0
+            if(tca.ge.0.0)then
+              elacrit=elcrit
+            else
+              elacrit=elcrit*(1.0-tca/tlcrit)
+            endif
+            elacrit=max(elacrit,0.0)
+            ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
+            ep(i,k)=max(ep(i,k),0.0 )
+            ep(i,k)=min(ep(i,k),1.0 )
+            sigp(i,k)=sigs
+          endif
+ 310    continue
+ 320  continue
+c
+!=====================================================================
+! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
+! --- VIRTUAL TEMPERATURE
+!=====================================================================
+c
+      do 340 k=minorig+1,nl
+        do 330 i=1,ncum
+        if(k.ge.(icb(i)+1))then
+          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
+c         print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
+c         print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
+        endif
+ 330    continue
+ 340  continue
+      do 350 i=1,ncum
+       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
+ 350  continue
+c
+c=====================================================================
+c  --- FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S
+c  --- HIGHEST LEVEL OF NEUTRAL BUOYANCY
+c  --- AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)
+c=====================================================================
+c
+      do 510 i=1,ncum
+        cape(i)=0.0
+        capem(i)=0.0
+        inb(i)=icb(i)+1
+        inb1(i)=inb(i)
+ 510  continue
+c
+c Originial Code
+c
+c     do 530 k=minorig+1,nl-1
+c       do 520 i=1,ncum
+c         if(k.ge.(icb(i)+1))then
+c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+c           byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+c           cape(i)=cape(i)+by
+c           if(by.ge.0.0)inb1(i)=k+1
+c           if(cape(i).gt.0.0)then
+c             inb(i)=k+1
+c             capem(i)=cape(i)
+c           endif
+c         endif
+c520    continue
+c530  continue
+c     do 540 i=1,ncum
+c         byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
+c         cape(i)=capem(i)+byp
+c         defrac=capem(i)-cape(i)
+c         defrac=max(defrac,0.001)
+c         frac(i)=-cape(i)/defrac
+c         frac(i)=min(frac(i),1.0)
+c         frac(i)=max(frac(i),0.0)
+c540   continue
+c
+c K Emanuel fix
+c
+c     call zilch(byp,ncum)
+c     do 530 k=minorig+1,nl-1
+c       do 520 i=1,ncum
+c         if(k.ge.(icb(i)+1))then
+c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+c           cape(i)=cape(i)+by
+c           if(by.ge.0.0)inb1(i)=k+1
+c           if(cape(i).gt.0.0)then
+c             inb(i)=k+1
+c             capem(i)=cape(i)
+c             byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+c           endif
+c         endif
+c520    continue
+c530  continue
+c     do 540 i=1,ncum
+c         inb(i)=max(inb(i),inb1(i))
+c         cape(i)=capem(i)+byp(i)
+c         defrac=capem(i)-cape(i)
+c         defrac=max(defrac,0.001)
+c         frac(i)=-cape(i)/defrac
+c         frac(i)=min(frac(i),1.0)
+c         frac(i)=max(frac(i),0.0)
+c540   continue
+c
+c J Teixeira fix
+c
+      call zilch(byp,ncum)
+      do 515 i=1,ncum
+        lcape(i)=.true.
+ 515  continue
+      do 530 k=minorig+1,nl-1
+        do 520 i=1,ncum
+          if(cape(i).lt.0.0)lcape(i)=.false.
+          if((k.ge.(icb(i)+1)).and.lcape(i))then
+            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+            cape(i)=cape(i)+by
+            if(by.ge.0.0)inb1(i)=k+1
+            if(cape(i).gt.0.0)then
+              inb(i)=k+1
+              capem(i)=cape(i)
+            endif
+          endif
+ 520    continue
+ 530  continue
+      do 540 i=1,ncum
+          cape(i)=capem(i)+byp(i)
+          defrac=capem(i)-cape(i)
+          defrac=max(defrac,0.001)
+          frac(i)=-cape(i)/defrac
+          frac(i)=min(frac(i),1.0)
+          frac(i)=max(frac(i),0.0)
+ 540  continue
+c
+c=====================================================================
+c ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
+c=====================================================================
+c
+c initialization:
+      do i=1,ncum*nlp
+       hp(i,1)=h(i,1)
+      enddo
+
+      do 600 k=minorig+1,nl
+        do 590 i=1,ncum
+        if((k.ge.icb(i)).and.(k.le.inb(i)))then
+          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
+        endif
+ 590    continue
+ 600  continue
+c
+        return
+        end
+c
+      SUBROUTINE cv_closure(nloc,ncum,nd,nk,icb
+     :                     ,tv,tvp,p,ph,dph,plcl,cpn
+     :                     ,iflag,cbmf)
+      implicit none
+
+c inputs:
+      integer ncum, nd, nloc
+      integer nk(nloc), icb(nloc)
+      real tv(nloc,nd), tvp(nloc,nd), p(nloc,nd), dph(nloc,nd)
+      real ph(nloc,nd+1) ! caution nd instead ndp1 to be consistent...
+      real plcl(nloc), cpn(nloc,nd)
+
+c outputs:
+      integer iflag(nloc)
+      real cbmf(nloc) ! also an input
+
+c local variables:
+      integer i, k, icbmax
+      real dtpbl(nloc), dtmin(nloc), tvpplcl(nloc), tvaplcl(nloc)
+      real work(nloc)
+
+#include "cvthermo.h"
+#include "cvparam.h"
+
+c-------------------------------------------------------------------
+c Compute icbmax. 
+c-------------------------------------------------------------------
+
+      icbmax=2
+      do 230 i=1,ncum
+       icbmax=max(icbmax,icb(i))
+ 230  continue
+
+c=====================================================================
+c ---  CALCULATE CLOUD BASE MASS FLUX 
+c=====================================================================
+c
+c tvpplcl = parcel temperature lifted adiabatically from level
+c           icb-1 to the LCL.
+c tvaplcl = virtual temperature at the LCL.
+c
+      do 610 i=1,ncum
+        dtpbl(i)=0.0
+        tvpplcl(i)=tvp(i,icb(i)-1)
+     &  -rrd*tvp(i,icb(i)-1)*(p(i,icb(i)-1)-plcl(i))
+     &  /(cpn(i,icb(i)-1)*p(i,icb(i)-1))
+        tvaplcl(i)=tv(i,icb(i))
+     &  +(tvp(i,icb(i))-tvp(i,icb(i)+1))*(plcl(i)-p(i,icb(i)))
+     &  /(p(i,icb(i))-p(i,icb(i)+1))
+ 610  continue
+
+c-------------------------------------------------------------------
+c --- Interpolate difference between lifted parcel and
+c --- environmental temperatures to lifted condensation level
+c-------------------------------------------------------------------
+c
+c dtpbl = average of tvp-tv in the PBL (k=nk to icb-1).
+c
+      do 630 k=minorig,icbmax
+        do 620 i=1,ncum
+        if((k.ge.nk(i)).and.(k.le.(icb(i)-1)))then
+          dtpbl(i)=dtpbl(i)+(tvp(i,k)-tv(i,k))*dph(i,k)
+        endif
+ 620    continue
+ 630  continue
+      do 640 i=1,ncum
+        dtpbl(i)=dtpbl(i)/(ph(i,nk(i))-ph(i,icb(i)))
+        dtmin(i)=tvpplcl(i)-tvaplcl(i)+dtmax+dtpbl(i)
+ 640  continue
+c
+c-------------------------------------------------------------------
+c --- Adjust cloud base mass flux
+c-------------------------------------------------------------------
+c
+      do 650 i=1,ncum
+       work(i)=cbmf(i)
+       cbmf(i)=max(0.0,(1.0-damp)*cbmf(i)+0.1*alpha*dtmin(i))
+       if((work(i).eq.0.0).and.(cbmf(i).eq.0.0))then
+         iflag(i)=3
+       endif
+ 650  continue
+
+       return
+       end
+
+      SUBROUTINE cv_mixing(nloc,ncum,nd,icb,nk,inb,inb1
+     :                    ,ph,t,q,qs,u,v,h,lv,qnk
+     :                    ,hp,tv,tvp,ep,clw,cbmf
+     :                    ,m,ment,qent,uent,vent,nent,sij,elij)
+      implicit none
+
+#include "cvthermo.h"
+#include "cvparam.h"
+
+c inputs:
+      integer ncum, nd, nloc
+      integer icb(nloc), inb(nloc), inb1(nloc), nk(nloc)
+      real cbmf(nloc), qnk(nloc)
+      real ph(nloc,nd+1)
+      real t(nloc,nd), q(nloc,nd), qs(nloc,nd), lv(nloc,nd)
+      real u(nloc,nd), v(nloc,nd), h(nloc,nd), hp(nloc,nd)
+      real tv(nloc,nd), tvp(nloc,nd), ep(nloc,nd), clw(nloc,nd)
+
+c outputs:
+      integer nent(nloc,nd)
+      real m(nloc,nd), ment(nloc,nd,nd), qent(nloc,nd,nd)
+      real uent(nloc,nd,nd), vent(nloc,nd,nd)
+      real sij(nloc,nd,nd), elij(nloc,nd,nd)
+
+c local variables:
+      integer i, j, k, ij
+      integer num1, num2
+      real dbo, qti, bf2, anum, denom, dei, altem, cwat, stemp
+      real alt, qp1, smid, sjmin, sjmax, delp, delm
+      real work(nloc), asij(nloc), smin(nloc), scrit(nloc)
+      real bsum(nloc,nd)
+      logical lwork(nloc)
+
+c=====================================================================
+c --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
+c=====================================================================
+c
+        do 360 i=1,ncum*nlp
+          nent(i,1)=0
+          m(i,1)=0.0
+ 360    continue
+c
+      do 400 k=1,nlp
+       do 390 j=1,nlp
+          do 385 i=1,ncum
+            qent(i,k,j)=q(i,j)
+            uent(i,k,j)=u(i,j)
+            vent(i,k,j)=v(i,j)
+            elij(i,k,j)=0.0
+            ment(i,k,j)=0.0
+            sij(i,k,j)=0.0
+ 385      continue
+ 390    continue
+ 400  continue
+c
+c-------------------------------------------------------------------
+c --- Calculate rates of mixing,  m(i)
+c-------------------------------------------------------------------
+c
+      call zilch(work,ncum)
+c
+      do 670 j=minorig+1,nl
+        do 660 i=1,ncum
+          if((j.ge.(icb(i)+1)).and.(j.le.inb(i)))then
+             k=min(j,inb1(i))
+             dbo=abs(tv(i,k+1)-tvp(i,k+1)-tv(i,k-1)+tvp(i,k-1))
+     &       +entp*0.04*(ph(i,k)-ph(i,k+1))
+             work(i)=work(i)+dbo
+             m(i,j)=cbmf(i)*dbo
+          endif
+ 660    continue
+ 670  continue
+      do 690 k=minorig+1,nl
+        do 680 i=1,ncum
+          if((k.ge.(icb(i)+1)).and.(k.le.inb(i)))then
+            m(i,k)=m(i,k)/work(i)
+          endif
+ 680    continue
+ 690  continue
+c
+c
+c=====================================================================
+c --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
+c --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
+c --- FRACTION (sij)
+c=====================================================================
+c
+c
+       do 750 i=minorig+1,nl
+         do 710 j=minorig+1,nl
+           do 700 ij=1,ncum
+             if((i.ge.(icb(ij)+1)).and.(j.ge.icb(ij))
+     &         .and.(i.le.inb(ij)).and.(j.le.inb(ij)))then
+               qti=qnk(ij)-ep(ij,i)*clw(ij,i)
+               bf2=1.+lv(ij,j)*lv(ij,j)*qs(ij,j)
+     &         /(rrv*t(ij,j)*t(ij,j)*cpd)
+               anum=h(ij,j)-hp(ij,i)+(cpv-cpd)*t(ij,j)*(qti-q(ij,j))
+               denom=h(ij,i)-hp(ij,i)+(cpd-cpv)*(q(ij,i)-qti)*t(ij,j)
+               dei=denom
+               if(abs(dei).lt.0.01)dei=0.01
+               sij(ij,i,j)=anum/dei
+               sij(ij,i,i)=1.0
+               altem=sij(ij,i,j)*q(ij,i)+(1.-sij(ij,i,j))*qti-qs(ij,j)
+               altem=altem/bf2
+               cwat=clw(ij,j)*(1.-ep(ij,j))
+               stemp=sij(ij,i,j)
+               if((stemp.lt.0.0.or.stemp.gt.1.0.or.
+     1           altem.gt.cwat).and.j.gt.i)then
+                 anum=anum-lv(ij,j)*(qti-qs(ij,j)-cwat*bf2)
+                 denom=denom+lv(ij,j)*(q(ij,i)-qti)
+                 if(abs(denom).lt.0.01)denom=0.01
+                 sij(ij,i,j)=anum/denom
+                 altem=sij(ij,i,j)*q(ij,i)+(1.-sij(ij,i,j))*qti-qs(ij,j)
+                 altem=altem-(bf2-1.)*cwat
+               endif
+               if(sij(ij,i,j).gt.0.0.and.sij(ij,i,j).lt.0.9)then
+                 qent(ij,i,j)=sij(ij,i,j)*q(ij,i)
+     &                        +(1.-sij(ij,i,j))*qti
+                 uent(ij,i,j)=sij(ij,i,j)*u(ij,i)
+     &                        +(1.-sij(ij,i,j))*u(ij,nk(ij))
+                 vent(ij,i,j)=sij(ij,i,j)*v(ij,i)
+     &                        +(1.-sij(ij,i,j))*v(ij,nk(ij))
+                 elij(ij,i,j)=altem
+                 elij(ij,i,j)=max(0.0,elij(ij,i,j))
+                 ment(ij,i,j)=m(ij,i)/(1.-sij(ij,i,j))
+                 nent(ij,i)=nent(ij,i)+1
+               endif
+             sij(ij,i,j)=max(0.0,sij(ij,i,j))
+             sij(ij,i,j)=min(1.0,sij(ij,i,j))
+             endif
+  700      continue
+  710    continue
+c
+c   ***   If no air can entrain at level i assume that updraft detrains  ***
+c   ***   at that level and calculate detrained air flux and properties  ***
+c
+           do 740 ij=1,ncum
+             if((i.ge.(icb(ij)+1)).and.(i.le.inb(ij))
+     &       .and.(nent(ij,i).eq.0))then
+               ment(ij,i,i)=m(ij,i)
+               qent(ij,i,i)=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
+               uent(ij,i,i)=u(ij,nk(ij))
+               vent(ij,i,i)=v(ij,nk(ij))
+               elij(ij,i,i)=clw(ij,i)
+               sij(ij,i,i)=1.0
+             endif
+ 740       continue
+ 750   continue
+c
+      do 770 i=1,ncum
+        sij(i,inb(i),inb(i))=1.0
+ 770  continue
+c
+c=====================================================================
+c   ---  NORMALIZE ENTRAINED AIR MASS FLUXES
+c   ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
+c=====================================================================
+c
+       call zilch(bsum,ncum*nlp)
+       do 780 ij=1,ncum
+         lwork(ij)=.false.
+ 780   continue
+       do 789 i=minorig+1,nl
+c
+         num1=0
+         do 779 ij=1,ncum
+           if((i.ge.icb(ij)+1).and.(i.le.inb(ij)))num1=num1+1
+ 779     continue
+         if(num1.le.0)go to 789
+c
+           do 781 ij=1,ncum
+             if((i.ge.icb(ij)+1).and.(i.le.inb(ij)))then
+                lwork(ij)=(nent(ij,i).ne.0)
+                qp1=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
+                anum=h(ij,i)-hp(ij,i)-lv(ij,i)*(qp1-qs(ij,i))
+                denom=h(ij,i)-hp(ij,i)+lv(ij,i)*(q(ij,i)-qp1)
+                if(abs(denom).lt.0.01)denom=0.01
+                scrit(ij)=anum/denom
+                alt=qp1-qs(ij,i)+scrit(ij)*(q(ij,i)-qp1)
+                if(scrit(ij).lt.0.0.or.alt.lt.0.0)scrit(ij)=1.0
+                asij(ij)=0.0
+                smin(ij)=1.0
+             endif
+ 781       continue
+         do 783 j=minorig,nl
+c
+         num2=0
+         do 778 ij=1,ncum
+             if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
+     &       .and.(j.ge.icb(ij)).and.(j.le.inb(ij))
+     &       .and.lwork(ij))num2=num2+1
+ 778     continue
+         if(num2.le.0)go to 783
+c
+           do 782 ij=1,ncum
+             if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
+     &       .and.(j.ge.icb(ij)).and.(j.le.inb(ij)).and.lwork(ij))then
+                  if(sij(ij,i,j).gt.0.0.and.sij(ij,i,j).lt.0.9)then
+                    if(j.gt.i)then
+                      smid=min(sij(ij,i,j),scrit(ij))
+                      sjmax=smid
+                      sjmin=smid
+                        if(smid.lt.smin(ij)
+     &                  .and.sij(ij,i,j+1).lt.smid)then
+                          smin(ij)=smid
+                          sjmax=min(sij(ij,i,j+1),sij(ij,i,j),scrit(ij))
+                          sjmin=max(sij(ij,i,j-1),sij(ij,i,j))
+                          sjmin=min(sjmin,scrit(ij))
+                        endif
+                    else
+                      sjmax=max(sij(ij,i,j+1),scrit(ij))
+                      smid=max(sij(ij,i,j),scrit(ij))
+                      sjmin=0.0
+                      if(j.gt.1)sjmin=sij(ij,i,j-1)
+                      sjmin=max(sjmin,scrit(ij))
+                    endif
+                    delp=abs(sjmax-smid)
+                    delm=abs(sjmin-smid)
+                    asij(ij)=asij(ij)+(delp+delm)
+     &                           *(ph(ij,j)-ph(ij,j+1))
+                    ment(ij,i,j)=ment(ij,i,j)*(delp+delm)
+     &                           *(ph(ij,j)-ph(ij,j+1))
+                  endif
+              endif
+  782    continue
+  783    continue
+            do 784 ij=1,ncum
+            if((i.ge.icb(ij)+1).and.(i.le.inb(ij)).and.lwork(ij))then
+               asij(ij)=max(1.0e-21,asij(ij))
+               asij(ij)=1.0/asij(ij)
+               bsum(ij,i)=0.0
+            endif
+ 784        continue
+            do 786 j=minorig,nl+1
+              do 785 ij=1,ncum
+                if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
+     &          .and.(j.ge.icb(ij)).and.(j.le.inb(ij))
+     &          .and.lwork(ij))then
+                   ment(ij,i,j)=ment(ij,i,j)*asij(ij)
+                   bsum(ij,i)=bsum(ij,i)+ment(ij,i,j)
+                endif
+ 785     continue
+ 786     continue
+             do 787 ij=1,ncum
+               if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
+     &         .and.(bsum(ij,i).lt.1.0e-18).and.lwork(ij))then
+                 nent(ij,i)=0
+                 ment(ij,i,i)=m(ij,i)
+                 qent(ij,i,i)=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
+                 uent(ij,i,i)=u(ij,nk(ij))
+                 vent(ij,i,i)=v(ij,nk(ij))
+                 elij(ij,i,i)=clw(ij,i)
+                 sij(ij,i,i)=1.0
+               endif
+  787        continue
+  789  continue
+c
+       return
+       end
+
+      SUBROUTINE cv_unsat(nloc,ncum,nd,inb,t,q,qs,gz,u,v,p,ph
+     :                  ,h,lv,ep,sigp,clw,m,ment,elij
+     :                  ,iflag,mp,qp,up,vp,wt,water,evap)
+      implicit none
+
+
+#include "cvthermo.h"
+#include "cvparam.h"
+
+c inputs:
+      integer ncum, nd, nloc
+      integer inb(nloc)
+      real t(nloc,nd), q(nloc,nd), qs(nloc,nd)
+      real gz(nloc,nd), u(nloc,nd), v(nloc,nd)
+      real p(nloc,nd), ph(nloc,nd+1), h(nloc,nd)
+      real lv(nloc,nd), ep(nloc,nd), sigp(nloc,nd), clw(nloc,nd)
+      real m(nloc,nd), ment(nloc,nd,nd), elij(nloc,nd,nd)
+
+c outputs:
+      integer iflag(nloc) ! also an input
+      real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
+      real water(nloc,nd), evap(nloc,nd), wt(nloc,nd)
+
+c local variables:
+      integer i,j,k,ij,num1
+      integer jtt(nloc)
+      real awat, coeff, qsm, afac, sigt, b6, c6, revap
+      real dhdp, fac, qstm, rat
+      real wdtrain(nloc)
+      logical lwork(nloc)
+
+c=====================================================================
+c --- PRECIPITATING DOWNDRAFT CALCULATION
+c=====================================================================
+c
+c Initializations:
+c
+         do i = 1, ncum
+         do k = 1, nl+1
+          wt(i,k) = omtsnow
+          mp(i,k) = 0.0
+          evap(i,k) = 0.0
+          water(i,k) = 0.0
+         enddo
+         enddo
+
+         do 420 i=1,ncum
+          qp(i,1)=q(i,1)
+          up(i,1)=u(i,1)
+          vp(i,1)=v(i,1)
+ 420     continue
+
+         do 440 k=2,nl+1
+         do 430 i=1,ncum
+          qp(i,k)=q(i,k-1)
+          up(i,k)=u(i,k-1)
+          vp(i,k)=v(i,k-1)
+ 430     continue
+ 440     continue
+
+
+c   ***  Check whether ep(inb)=0, if so, skip precipitating    ***
+c   ***             downdraft calculation                      ***
+c
+c
+c   ***  Integrate liquid water equation to find condensed water   ***
+c   ***                and condensed water flux                    ***
+c
+c
+      do 890 i=1,ncum
+        jtt(i)=2
+        if(ep(i,inb(i)).le.0.0001)iflag(i)=2
+        if(iflag(i).eq.0)then
+          lwork(i)=.true.
+        else
+          lwork(i)=.false.
+        endif
+ 890  continue
+c
+c    ***                    Begin downdraft loop                    ***
+c
+c
+        call zilch(wdtrain,ncum)
+        do 899 i=nl+1,1,-1
+c
+          num1=0
+          do 879 ij=1,ncum
+            if((i.le.inb(ij)).and.lwork(ij))num1=num1+1
+ 879      continue
+          if(num1.le.0)go to 899
+c
+c
+c    ***        Calculate detrained precipitation             ***
+c
+          do 891 ij=1,ncum
+            if((i.le.inb(ij)).and.(lwork(ij)))then
+            wdtrain(ij)=g*ep(ij,i)*m(ij,i)*clw(ij,i)
+            endif
+ 891      continue
+c
+          if(i.gt.1)then
+            do 893 j=1,i-1
+              do 892 ij=1,ncum
+                if((i.le.inb(ij)).and.(lwork(ij)))then
+                  awat=elij(ij,j,i)-(1.-ep(ij,i))*clw(ij,i)
+                  awat=max(0.0,awat)
+                  wdtrain(ij)=wdtrain(ij)+g*awat*ment(ij,j,i)
+                endif
+ 892          continue
+ 893      continue
+          endif
+c
+c    ***    Find rain water and evaporation using provisional   ***
+c    ***              estimates of qp(i)and qp(i-1)             ***
+c
+c
+c  ***  Value of terminal velocity and coeffecient of evaporation for snow   ***
+c
+          do 894 ij=1,ncum
+            if((i.le.inb(ij)).and.(lwork(ij)))then
+            coeff=coeffs
+            wt(ij,i)=omtsnow
+c
+c  ***  Value of terminal velocity and coeffecient of evaporation for rain   ***
+c
+            if(t(ij,i).gt.273.0)then
+              coeff=coeffr
+              wt(ij,i)=omtrain
+            endif
+            qsm=0.5*(q(ij,i)+qp(ij,i+1))
+            afac=coeff*ph(ij,i)*(qs(ij,i)-qsm)
+     &       /(1.0e4+2.0e3*ph(ij,i)*qs(ij,i))
+            afac=max(afac,0.0)
+            sigt=sigp(ij,i)
+            sigt=max(0.0,sigt)
+            sigt=min(1.0,sigt)
+            b6=100.*(ph(ij,i)-ph(ij,i+1))*sigt*afac/wt(ij,i)
+            c6=(water(ij,i+1)*wt(ij,i+1)+wdtrain(ij)/sigd)/wt(ij,i)
+            revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
+            evap(ij,i)=sigt*afac*revap
+            water(ij,i)=revap*revap
+c
+c    ***  Calculate precipitating downdraft mass flux under     ***
+c    ***              hydrostatic approximation                 ***
+c
+            if(i.gt.1)then
+              dhdp=(h(ij,i)-h(ij,i-1))/(p(ij,i-1)-p(ij,i))
+              dhdp=max(dhdp,10.0)
+              mp(ij,i)=100.*ginv*lv(ij,i)*sigd*evap(ij,i)/dhdp
+              mp(ij,i)=max(mp(ij,i),0.0)
+c
+c   ***   Add small amount of inertia to downdraft              ***
+c
+              fac=20.0/(ph(ij,i-1)-ph(ij,i))
+              mp(ij,i)=(fac*mp(ij,i+1)+mp(ij,i))/(1.+fac)
+c
+c    ***      Force mp to decrease linearly to zero                 ***
+c    ***      between about 950 mb and the surface                  ***
+c
+              if(p(ij,i).gt.(0.949*p(ij,1)))then
+                 jtt(ij)=max(jtt(ij),i)
+                 mp(ij,i)=mp(ij,jtt(ij))*(p(ij,1)-p(ij,i))
+     &           /(p(ij,1)-p(ij,jtt(ij)))
+              endif
+            endif
+c
+c    ***       Find mixing ratio of precipitating downdraft     ***
+c
+            if(i.ne.inb(ij))then
+              if(i.eq.1)then
+                qstm=qs(ij,1)
+              else
+                qstm=qs(ij,i-1)
+              endif
+              if(mp(ij,i).gt.mp(ij,i+1))then
+                 rat=mp(ij,i+1)/mp(ij,i)
+                 qp(ij,i)=qp(ij,i+1)*rat+q(ij,i)*(1.0-rat)+100.*ginv*
+     &             sigd*(ph(ij,i)-ph(ij,i+1))*(evap(ij,i)/mp(ij,i))
+                 up(ij,i)=up(ij,i+1)*rat+u(ij,i)*(1.-rat)
+                 vp(ij,i)=vp(ij,i+1)*rat+v(ij,i)*(1.-rat)
+               else
+                 if(mp(ij,i+1).gt.0.0)then
+                   qp(ij,i)=(gz(ij,i+1)-gz(ij,i)
+     &               +qp(ij,i+1)*(lv(ij,i+1)+t(ij,i+1)
+     &               *(cl-cpd))+cpd*(t(ij,i+1)-t(ij,i)))
+     &               /(lv(ij,i)+t(ij,i)*(cl-cpd))
+                   up(ij,i)=up(ij,i+1)
+                   vp(ij,i)=vp(ij,i+1)
+                 endif
+              endif
+              qp(ij,i)=min(qp(ij,i),qstm)
+              qp(ij,i)=max(qp(ij,i),0.0)
+            endif
+            endif
+ 894      continue
+ 899    continue
+c
+        return
+        end
+
+      SUBROUTINE cv_yield(nloc,ncum,nd,nk,icb,inb,delt
+     :             ,t,q,u,v,gz,p,ph,h,hp,lv,cpn
+     :             ,ep,clw,frac,m,mp,qp,up,vp
+     :             ,wt,water,evap
+     :             ,ment,qent,uent,vent,nent,elij
+     :             ,tv,tvp
+     o             ,iflag,wd,qprime,tprime
+     o             ,precip,cbmf,ft,fq,fu,fv,Ma,qcondc)
+      implicit none
+
+#include "cvthermo.h"
+#include "cvparam.h"
+
+c inputs
+      integer ncum, nd, nloc
+      integer nk(nloc), icb(nloc), inb(nloc)
+      integer nent(nloc,nd)
+      real delt
+      real t(nloc,nd), q(nloc,nd), u(nloc,nd), v(nloc,nd)
+      real gz(nloc,nd)
+      real p(nloc,nd), ph(nloc,nd+1), h(nloc,nd)
+      real hp(nloc,nd), lv(nloc,nd)
+      real cpn(nloc,nd), ep(nloc,nd), clw(nloc,nd), frac(nloc)
+      real m(nloc,nd), mp(nloc,nd), qp(nloc,nd)
+      real up(nloc,nd), vp(nloc,nd)
+      real wt(nloc,nd), water(nloc,nd), evap(nloc,nd)
+      real ment(nloc,nd,nd), qent(nloc,nd,nd), elij(nloc,nd,nd)
+      real uent(nloc,nd,nd), vent(nloc,nd,nd)
+      real tv(nloc,nd), tvp(nloc,nd)
+
+c outputs
+      integer iflag(nloc)  ! also an input
+      real cbmf(nloc)      ! also an input
+      real wd(nloc), tprime(nloc), qprime(nloc)
+      real precip(nloc)
+      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
+      real Ma(nloc,nd)
+      real qcondc(nloc,nd)
+
+c local variables
+      integer i,j,ij,k,num1
+      real dpinv,cpinv,awat,fqold,ftold,fuold,fvold,delti
+      real work(nloc), am(nloc),amp1(nloc),ad(nloc)
+      real ents(nloc), uav(nloc),vav(nloc),lvcp(nloc,nd)
+      real qcond(nloc,nd), nqcond(nloc,nd), wa(nloc,nd) ! cld
+      real siga(nloc,nd), ax(nloc,nd), mac(nloc,nd)     ! cld
+
+ 
+c -- initializations:
+
+      delti = 1.0/delt
+
+      do 160 i=1,ncum
+      precip(i)=0.0
+      wd(i)=0.0
+      tprime(i)=0.0
+      qprime(i)=0.0
+       do 170 k=1,nl+1
+        ft(i,k)=0.0
+        fu(i,k)=0.0
+        fv(i,k)=0.0
+        fq(i,k)=0.0
+        lvcp(i,k)=lv(i,k)/cpn(i,k)
+        qcondc(i,k)=0.0              ! cld
+        qcond(i,k)=0.0               ! cld
+        nqcond(i,k)=0.0              ! cld
+ 170   continue
+ 160  continue
+
+c
+c   ***  Calculate surface precipitation in mm/day     ***
+c
+        do 1190 i=1,ncum
+          if(iflag(i).le.1)then
+cc            precip(i)=precip(i)+wt(i,1)*sigd*water(i,1)*3600.*24000.
+cc     &                /(rowl*g)
+cc            precip(i)=precip(i)*delt/86400.
+            precip(i) = wt(i,1)*sigd*water(i,1)*86400/g
+          endif
+ 1190   continue
+c
+c
+c   ***  Calculate downdraft velocity scale and surface temperature and  ***
+c   ***                    water vapor fluctuations                      ***
+c
+      do i=1,ncum
+       wd(i)=betad*abs(mp(i,icb(i)))*0.01*rrd*t(i,icb(i))
+     :           /(sigd*p(i,icb(i)))
+       qprime(i)=0.5*(qp(i,1)-q(i,1))
+       tprime(i)=lv0*qprime(i)/cpd
+      enddo
+c
+c   ***  Calculate tendencies of lowest level potential temperature  ***
+c   ***                      and mixing ratio                        ***
+c
+        do 1200 i=1,ncum
+          work(i)=0.01/(ph(i,1)-ph(i,2))
+          am(i)=0.0
+ 1200   continue
+        do 1220 k=2,nl
+          do 1210 i=1,ncum
+            if((nk(i).eq.1).and.(k.le.inb(i)).and.(nk(i).eq.1))then
+              am(i)=am(i)+m(i,k)
+            endif
+ 1210     continue
+ 1220   continue
+        do 1240 i=1,ncum
+          if((g*work(i)*am(i)).ge.delti)iflag(i)=1
+          ft(i,1)=ft(i,1)+g*work(i)*am(i)*(t(i,2)-t(i,1)
+     &    +(gz(i,2)-gz(i,1))/cpn(i,1))
+          ft(i,1)=ft(i,1)-lvcp(i,1)*sigd*evap(i,1)
+          ft(i,1)=ft(i,1)+sigd*wt(i,2)*(cl-cpd)*water(i,2)*(t(i,2)
+     &     -t(i,1))*work(i)/cpn(i,1)
+          fq(i,1)=fq(i,1)+g*mp(i,2)*(qp(i,2)-q(i,1))*
+     &    work(i)+sigd*evap(i,1)
+          fq(i,1)=fq(i,1)+g*am(i)*(q(i,2)-q(i,1))*work(i)
+          fu(i,1)=fu(i,1)+g*work(i)*(mp(i,2)*(up(i,2)-u(i,1))
+     &    +am(i)*(u(i,2)-u(i,1)))
+          fv(i,1)=fv(i,1)+g*work(i)*(mp(i,2)*(vp(i,2)-v(i,1))
+     &    +am(i)*(v(i,2)-v(i,1)))
+ 1240   continue
+        do 1260 j=2,nl
+           do 1250 i=1,ncum
+             if(j.le.inb(i))then
+               fq(i,1)=fq(i,1)
+     &                 +g*work(i)*ment(i,j,1)*(qent(i,j,1)-q(i,1))
+               fu(i,1)=fu(i,1)
+     &                 +g*work(i)*ment(i,j,1)*(uent(i,j,1)-u(i,1))
+               fv(i,1)=fv(i,1)
+     &                 +g*work(i)*ment(i,j,1)*(vent(i,j,1)-v(i,1))
+             endif
+ 1250      continue
+ 1260   continue
+c
+c   ***  Calculate tendencies of potential temperature and mixing ratio  ***
+c   ***               at levels above the lowest level                   ***
+c
+c   ***  First find the net saturated updraft and downdraft mass fluxes  ***
+c   ***                      through each level                          ***
+c
+        do 1500 i=2,nl+1
+c
+          num1=0
+          do 1265 ij=1,ncum
+            if(i.le.inb(ij))num1=num1+1
+ 1265     continue
+          if(num1.le.0)go to 1500
+c
+          call zilch(amp1,ncum)
+          call zilch(ad,ncum)
+c
+          do 1280 k=i+1,nl+1
+            do 1270 ij=1,ncum
+              if((i.ge.nk(ij)).and.(i.le.inb(ij))
+     &            .and.(k.le.(inb(ij)+1)))then
+                amp1(ij)=amp1(ij)+m(ij,k)
+              endif
+ 1270         continue
+ 1280     continue
+c
+          do 1310 k=1,i
+            do 1300 j=i+1,nl+1
+               do 1290 ij=1,ncum
+                 if((j.le.(inb(ij)+1)).and.(i.le.inb(ij)))then
+                   amp1(ij)=amp1(ij)+ment(ij,k,j)
+                 endif
+ 1290          continue
+ 1300       continue
+ 1310     continue
+          do 1340 k=1,i-1
+            do 1330 j=i,nl+1
+              do 1320 ij=1,ncum
+                if((i.le.inb(ij)).and.(j.le.inb(ij)))then
+                   ad(ij)=ad(ij)+ment(ij,j,k)
+                endif
+ 1320         continue
+ 1330       continue
+ 1340     continue
+c
+          do 1350 ij=1,ncum
+          if(i.le.inb(ij))then
+            dpinv=0.01/(ph(ij,i)-ph(ij,i+1))
+            cpinv=1.0/cpn(ij,i)
+c
+            ft(ij,i)=ft(ij,i)
+     &       +g*dpinv*(amp1(ij)*(t(ij,i+1)-t(ij,i)
+     &       +(gz(ij,i+1)-gz(ij,i))*cpinv)
+     &       -ad(ij)*(t(ij,i)-t(ij,i-1)+(gz(ij,i)-gz(ij,i-1))*cpinv))
+     &       -sigd*lvcp(ij,i)*evap(ij,i)
+            ft(ij,i)=ft(ij,i)+g*dpinv*ment(ij,i,i)*(hp(ij,i)-h(ij,i)+
+     &        t(ij,i)*(cpv-cpd)*(q(ij,i)-qent(ij,i,i)))*cpinv
+            ft(ij,i)=ft(ij,i)+sigd*wt(ij,i+1)*(cl-cpd)*water(ij,i+1)*
+     &        (t(ij,i+1)-t(ij,i))*dpinv*cpinv
+            fq(ij,i)=fq(ij,i)+g*dpinv*(amp1(ij)*(q(ij,i+1)-q(ij,i))-
+     &        ad(ij)*(q(ij,i)-q(ij,i-1)))
+            fu(ij,i)=fu(ij,i)+g*dpinv*(amp1(ij)*(u(ij,i+1)-u(ij,i))-
+     &        ad(ij)*(u(ij,i)-u(ij,i-1)))
+            fv(ij,i)=fv(ij,i)+g*dpinv*(amp1(ij)*(v(ij,i+1)-v(ij,i))-
+     &        ad(ij)*(v(ij,i)-v(ij,i-1)))
+         endif
+ 1350    continue
+         do 1370 k=1,i-1
+           do 1360 ij=1,ncum
+             if(i.le.inb(ij))then
+               awat=elij(ij,k,i)-(1.-ep(ij,i))*clw(ij,i)
+               awat=max(awat,0.0)
+               fq(ij,i)=fq(ij,i)
+     &         +g*dpinv*ment(ij,k,i)*(qent(ij,k,i)-awat-q(ij,i))
+               fu(ij,i)=fu(ij,i)
+     &         +g*dpinv*ment(ij,k,i)*(uent(ij,k,i)-u(ij,i))
+               fv(ij,i)=fv(ij,i)
+     &         +g*dpinv*ment(ij,k,i)*(vent(ij,k,i)-v(ij,i))
+c (saturated updrafts resulting from mixing)               ! cld
+               qcond(ij,i)=qcond(ij,i)+(elij(ij,k,i)-awat) ! cld
+               nqcond(ij,i)=nqcond(ij,i)+1.                ! cld
+             endif
+ 1360      continue
+ 1370    continue
+         do 1390 k=i,nl+1
+           do 1380 ij=1,ncum
+             if((i.le.inb(ij)).and.(k.le.inb(ij)))then
+               fq(ij,i)=fq(ij,i)
+     &                  +g*dpinv*ment(ij,k,i)*(qent(ij,k,i)-q(ij,i))
+               fu(ij,i)=fu(ij,i)
+     &                  +g*dpinv*ment(ij,k,i)*(uent(ij,k,i)-u(ij,i))
+               fv(ij,i)=fv(ij,i)
+     &                  +g*dpinv*ment(ij,k,i)*(vent(ij,k,i)-v(ij,i))
+             endif
+ 1380      continue
+ 1390    continue
+          do 1400 ij=1,ncum
+           if(i.le.inb(ij))then
+             fq(ij,i)=fq(ij,i)
+     &                +sigd*evap(ij,i)+g*(mp(ij,i+1)*
+     &                (qp(ij,i+1)-q(ij,i))
+     &                -mp(ij,i)*(qp(ij,i)-q(ij,i-1)))*dpinv
+             fu(ij,i)=fu(ij,i)
+     &                +g*(mp(ij,i+1)*(up(ij,i+1)-u(ij,i))-mp(ij,i)*
+     &                (up(ij,i)-u(ij,i-1)))*dpinv
+             fv(ij,i)=fv(ij,i)
+     &               +g*(mp(ij,i+1)*(vp(ij,i+1)-v(ij,i))-mp(ij,i)*
+     &               (vp(ij,i)-v(ij,i-1)))*dpinv
+C (saturated downdrafts resulting from mixing)               ! cld
+            do k=i+1,inb(ij)                                 ! cld
+             qcond(ij,i)=qcond(ij,i)+elij(ij,k,i)            ! cld
+             nqcond(ij,i)=nqcond(ij,i)+1.                    ! cld
+            enddo                                            ! cld
+C (particular case: no detraining level is found)            ! cld
+            if (nent(ij,i).eq.0) then                        ! cld
+             qcond(ij,i)=qcond(ij,i)+(1.-ep(ij,i))*clw(ij,i) ! cld
+             nqcond(ij,i)=nqcond(ij,i)+1.                    ! cld
+            endif                                            ! cld
+            if (nqcond(ij,i).ne.0.) then                     ! cld
+             qcond(ij,i)=qcond(ij,i)/nqcond(ij,i)            ! cld
+            endif                                            ! cld
+           endif
+ 1400     continue
+ 1500   continue
+c
+c   *** Adjust tendencies at top of convection layer to reflect  ***
+c   ***       actual position of the level zero cape             ***
+c
+        do 503 ij=1,ncum
+        fqold=fq(ij,inb(ij))
+        fq(ij,inb(ij))=fq(ij,inb(ij))*(1.-frac(ij))
+        fq(ij,inb(ij)-1)=fq(ij,inb(ij)-1)
+     &   +frac(ij)*fqold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
+     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))*lv(ij,inb(ij))
+     &   /lv(ij,inb(ij)-1)
+        ftold=ft(ij,inb(ij))
+        ft(ij,inb(ij))=ft(ij,inb(ij))*(1.-frac(ij))
+        ft(ij,inb(ij)-1)=ft(ij,inb(ij)-1)
+     &   +frac(ij)*ftold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
+     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))*cpn(ij,inb(ij))
+     &   /cpn(ij,inb(ij)-1)
+        fuold=fu(ij,inb(ij))
+        fu(ij,inb(ij))=fu(ij,inb(ij))*(1.-frac(ij))
+        fu(ij,inb(ij)-1)=fu(ij,inb(ij)-1)
+     &   +frac(ij)*fuold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
+     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
+        fvold=fv(ij,inb(ij))
+        fv(ij,inb(ij))=fv(ij,inb(ij))*(1.-frac(ij))
+        fv(ij,inb(ij)-1)=fv(ij,inb(ij)-1)
+     &  +frac(ij)*fvold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
+     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
+ 503    continue
+c
+c   ***   Very slightly adjust tendencies to force exact   ***
+c   ***     enthalpy, momentum and tracer conservation     ***
+c
+        do 682 ij=1,ncum
+        ents(ij)=0.0
+        uav(ij)=0.0
+        vav(ij)=0.0
+        do 681 i=1,inb(ij)
+         ents(ij)=ents(ij)
+     &  +(cpn(ij,i)*ft(ij,i)+lv(ij,i)*fq(ij,i))*(ph(ij,i)-ph(ij,i+1))	
+         uav(ij)=uav(ij)+fu(ij,i)*(ph(ij,i)-ph(ij,i+1))
+         vav(ij)=vav(ij)+fv(ij,i)*(ph(ij,i)-ph(ij,i+1))
+  681	continue
+  682   continue
+        do 683 ij=1,ncum
+        ents(ij)=ents(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
+        uav(ij)=uav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
+        vav(ij)=vav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
+ 683    continue
+        do 642 ij=1,ncum
+        do 641 i=1,inb(ij)
+         ft(ij,i)=ft(ij,i)-ents(ij)/cpn(ij,i)
+         fu(ij,i)=(1.-cu)*(fu(ij,i)-uav(ij))
+         fv(ij,i)=(1.-cu)*(fv(ij,i)-vav(ij))
+  641	continue
+ 642    continue
+c
+        do 1810 k=1,nl+1
+          do 1800 i=1,ncum
+            if((q(i,k)+delt*fq(i,k)).lt.0.0)iflag(i)=10
+ 1800     continue
+ 1810   continue
+c
+c
+        do 1900 i=1,ncum
+          if(iflag(i).gt.2)then
+          precip(i)=0.0
+          cbmf(i)=0.0
+          endif
+ 1900   continue
+        do 1920 k=1,nl
+         do 1910 i=1,ncum
+           if(iflag(i).gt.2)then
+             ft(i,k)=0.0
+             fq(i,k)=0.0
+             fu(i,k)=0.0
+             fv(i,k)=0.0
+             qcondc(i,k)=0.0                               ! cld
+           endif
+ 1910    continue
+ 1920   continue
+
+        do k=1,nl+1
+        do i=1,ncum
+          Ma(i,k) = 0.
+        enddo
+        enddo
+        do k=nl,1,-1
+        do i=1,ncum
+          Ma(i,k) = Ma(i,k+1)+m(i,k)
+        enddo
+        enddo
+
+c
+c   *** diagnose the in-cloud mixing ratio   ***            ! cld
+c   ***           of condensed water         ***            ! cld
+c                                                           ! cld
+      DO ij=1,ncum                                          ! cld   
+       do i=1,nd                                            ! cld 
+        mac(ij,i)=0.0                                       ! cld   
+        wa(ij,i)=0.0                                        ! cld
+        siga(ij,i)=0.0                                      ! cld
+       enddo                                                ! cld
+       do i=nk(ij),inb(ij)                                  ! cld
+       do k=i+1,inb(ij)+1                                   ! cld
+        mac(ij,i)=mac(ij,i)+m(ij,k)                         ! cld
+       enddo                                                ! cld
+       enddo                                                ! cld
+       do i=icb(ij),inb(ij)-1                               ! cld
+        ax(ij,i)=0.                                         ! cld
+        do j=icb(ij),i                                      ! cld
+         ax(ij,i)=ax(ij,i)+rrd*(tvp(ij,j)-tv(ij,j))         ! cld   
+     :       *(ph(ij,j)-ph(ij,j+1))/p(ij,j)                 ! cld   
+        enddo                                               ! cld
+        if (ax(ij,i).gt.0.0) then                           ! cld   
+         wa(ij,i)=sqrt(2.*ax(ij,i))                         ! cld
+        endif                                               ! cld
+       enddo                                                ! cld
+       do i=1,nl                                            ! cld
+        if (wa(ij,i).gt.0.0)                                ! cld
+     :    siga(ij,i)=mac(ij,i)/wa(ij,i)                     ! cld   
+     :        *rrd*tvp(ij,i)/p(ij,i)/100./delta             ! cld   
+        siga(ij,i) = min(siga(ij,i),1.0)                    ! cld
+        qcondc(ij,i)=siga(ij,i)*clw(ij,i)*(1.-ep(ij,i))     ! cld   
+     :          + (1.-siga(ij,i))*qcond(ij,i)               ! cld   
+       enddo                                                ! cld
+      ENDDO                                                 ! cld   
+
+        return
+        end
+
+      SUBROUTINE cv_uncompress(nloc,len,ncum,nd,idcum
+     :         ,iflag
+     :         ,precip,cbmf
+     :         ,ft,fq,fu,fv
+     :         ,Ma,qcondc            
+     :         ,iflag1
+     :         ,precip1,cbmf1
+     :         ,ft1,fq1,fu1,fv1
+     :         ,Ma1,qcondc1            
+     :                               )
+      implicit none
+
+#include "cvparam.h"
+
+c inputs:
+      integer len, ncum, nd, nloc
+      integer idcum(nloc)
+      integer iflag(nloc)
+      real precip(nloc), cbmf(nloc)
+      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
+      real Ma(nloc,nd)
+      real qcondc(nloc,nd) !cld
+
+c outputs:
+      integer iflag1(len)
+      real precip1(len), cbmf1(len)
+      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
+      real Ma1(len,nd)
+      real qcondc1(len,nd) !cld
+
+c local variables:
+      integer i,k
+
+        do 2000 i=1,ncum
+         precip1(idcum(i))=precip(i)
+         cbmf1(idcum(i))=cbmf(i)
+         iflag1(idcum(i))=iflag(i)
+ 2000   continue
+
+        do 2020 k=1,nl
+          do 2010 i=1,ncum
+            ft1(idcum(i),k)=ft(i,k)
+            fq1(idcum(i),k)=fq(i,k)
+            fu1(idcum(i),k)=fu(i,k)
+            fv1(idcum(i),k)=fv(i,k)
+            Ma1(idcum(i),k)=Ma(i,k)
+            qcondc1(idcum(i),k)=qcondc(i,k)
+ 2010     continue
+ 2020   continue
+
+        return
+        end
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/cvflag.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/cvflag.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/cvflag.h	(revision 418)
@@ -0,0 +1,3 @@
+      logical cvflag_grav
+
+      COMMON /cvflag/ cvflag_grav 
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/cvparam.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/cvparam.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/cvparam.h	(revision 418)
@@ -0,0 +1,25 @@
+c------------------------------------------------------------
+c Parameters for convectL:
+c (includes - microphysical parameters, 
+c			- parameters that control the rate of approach 
+c               to quasi-equilibrium)
+c			- noff & minorig (previously in input of convect1)
+c------------------------------------------------------------
+
+      integer noff, minorig, nl, nlp, nlm
+      real elcrit, tlcrit
+      real entp
+      real sigs, sigd
+      real omtrain, omtsnow, coeffr, coeffs
+      real dtmax
+      real cu
+      real betad
+      real alpha, damp
+      real delta
+
+      COMMON /cvparam/ noff, minorig, nl, nlp, nlm
+     :                ,elcrit, tlcrit
+     :                ,entp, sigs, sigd
+     :                ,omtrain, omtsnow, coeffr, coeffs
+     :                ,dtmax, cu, betad, alpha, damp, delta
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/cvparam3.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/cvparam3.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/cvparam3.h	(revision 418)
@@ -0,0 +1,24 @@
+c------------------------------------------------------------
+c Parameters for convectL, iflag_con=3:
+c (includes - microphysical parameters, 
+c			- parameters that control the rate of approach 
+c               to quasi-equilibrium)
+c			- noff & minorig (previously in input of convect1)
+c------------------------------------------------------------
+
+      integer noff, minorig, nl, nlp, nlm
+      real sigd, spfac
+      real pbcrit, ptcrit, epmax
+      real omtrain
+      real dtovsh, dpbase, dttrig
+      real dtcrit, tau, beta, alpha
+      real delta
+      real betad
+
+      COMMON /cvparam3/  noff, minorig, nl, nlp, nlm
+     :                ,  sigd, spfac
+     :                ,pbcrit, ptcrit, epmax
+     :                ,omtrain
+     :                ,dtovsh, dpbase, dttrig
+     :                ,dtcrit, tau, beta, alpha, delta, betad
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/cvthermo.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/cvthermo.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/cvthermo.h	(revision 418)
@@ -0,0 +1,12 @@
+c Thermodynamical constants for convectL:
+
+      real cpd, cpv, cl, rrv, rrd, lv0, g, rowl, t0
+      real clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl
+      real eps, epsi, epsim1
+      real ginv, hrd
+      real grav
+
+      COMMON /cvthermo/ cpd, cpv, cl, rrv, rrd, lv0, g, rowl, t0
+     :                 ,clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl 
+     :                 ,eps, epsi, epsim1, ginv, hrd, grav
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp.h	(revision 418)
@@ -0,0 +1,18 @@
+      REAL cld_lc_lsc,cld_lc_con
+      REAL cld_tau_lsc,cld_tau_con
+      REAL ffallv_lsc,ffallv_con
+      REAL coef_eva
+      LOGICAL reevap_ice
+      INTEGER iflag_pdf
+
+      common/comfisrtilp/
+     s     cld_lc_lsc     ! 2.6e-4
+     s     ,cld_lc_con    ! 2.6e-4
+     s     ,cld_tau_lsc   ! 3600.
+     s     ,cld_tau_con   ! 3600.
+     s     ,ffallv_lsc    ! 1.
+     s     ,ffallv_con    ! 1.
+     s     ,coef_eva      ! 2.e-5
+     s     ,reevap_ice    ! F
+     s     ,iflag_pdf     ! 0
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histday.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histday.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histday.h	(revision 418)
@@ -0,0 +1,342 @@
+      IF (ok_journe) THEN
+c
+         idayref = day_ref
+         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlon(i+1)
+            zx_lon(i,jjmp1) = rlon(i+1)
+         ENDDO
+         DO ll=1,klev
+            znivsig(ll)=float(ll)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
+         write(*,*)'zx_lon = ',zx_lon(:,1)
+         write(*,*)'zx_lat = ',zx_lat(1,:)
+         CALL histbeg("histday", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 
+     .                 nhori, nid_day)
+         write(*,*)'Journee ', itau_phy, zjulian
+         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
+     .                 klev, presnivs, nvert)
+c        call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
+c    .              klev, znivsig, nvert)
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_day)
+C Essai writephys
+c        nom_fichier = 'histday1'
+c        call writephy_ini(fid_day,nom_fichier,klon,iim,jjmp1,klev,
+c    .                     rlon,rlat, presnivs,
+c    .                     zjulian, dtime)
+c        call writephy_def(prof2d_on, fid_day, "once", zsto, zout, 0)
+c        call writephy_def(prof3d_on, fid_day, "once", zsto, zout,
+c    .                                                         klev)
+c        call writephy_def(prof2d_av, fid_day, "ave(X)", zsto, zout, 0) 
+c        call writephy_def(prof3d_av, fid_day, "ave(X)", zsto, zout, 
+c    .                                                         klev)
+ 
+c
+         CALL histdef(nid_day, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once", zsto,zout)
+c
+         CALL histdef(nid_day, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once", zsto,zout)
+c
+c Champs 2D:
+c
+         CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "tter", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "tlic", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "toce", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "tsic", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+cccIM
+c
+         CALL histdef(nid_day, "t2m", "Temperature 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "t2mter", "Temp.terre 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "t2mlic", "Temp.lic 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "t2moce", "Temp.oce 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "t2msic", "Temp.sic 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "t2m_min", "Temp. 2m min.",
+     .                "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                t2mincels, zsto,zout)
+c
+         CALL histdef(nid_day, "t2m_max", "Temp. 2m max.",
+     .                "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                t2maxcels, zsto,zout)
+c
+         CALL histdef(nid_day, "t2mter_min", "Temp.terre 2m min.",
+     .                "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                t2mincels, zsto,zout)
+c
+         CALL histdef(nid_day, "t2mter_max", "Temp.terre 2m max.",
+     .                "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                t2maxcels, zsto,zout)
+c
+         CALL histdef(nid_day, "q2m", "Specific humidity", "Kg/Kg",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "u10m", "Vent zonal 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "u10mter", "Vent zonal ter 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "u10mlic", "Vent zonal lic 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "u10moce", "Vent zonal oce 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "u10msic", "Vent zonal sic 10m",
+     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "v10m", "Vent meridien 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "v10mter", "Vent meridien ter 10m", 
+     .                "m/s", iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "v10mlic", "Vent meridien lic 10m",
+     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "v10moce", "Vent meridien oce 10m",
+     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "v10msic", "Vent meridien sic 10m",
+     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "precip","Precipitation Totale liq+sol"
+     .                , "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "snow", "Snow fall", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "snow_mass", "Snow Mass", "kg/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "evap", "Evaporation", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "sols", "Net Solar rad. at surf.", 
+     .                "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "soll", "Net IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "solldown", "Down. IR rad. at surface", 
+     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "sens", "Sensible heat flux", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "fder", "Heat flux derivation", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "frtu", "Zonal wind stress", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "frtv", "Meridional wind stress", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+CXXX PB flux pour chaque sous surface
+C
+         DO nsrf = 1, nbsrf
+C
+           call histdef(nid_day, "pourc_"//clnsurf(nsrf), 
+     $         "Fraction"//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_day, "tsol_"//clnsurf(nsrf), 
+     $         "Fraction"//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_day, "sens_"//clnsurf(nsrf), 
+     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+c
+           call histdef(nid_day, "lat_"//clnsurf(nsrf), 
+     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_day, "taux_"//clnsurf(nsrf), 
+     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+
+           call histdef(nid_day, "tauy_"//clnsurf(nsrf), 
+     $         "Meridional xind stress "//clnsurf(nsrf), "Pa",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_day, "albe_"//clnsurf(nsrf), 
+     $         "Albedo surf. "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_day, "rugs_"//clnsurf(nsrf), 
+     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+
+CXXX
+         END DO 
+           
+         CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "cldl", "Low-level cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "cldm", "Mid-level cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "cldh", "High-level cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "cldt", "Total cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "cldq", "Cloud liquid water path", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+c Champs 3D:
+c
+         CALL histdef(nid_day, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "ovap", "Specific humidity", "Kg/Kg",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+cccIM   
+         CALL histdef(nid_day, "SWupTOA", "SWup at TOA","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "SWupSFC", "SWup at surface","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "SWdnTOA", "SWdn at TOA","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "SWdnSFC", "SWdn at surface","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histend(nid_day)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF ! fin de test sur ok_journe
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histhf.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histhf.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histhf.h	(revision 418)
@@ -0,0 +1,91 @@
+
+      IF (ok_hf) THEN
+c
+         PRINT*, 'La frequence de sortie instant. est de ', ecrit_hf
+
+cccIM    CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
+         CALL ymds2ju(annee_ref, 1, 1, 0.0, zjulian)
+         zjulian = zjulian + day_ini
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlon(i+1)
+            zx_lon(i,jjmp1) = rlon(i+1)
+         ENDDO
+
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
+
+cccIM      CALL histbeg("histhf", iim,zx_lon, jjmp1,zx_lat,
+         CALL histbeg("histhf", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
+     .                 1,iim,1,jjmp1, 0, zjulian, dtime, 
+     .                 nhori, nid_hf)
+
+         CALL histvert(nid_hf, "presnivs", "Vertical levels", "mb",
+     .                 klev, presnivs, nvert)
+         zsto = dtime
+
+c   pour les champs instantannes, il faut mettre la meme valeur pour
+c   zout et tsto.
+c   dtime est passe par ailleurs a histbeg
+
+         zout = dtime * FLOAT(NINT(86400./dtime*ecrit_hf))
+         zsto = zout
+         print*,'zout,zsto=',zout,zsto
+
+c
+c        CALL histdef(nid_hf, "phis", "Surface geop. height", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "once", zsto,zout)
+c
+c        CALL histdef(nid_hf, "aire", "Grid area", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "once", zsto,zout)
+c
+c Champs 2D:
+c
+         CALL histdef(nid_hf, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         print*,'ATTENTION METTRE AVE(X) POUR LES PRECIPS'
+
+         CALL histdef(nid_hf, "rain", "Precipitation", "mm/d",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "u850", "Zonal wind 850mb", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+         CALL histdef(nid_hf, "v850", "Meridional wind 850mb", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "u500", "Zonal wind 500mb", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+         CALL histdef(nid_hf, "v500", "Meridional wind 500mb", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+         CALL histdef(nid_hf, "u200", "Zonal wind 200mb", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+         CALL histdef(nid_hf, "v200", "Meridional wind 200mb", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+         CALL histdef(nid_hf, "phi500", "Geopotentiel à 500mb", "m2/s2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+c
+         CALL histend(nid_hf)
+
+      endif ! ok_hf
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histins.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histins.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histins.h	(revision 418)
@@ -0,0 +1,235 @@
+      IF (ok_instan) THEN
+c
+         idayref = day_ref
+         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlon(i+1)
+            zx_lon(i,jjmp1) = rlon(i+1)
+         ENDDO
+         DO ll=1,klev
+            znivsig(ll)=float(ll)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
+         CALL histbeg("histins", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
+     .                 nhori, nid_ins)
+         write(*,*)'Inst ', itau_phy, zjulian
+         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
+     .                 klev, presnivs, nvert)
+c        call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
+c    .              klev, znivsig, nvert)
+c
+c
+         zsto = dtime * ecrit_ins
+         zout = dtime * ecrit_ins
+C
+         CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "once", zsto,zout)
+c
+         CALL histdef(nid_ins, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "once", zsto,zout)
+c
+c Champs 2D:
+c
+        CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "t2m", "Temperature 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "q2m", "Specific humidity 2m", "Kg/Kg",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "u10m", "Vent zonal 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "v10m", "Vent meridien 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+        CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "plul", "Large-scale Precip.", "mm/day",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "pluc", "Convective Precip.", "mm/day",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+
+        CALL histdef(nid_ins, "qsol", "Surface humidity", "mm",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "cdrm", "Momentum drag coef.", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "cdrh", "Heat drag coef.", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "precip", "Precipitation Totale liq+sol", 
+     .                "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "snow", "Snow fall", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "snow_mass", "Snow Mass", "kg/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "topl", "OLR", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "evap", "Evaporation", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface", 
+     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+      CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+      CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+      CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+      CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+         DO nsrf = 1, nbsrf
+C
+           call histdef(nid_ins, "pourc_"//clnsurf(nsrf), 
+     $         "Fraction"//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+
+           call histdef(nid_ins, "sens_"//clnsurf(nsrf), 
+     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+c
+           call histdef(nid_ins, "tsol_"//clnsurf(nsrf), 
+     $         "Surface Temperature"//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+c
+           call histdef(nid_ins, "lat_"//clnsurf(nsrf), 
+     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+C
+           call histdef(nid_ins, "taux_"//clnsurf(nsrf), 
+     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+
+           call histdef(nid_ins, "tauy_"//clnsurf(nsrf), 
+     $         "Meridional xind stress "//clnsurf(nsrf), "Pa",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+c
+           call histdef(nid_ins, "albe_"//clnsurf(nsrf), 
+     $         "Albedo "//clnsurf(nsrf), "-",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+c
+           call histdef(nid_ins, "rugs_"//clnsurf(nsrf), 
+     $         "rugosite "//clnsurf(nsrf), "-",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "inst(X)", zsto,zout)
+CXXX
+         END DO 
+         CALL histdef(nid_ins, "rugs", "rugosity", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+
+c
+         CALL histdef(nid_ins, "albs", "Surface albedo", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+         CALL histdef(nid_ins, "albslw", "Surface albedo LW", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+c
+c Champs 3D:
+c
+         CALL histdef(nid_ins, "temp", "Temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+
+         CALL histend(nid_ins)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmth.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmth.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmth.h	(revision 418)
@@ -0,0 +1,489 @@
+      IF (ok_mensuel) THEN
+c
+         idayref = day_ref
+         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlon(i+1)
+            zx_lon(i,jjmp1) = rlon(i+1)
+         ENDDO
+         DO ll=1,klev
+            znivsig(ll)=float(ll)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
+         CALL histbeg("histmth.nc", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 
+     .                 nhori, nid_mth)
+         write(*,*)'Mensuel ', itau_phy, zjulian
+         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
+     .                 klev, presnivs, nvert)
+c        call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
+c    .              klev, znivsig, nvert)
+c
+         zsto = dtime
+         zout = dtime * ecrit_mth
+c
+         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_mth, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+c Champs 2D:
+c
+         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "t2m", "Temperature 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "q2m", "Specific humidity 2m", "Kg/Kg",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "u10m", "Vent zonal 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "v10m", "Vent meridien 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+c
+         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "precip", "Precipitation Totale liq+sol", 
+     .                "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "plul", "Large-scale Precip.", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "pluc", "Convective Precip.", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "snow", "Snow fall", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "snow_mass", "Snow Mass", "kg/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "evap", "Evaporation", "kg/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface", 
+     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         DO nsrf = 1, nbsrf
+C
+           call histdef(nid_mth, "pourc_"//clnsurf(nsrf), 
+     $         "Fraction "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_mth, "tsol_"//clnsurf(nsrf), 
+     $         "Fraction "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_mth, "sens_"//clnsurf(nsrf), 
+     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+c
+           call histdef(nid_mth, "lat_"//clnsurf(nsrf), 
+     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+C
+           call histdef(nid_mth, "taux_"//clnsurf(nsrf), 
+     $         "Zonal wind stress"//clnsurf(nsrf), "Pa",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+
+           call histdef(nid_mth, "tauy_"//clnsurf(nsrf), 
+     $         "Meridional xind stress "//clnsurf(nsrf), "Pa",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+c
+           call histdef(nid_mth, "albe_"//clnsurf(nsrf), 
+     $         "Albedo surf. "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+c
+           call histdef(nid_mth, "rugs_"//clnsurf(nsrf), 
+     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
+     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+     $         "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ages_"//clnsurf(nsrf), "Snow age","day",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+
+         END DO
+C
+         CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "albs", "Surface albedo", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_mth, "albslw", "Surface albedo LW", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+cKE43
+      IF (iflag_con .GE. 3) THEN ! sb
+c
+         CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto,zout)
+c
+c
+      ENDIF
+c34EK
+c
+c Champs 3D:
+c
+         CALL histdef(nid_mth, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "clwcon", "Cloud Liquid water content"
+     .                , "kg/kg",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ducon", "Convection du", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
+         CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
+         CALL histdef(nid_mth, "ratqs", "RATQS"," ",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
+c
+         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
+         CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtec", "Cinetic dissip dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         IF (ok_orodr) THEN
+         CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         ENDIF
+C
+         IF (ok_orolf) THEN
+         CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         ENDIF
+C
+         CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         if (nqmax.GE.3) THEN
+         DO iq=1,nqmax-2
+         IF (iq.LE.99) THEN
+         WRITE(str2,'(i2.2)') iq
+         CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         ELSE
+         PRINT*, "Trop de traceurs"
+         CALL abort
+         ENDIF
+         ENDDO
+         ENDIF
+c
+cKE43
+      IF (iflag_con.GE.3) THEN ! (sb)
+c
+         CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+cccIM
+         CALL histdef(nid_mth, "SWupTOA", "SWup at TOA","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "SWupSFC", "SWup at surface","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "SWdnTOA", "SWdn at TOA","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "SWdnSFC", "SWdn at surface","W/m2",
+     .                iim,jjmp1,nhori, 1,1,1,-99,
+     .                32, "ave(X)", zsto,zout)
+c
+      ENDIF
+c34EK
+         CALL histend(nid_mth)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF ! fin de test sur ok_mensuel
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/newmicro.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/newmicro.F	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/newmicro.F	(revision 418)
@@ -0,0 +1,192 @@
+      SUBROUTINE newmicro (paprs, pplay,ok_newmicro,
+     .                  t, pqlwp, pclc, pcltau, pclemi,
+     .                  pch, pcl, pcm, pct, pctlwp)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
+c Objet: Calculer epaisseur optique et emmissivite des nuages
+c======================================================================
+c Arguments:
+c t-------input-R-temperature
+c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)
+c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
+c 
+c pcltau--output-R-epaisseur optique des nuages
+c pclemi--output-R-emissivite des nuages (0 a 1)
+c======================================================================
+C
+#include "YOMCST.h"
+c
+#include "dimensions.h"
+#include "dimphy.h"
+#include "nuage.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+c
+      REAL pclc(klon,klev)
+      REAL pqlwp(klon,klev)
+      REAL pcltau(klon,klev), pclemi(klon,klev)
+c
+      REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
+c
+      LOGICAL lo
+c
+      REAL cetahb, cetamb
+      PARAMETER (cetahb = 0.45, cetamb = 0.80)
+C
+      INTEGER i, k
+      REAL zflwp, zradef, zfice, zmsac
+c
+      REAL radius, rad_chaud
+cc      PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
+ccc      PARAMETER (rad_chaud=15.0, rad_froid=35.0)
+c sintex initial      PARAMETER (rad_chaud=10.0, rad_froid=30.0)
+      REAL coef, coef_froi, coef_chau
+      PARAMETER (coef_chau=0.13, coef_froi=0.09)
+      REAL seuil_neb, t_glace
+      PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
+      INTEGER nexpo ! exponentiel pour glace/eau
+      PARAMETER (nexpo=6)
+ccc      PARAMETER (nexpo=1)
+
+c -- sb:
+      logical ok_newmicro
+c     parameter (ok_newmicro=.FALSE.)
+      real rel, tc, rei, zfiwp
+      real k_liq, k_ice0, k_ice, DF
+      parameter (k_liq=0.0903, k_ice0=0.005) ! units=m2/g
+      parameter (DF=1.66) ! diffusivity factor
+c sb --
+
+c
+c Calculer l'epaisseur optique et l'emmissivite des nuages
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         rad_chaud = rad_chau1
+         IF (k.LE.3) rad_chaud = rad_chau2
+         pclc(i,k) = MAX(pclc(i,k), seuil_neb)
+         zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k)
+     .          *(paprs(i,k)-paprs(i,k+1))
+         zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
+         zfice = MIN(MAX(zfice,0.0),1.0)
+         zfice = zfice**nexpo
+         radius = rad_chaud * (1.-zfice) + rad_froid * zfice
+         coef = coef_chau * (1.-zfice) + coef_froi * zfice
+         pcltau(i,k) = 3.0/2.0 * zflwp / radius
+         pclemi(i,k) = 1.0 - EXP( - coef * zflwp)
+
+         if (ok_newmicro) then
+
+c -- liquid/ice cloud water paths:
+
+         zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
+         zfice = MIN(MAX(zfice,0.0),1.0)
+
+         zflwp = 1000.*(1.-zfice)*pqlwp(i,k)/pclc(i,k)
+     :          *(paprs(i,k)-paprs(i,k+1))/RG
+         zfiwp = 1000.*zfice*pqlwp(i,k)/pclc(i,k)
+     :          *(paprs(i,k)-paprs(i,k+1))/RG
+
+c -- effective cloud droplet radius (microns):
+
+c for liquid water clouds: 
+         rel = rad_chaud
+
+c for ice clouds: as a function of the ambiant temperature
+c [formula used by Iacobellis and Somerville (2000), with an 
+c asymptotical value of 3.5 microns at T<-81.4 C added to be 
+c consistent with observations of Heymsfield et al. 1986]:
+         tc = t(i,k)-273.15
+         rei = 0.71*tc + 61.29 
+         if (tc.le.-81.4) rei = 3.5 
+
+c -- cloud optical thickness :
+
+c [for liquid clouds, traditional formula, 
+c  for ice clouds, Ebert & Curry (1992)] 
+
+         if (zflwp.eq.0.) rel = 1. 
+         if (zfiwp.eq.0. .or. rei.le.0.) rei = 1. 
+         pcltau(i,k) = 3.0/2.0 * ( zflwp/rel )
+     .             + zfiwp * (3.448e-03  + 2.431/rei)
+
+c -- cloud infrared emissivity:
+
+c [the broadband infrared absorption coefficient is parameterized
+c  as a function of the effective cld droplet radius]
+
+c Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
+         k_ice = k_ice0 + 1.0/rei
+
+         pclemi(i,k) = 1.0
+     .      - EXP( - coef_chau*zflwp - DF*k_ice*zfiwp )
+
+         endif ! ok_newmicro
+
+         lo = (pclc(i,k) .LE. seuil_neb)
+         IF (lo) pclc(i,k) = 0.0
+         IF (lo) pcltau(i,k) = 0.0
+         IF (lo) pclemi(i,k) = 0.0
+      ENDDO
+      ENDDO
+ccc      DO k = 1, klev
+ccc      DO i = 1, klon
+ccc         t(i,k) = t(i,k)
+ccc         pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
+ccc         lo = pclc(i,k) .GT. (2.*1.e-5)
+ccc         zflwp = pqlwp(i,k)*1000.*(paprs(i,k)-paprs(i,k+1))
+ccc     .          /(rg*pclc(i,k))
+ccc         zradef = 10.0 + (1.-sigs(k))*45.0
+ccc         pcltau(i,k) = 1.5 * zflwp / zradef
+ccc         zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
+ccc         zmsac = 0.13*(1.0-zfice) + 0.08*zfice
+ccc         pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
+ccc         if (.NOT.lo) pclc(i,k) = 0.0
+ccc         if (.NOT.lo) pcltau(i,k) = 0.0
+ccc         if (.NOT.lo) pclemi(i,k) = 0.0
+ccc      ENDDO
+ccc      ENDDO
+cccccc      print*, 'pas de nuage dans le rayonnement'
+cccccc      DO k = 1, klev
+cccccc      DO i = 1, klon
+cccccc         pclc(i,k) = 0.0
+cccccc         pcltau(i,k) = 0.0
+cccccc         pclemi(i,k) = 0.0
+cccccc      ENDDO
+cccccc      ENDDO
+C
+C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
+C
+      DO i = 1, klon
+         pct(i)=1.0
+         pch(i)=1.0
+         pcm(i) = 1.0
+         pcl(i) = 1.0
+         pctlwp(i) = 0.0
+      ENDDO
+C
+      DO k = klev, 1, -1
+      DO i = 1, klon
+         pctlwp(i) = pctlwp(i) 
+     .             + pqlwp(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
+         pct(i) = pct(i)*(1.0-pclc(i,k))
+         if (pplay(i,k).LE.cetahb*paprs(i,1))
+     .      pch(i) = pch(i)*(1.0-pclc(i,k))
+         if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
+     .       pplay(i,k).LE.cetamb*paprs(i,1)) 
+     .      pcm(i) = pcm(i)*(1.0-pclc(i,k))
+         if (pplay(i,k).GT.cetamb*paprs(i,1))
+     .      pcl(i) = pcl(i)*(1.0-pclc(i,k))
+      ENDDO
+      ENDDO
+C
+      DO i = 1, klon
+         pct(i)=1.-pct(i)
+         pch(i)=1.-pch(i)
+         pcm(i)=1.-pcm(i)
+         pcl(i)=1.-pcl(i)
+      ENDDO
+C
+      RETURN
+      END
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/plevel.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/plevel.F	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/plevel.F	(revision 418)
@@ -0,0 +1,114 @@
+c================================================================
+c================================================================
+      SUBROUTINE plevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
+c================================================================
+c================================================================
+
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+c================================================================
+c
+c Interpoler des champs 3-D u, v et g du modele a un niveau de
+c pression donnee (pres)
+c
+c INPUT:  ilon ----- nombre de points
+c         ilev ----- nombre de couches
+c         lnew ----- true si on doit reinitialiser les poids
+c         pgcm ----- pressions modeles
+c         pres ----- pression vers laquelle on interpolle
+c         Qgcm ----- champ GCM
+c         Qpres ---- champ interpolle au niveau pres
+c
+c================================================================
+c
+c   arguments :
+c   -----------
+
+      INTEGER ilon, ilev
+      logical lnew
+
+      REAL pgcm(ilon,ilev)
+      REAL Qgcm(ilon,ilev)
+      real pres
+      REAL Qpres(ilon)
+
+c   local :
+c   -------
+
+      INTEGER lt(klon), lb(klon)
+      REAL ptop, pbot, aist(klon), aisb(klon)
+
+      save lt,lb,ptop,pbot,aist,aisb
+
+      INTEGER i, k
+c
+
+c=====================================================================
+      if (lnew) then
+c   on réinitialise les réindicages et les poids
+c=====================================================================
+
+
+c Chercher les 2 couches les plus proches du niveau a obtenir
+c
+c Eventuellement, faire l'extrapolation a partir des deux couches
+c les plus basses ou les deux couches les plus hautes:
+      DO 130 i = 1, klon
+         IF ( ABS(pres-pgcm(i,ilev) ) .LT.
+     .        ABS(pres-pgcm(i,1)) ) THEN
+            lt(i) = ilev     ! 2
+            lb(i) = ilev-1   ! 1
+         ELSE
+            lt(i) = 2
+            lb(i) = 1
+         ENDIF
+  130 CONTINUE
+      DO 150 k = 1, ilev-1
+         DO 140 i = 1, klon
+            pbot = pgcm(i,k)
+            ptop = pgcm(i,k+1)
+            IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
+               lt(i) = k+1
+               lb(i) = k
+            ENDIF
+  140    CONTINUE
+  150 CONTINUE
+c
+c Interpolation lineaire:
+c
+      DO i = 1, klon
+c interpolation en logarithme de pression:
+c
+c ...   Modif . P. Le Van    ( 20/01/98) ....
+c       Modif Frédéric Hourdin (3/01/02)
+
+        aist(i) = LOG( pgcm(i,lb(i))/ pres )
+     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
+        aisb(i) = LOG( pres / pgcm(i,lt(i)) )
+     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
+      enddo
+
+
+      endif ! lnew
+
+c======================================================================
+c    inteprollation
+c======================================================================
+
+      do i=1,klon
+         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
+      enddo
+c
+c Je mets les vents a zero quand je rencontre une montagne
+      do i = 1, klon
+         if (pgcm(i,1).LT.pres) THEN
+            Qpres(i)=1e33
+         endif
+      enddo
+
+c
+      RETURN
+      END
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/screenc.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/screenc.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/screenc.F90	(revision 418)
@@ -0,0 +1,82 @@
+      SUBROUTINE screenc(klon, knon, nsrf, zxli, &
+                         speed, temp, q_zref, zref, &
+                         ts, qsurf, rugos, psol, &
+                         ustar, testar, qstar, okri, ri1, &
+                         pref, delu, delte, delq)
+      USE coefcdrag_int
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+! 
+! Objet : calcul "correcteur" des anomalies du vent, de la temperature 
+!         potentielle et de l'humidite relative au niveau de reference zref et 
+!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
+!         a partir des equations de Louis.
+!
+! Reference : Hess, Colman et McAvaney (1995)
+!
+! I. Musat, 01.07.2002
+!-----------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
+! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+! speed---input-R- module du vent au 1er niveau du modele
+! temp----input-R- temperature de l'air au 1er niveau du modele
+! q_zref--input-R- humidite relative au 1er niveau du modele
+! zref----input-R- altitude de reference
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! rugos---input-R- rugosite
+! psol----input-R- pression au sol
+! ustar---input-R- facteur d'echelle pour le vent
+! testar--input-R- facteur d'echelle pour la temperature potentielle
+! qstar---input-R- facteur d'echelle pour l'humidite relative
+! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce 
+!                  et zref par rapport au Ri entre la sfce et la 1ere couche
+! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche 
+!
+! pref----input-R- pression au niveau de reference
+! delu----input-R- anomalie du vent par rapport au 1er niveau
+! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli, okri 
+      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
+      REAL, intent(in) :: zref
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, psol
+      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1         
+!
+      REAL, dimension(klon), intent(out) :: pref, delu, delte, delq 
+!-----------------------------------------------------------------------
+#include "YOMCST.inc"
+!
+! Variables locales  
+      INTEGER :: i 
+      REAL, dimension(klon) :: cdram, cdrah, cdran, zri1, gref
+!
+!------------------------------------------------------------------------- 
+      DO i=1, knon
+        gref(i) = zref*RG
+      ENDDO 
+!
+! Richardson at reference level 
+!
+      CALL coefcdrag (klon, knon, nsrf, zxli, &
+                    speed, temp, q_zref, gref, &
+                    psol, ts, qsurf, rugos, &
+                    okri, ri1, &
+                    cdram, cdrah, cdran, zri1, &
+                    pref)
+!
+      DO i = 1, knon
+        delu(i) = ustar(i)/sqrt(cdram(i))
+        delte(i)= (testar(i)* sqrt(cdram(i)))/ &
+                   cdrah(i)
+        delq(i)= (qstar(i)* sqrt(cdram(i)))/ &
+                  cdrah(i)
+      ENDDO 
+!
+      RETURN 
+      END SUBROUTINE screenc
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/screenp.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/screenp.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/screenp.F90	(revision 418)
@@ -0,0 +1,105 @@
+      SUBROUTINE screenp(klon, knon, nsrf, &
+     &                   speed, tair, qair, &
+     &                   ts, qsurf, rugos, lmon, &
+     &                   ustar, testar, qstar, zref, &
+     &                   delu, delte, delq) 
+      IMPLICIT none
+!-------------------------------------------------------------------------
+!
+! Objet : calcul "predicteur" des anomalies du vent, de la temperature 
+!         potentielle et de l'humidite relative au niveau de reference zref et 
+!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
+!         a partir des relations de Dyer-Businger.
+!
+! Reference : Hess, Colman et McAvaney (1995)
+!
+! I. Musat, 01.07.2002
+!-------------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
+! speed---input-R- module du vent au 1er niveau du modele
+! tair----input-R- temperature de l'air au 1er niveau du modele
+! qair----input-R- humidite relative au 1er niveau du modele
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! rugos---input-R- rugosite
+! lmon----input-R- longueur de Monin-Obukov
+! ustar---input-R- facteur d'echelle pour le vent
+! testar--input-R- facteur d'echelle pour la temperature potentielle
+! qstar---input-R- facteur d'echelle pour l'humidite relative
+! zref----input-R- altitude de reference
+!
+! delu----input-R- anomalie du vent par rapport au 1er niveau
+! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      REAL, dimension(klon), intent(in) :: speed, tair, qair
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
+      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
+      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
+      REAL, intent(in) :: zref
+!
+      REAL, dimension(klon), intent(out) :: delu, delte, delq
+!
+!-------------------------------------------------------------------------
+! Variables locales et constantes :
+      REAL, PARAMETER :: RKAR=0.40
+      INTEGER :: i
+      REAL :: xtmp, xtmp0
+!-------------------------------------------------------------------------
+      DO i = 1, knon
+!
+        IF (lmon(i).GE.0.) THEN
+!
+! STABLE CASE
+!
+          IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0) THEN
+            delu(i) = (ustar(i)/RKAR)* &
+                      (log(zref/(rugos(i))+1.) + &
+                      min(5.0, 5.0 *(zref - rugos(i))/lmon(i)))
+            delte(i) = (testar(i)/RKAR)* &
+                       (log(zref/(rugos(i))+1.) + &
+                       min(5.0, 5.0 * (zref - rugos(i))/lmon(i)))
+            delq(i) = (qstar(i)/RKAR)* &
+                      (log(zref/(rugos(i))+1.) + &
+                      min(5.0, 5.0 * (zref - rugos(i))/lmon(i)))
+          ELSE
+            delu(i)  = 0.1 * speed(i)
+            delte(i) = 0.1 * (tair(i) - ts(i) )
+            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
+          ENDIF
+        ELSE  
+!
+! UNSTABLE CASE
+!
+          IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN
+            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
+            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
+            delu(i) = (ustar(i)/RKAR)* &
+                      (log(zref/(rugos(i))+1.) & 
+                      - 2.*log(0.5*(1. + xtmp)) &
+                      + 2.*log(0.5*(1. + xtmp0)) &
+                      - log(0.5*(1. + xtmp*xtmp)) &
+                      + log(0.5*(1. + xtmp0*xtmp0)) &
+                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
+            delte(i) = (testar(i)/RKAR)* &
+                       (log(zref/(rugos(i))+1.) &
+                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
+                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
+            delq(i)  = (qstar(i)/RKAR)* &
+                       (log(zref/(rugos(i))+1.) &
+                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
+                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
+          ELSE
+            delu(i)  = 0.5 * speed(i)
+            delte(i) = 0.5 * (tair(i) - ts(i) )
+            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
+          ENDIF
+        ENDIF
+!
+      ENDDO
+      RETURN
+      END SUBROUTINE screenp
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/screenpc_int.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/screenpc_int.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/screenpc_int.F90	(revision 418)
@@ -0,0 +1,38 @@
+MODULE screenpc_int
+
+  IMPLICIT NONE 
+
+  INTERFACE
+
+    SUBROUTINE screenp(klon, knon, nsrf, &
+     &                 speed, tair, qair, &
+     &                 ts, qsurf, rugos, lmon, &
+     &                 ustar, testar, qstar, zref, &
+     &                 delu, delte, delq) 
+      INTEGER, intent(in) :: klon, knon, nsrf
+      REAL, dimension(klon), intent(in) :: speed, tair, qair
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
+      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
+      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
+      REAL, intent(in) :: zref
+      REAL, dimension(klon), intent(out) :: delu, delte, delq
+    END SUBROUTINE screenp
+
+    SUBROUTINE screenc(klon, knon, nsrf, zxli, &
+     &                 speed, temp, q_zref, zref, &
+     &                 ts, qsurf, rugos, psol, &
+     &                 ustar, testar, qstar, okri, ri1, &
+     &                 pref, delu, delte, delq)
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli, okri
+      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
+      REAL, intent(in) :: zref
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, psol
+      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1
+      REAL, dimension(klon), intent(out) :: pref, delu, delte, delq
+
+    END SUBROUTINE screenc
+
+  END INTERFACE
+
+END MODULE screenpc_int
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/stdlevvar.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/stdlevvar.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/stdlevvar.F90	(revision 418)
@@ -0,0 +1,239 @@
+      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
+                           u1, v1, t1, q1, z1, &
+                           ts1, qsurf, rugos, psol, pat1, &
+                           t_2m, q_2m, u_10m) 
+      USE coefcdrag_int
+      USE screenpc_int
+      IMPLICIT NONE
+!-------------------------------------------------------------------------
+!
+! Objet : calcul de la temperature et l'humidite relative a 2m et du 
+!         module du vent a 10m a partir des relations de Dyer-Businger et
+!         des equations de Louis.
+!
+! Reference : Hess, Colman et McAvaney (1995)        
+!
+! I. Musat, 01.07.2002
+!-------------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
+! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+! u1------input-R- vent zonal au 1er niveau du modele
+! v1------input-R- vent meridien au 1er niveau du modele
+! t1------input-R- temperature de l'air au 1er niveau du modele
+! q1------input-R- humidite relative au 1er niveau du modele
+! z1------input-R- geopotentiel au 1er niveau du modele
+! ts1-----input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! rugos---input-R- rugosite
+! psol----input-R- pression au sol
+! pat1----input-R- pression au 1er niveau du modele
+!
+! t_2m---output-R- temperature de l'air a 2m
+! q_2m---output-R- humidite relative a 2m
+! u_10m--output-R- vitesse du vent a 10m
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli
+      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
+      REAL, dimension(klon), intent(in) :: qsurf, rugos
+      REAL, dimension(klon), intent(in) :: psol, pat1
+!
+      REAL, dimension(klon), intent(out) :: t_2m, q_2m, u_10m
+!-------------------------------------------------------------------------
+#include "YOMCST.inc"
+!IM PLUS
+#include "YOETHF.inc"
+!
+! Quelques constantes et options:
+!
+! RKAR : constante de von Karman
+      REAL, PARAMETER :: RKAR=0.40
+! niter : nombre iterations calcul "corrector"
+      INTEGER, parameter :: niter=6, ncon=niter-1
+!
+! Variables locales
+      INTEGER :: i, n
+      REAL :: zref
+      REAL, dimension(klon) :: speed
+! tpot : temperature potentielle
+      REAL, dimension(klon) :: tpot
+      REAL, dimension(klon) :: zri1, cdran
+      REAL, dimension(klon) :: cdram, cdrah
+! ri1 : nb. de Richardson entre la surface --> la 1ere couche
+      REAL, dimension(klon) :: ri1 
+      REAL, dimension(klon) :: ustar, testar, qstar
+      REAL, dimension(klon) :: zdte, zdq   
+! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
+      DOUBLE PRECISION, dimension(klon) :: lmon
+      DOUBLE PRECISION, parameter :: eps=1.0D-20
+      REAL, dimension(klon) :: delu, delte, delq
+      REAL, dimension(klon) :: u_zref, te_zref, q_zref  
+      REAL, dimension(klon) :: temp, pref
+      LOGICAL :: okri
+      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
+      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
+      REAL, dimension(klon) :: ok_pred, ok_corr
+      REAL, dimension(klon) :: conv_te, conv_q
+!------------------------------------------------------------------------- 
+      DO i=1, knon
+       speed(i)=SQRT(u1(i)**2+v1(i)**2)
+       ri1(i) = 0.0
+      ENDDO
+!
+      okri=.FALSE.
+      CALL coefcdrag(klon, knon, nsrf, zxli, &
+                     speed, t1, q1, z1, psol, &
+                     ts1, qsurf, rugos, okri, ri1,  &         
+                     cdram, cdrah, cdran, zri1, pref)            
+!
+!---------Star variables----------------------------------------------------
+!
+      DO i = 1, knon
+        ri1(i) = zri1(i)
+        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
+        ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
+        zdte(i) = tpot(i) - ts1(i)
+        zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
+!
+        testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
+        qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
+        lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
+                  (RKAR * RG * testar(i))
+      ENDDO
+!
+!----------First aproximation of variables at zref --------------------------
+      zref = 2.0
+      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
+                   ts1, qsurf, rugos, lmon, &
+                   ustar, testar, qstar, zref, &
+                   delu, delte, delq)
+!
+      DO i = 1, knon
+        u_zref(i) = delu(i)
+        q_zref(i) = max(qsurf(i),0.0) + delq(i)
+        te_zref(i) = ts1(i) + delte(i)
+        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
+!       q_zref_p(i) = q_zref(i)
+!       te_zref_p(i) = te_zref(i)
+        temp_p(i) = temp(i)
+      ENDDO
+!
+! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
+!
+      DO n = 1, niter
+!
+        okri=.TRUE.
+        CALL screenc(klon, knon, nsrf, zxli, &
+                     u_zref, temp, q_zref, zref, &
+                     ts1, qsurf, rugos, psol, &           
+                     ustar, testar, qstar, okri, ri1, &
+                     pref, delu, delte, delq) 
+!
+        DO i = 1, knon
+          u_zref(i) = delu(i)
+          q_zref(i) = delq(i) + max(qsurf(i),0.0)
+          te_zref(i) = delte(i) + ts1(i) 
+!
+! return to normal temperature
+!
+          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+!                 (1 + RVTMP2 * max(q_zref(i),0.0))
+!
+          IF(temp(i).GT.350.) THEN
+            WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
+          ENDIF
+!
+        IF(n.EQ.ncon) THEN
+          te_zref_p(i) = te_zref(i)
+          q_zref_p(i) = q_zref(i)
+        ENDIF 
+!
+        ENDDO 
+!
+      ENDDO 
+!
+! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
+!
+        DO i = 1, knon
+          conv_te(i) = (te_zref(i) - te_zref_p(i))/te_zref_p(i)
+          conv_q(i) = (q_zref(i) - q_zref_p(i))/q_zref_p(i)
+          IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
+            PRINT*,'DIV','i=',i,te_zref_p(i),te_zref(i),conv_te(i), &
+            q_zref_p(i),q_zref(i),conv_q(i)
+          ENDIF
+        ENDDO
+!
+      DO i = 1, knon
+        q_zref_c(i) = q_zref(i)
+        temp_c(i) = temp(i)
+!
+        IF(zri1(i).LT.0.) THEN
+          IF(nsrf.EQ.1) THEN
+            ok_pred(i)=1.
+            ok_corr(i)=0.
+          ELSE
+            ok_pred(i)=0.
+            ok_corr(i)=1.
+          ENDIF
+        ELSE
+          ok_pred(i)=0.
+          ok_corr(i)=1.
+        ENDIF
+!
+        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+      ENDDO
+!
+!
+!----------First aproximation of variables at zref --------------------------
+!
+      zref = 10.0
+      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
+                   ts1, qsurf, rugos, lmon, &
+                   ustar, testar, qstar, zref, &
+                   delu, delte, delq)
+!
+      DO i = 1, knon
+        u_zref(i) = delu(i)
+        q_zref(i) = max(qsurf(i),0.0) + delq(i)
+        te_zref(i) = ts1(i) + delte(i)
+        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
+!       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+!                 (1 + RVTMP2 * max(q_zref(i),0.0))
+        u_zref_p(i) = u_zref(i)
+      ENDDO
+!
+! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995 
+!
+      DO n = 1, niter
+!
+        okri=.TRUE.
+        CALL screenc(klon, knon, nsrf, zxli, &
+                     u_zref, temp, q_zref, zref, &
+                     ts1, qsurf, rugos, psol, &
+                     ustar, testar, qstar, okri, ri1, &
+                     pref, delu, delte, delq)
+!
+        DO i = 1, knon
+          u_zref(i) = delu(i)
+          q_zref(i) = delq(i) + max(qsurf(i),0.0)
+          te_zref(i) = delte(i) + ts1(i)
+          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+!                   (1 + RVTMP2 * max(q_zref(i),0.0))
+        ENDDO 
+!
+      ENDDO
+!
+      DO i = 1, knon
+        u_zref_c(i) = u_zref(i)
+!
+        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
+      ENDDO
+! 
+      RETURN
+      END subroutine stdlevvar
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/stdlevvar_int.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/stdlevvar_int.F90	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/stdlevvar_int.F90	(revision 418)
@@ -0,0 +1,21 @@
+MODULE stdlevvar_int
+
+  IMPLICIT NONE 
+
+  INTERFACE
+
+    SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
+                         u1, v1, t1, q1, z1, &
+                         ts1, qsurf, rugos, psol, pat1, &
+                         t_2m, q_2m, u_10m)
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli
+      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
+      REAL, dimension(klon), intent(in) :: qsurf, rugos
+      REAL, dimension(klon), intent(in) :: psol, pat1
+      REAL, dimension(klon), intent(out) :: t_2m, q_2m, u_10m
+    END SUBROUTINE stdlevvar
+
+  END INTERFACE
+
+END MODULE stdlevvar_int
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histday.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histday.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histday.h	(revision 418)
@@ -0,0 +1,406 @@
+      IF (ok_journe) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+c
+c Champs 2D:
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_day)
+         itau_w = itau_phy + itap
+
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+       CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+         varname = 'phis'
+         vartitle= 'Surface geop. height'
+         varunits= '-'
+c        call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
+c    .                                                    varunits)
+c
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
+       CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+         varname = 'aire'
+         vartitle= 'Grid area'
+         varunits= '-'
+c        call writephy(fid_day,prof2d_on,varname,paire,vartitle,
+c    .                                                    varunits)
+C
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
+      CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'tsol',zxtsol,
+c    .              'Surface Temperature','K')
+c
+C
+      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
+      CALL histwrite(nid_day,"tter",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
+c    .              'Surface Temperature','K')
+C
+      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day,"tlic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
+c    .              'Surface Temperature','K')
+C
+      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day,"toce",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
+c    .              'Surface Temperature','K')
+C
+      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day,"tsic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
+c    .              'Surface Temperature','K')
+C
+cccIM
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zt2m,zx_tmp_2d)
+      CALL histwrite(nid_day,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zt2m,zx_tmp_2d)
+      CALL histwrite(nid_day,"t2m_min",itau_w,zx_tmp_2d,
+     .               iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zt2m,zx_tmp_2d)
+      CALL histwrite(nid_day,"t2m_max",itau_w,zx_tmp_2d,
+     .               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_ter)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"t2mter",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_ter)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day,"t2mter_min",itau_w,zx_tmp_2d,
+     .               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_ter)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day,"t2mter_max",itau_w,zx_tmp_2d,
+     .               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_lic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"t2mlic",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_oce)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"t2moce",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_sic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"t2msic",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zq2m,zx_tmp_2d)
+      CALL histwrite(nid_day,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zu10m,zx_tmp_2d)
+      CALL histwrite(nid_day,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zv10m,zx_tmp_2d)
+      CALL histwrite(nid_day,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_ter)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"u10mter",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_ter)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"v10mter",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_lic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"u10mlic",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_lic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"v10mlic",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_oce)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"u10moce",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_oce)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"v10moce",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_sic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"u10msic",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+C
+      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_sic)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
+      CALL histwrite(nid_day,"v10msic",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+C
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c Essai writephys
+      varname = 'psol'
+      vartitle= 'pression au sol'
+      varunits= 'hPa'
+c     call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
+c    .                                                    varunits)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day,"precip",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
+c    .              'Precipitation','mm/day')
+
+
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
+      CALL histwrite(nid_day,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'snow',snow_fall,
+c    .              'Snow','mm/day')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
+      CALL histwrite(nid_day,"snow_mass",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c     call writephy(fid_day,prof2d_av,'snow_mass',zxsnow,
+c    .              'Snow cover','mm')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
+      CALL histwrite(nid_day,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'evap',evap,
+c    .              'Evaporation','mm/day')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
+      CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'tops',topsw,
+c    .              'Solar rad. at TOA','W/m2')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'topl',toplw,
+c    .              'IR rad. at TOA','W/m2')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'sols',solsw,
+c    .              'Solar rad. at surf.','W/m2')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'soll',sollw,
+c    .              'IR rad. at surface','W/m2')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
+      CALL histwrite(nid_day,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c     call writephy(fid_day,prof2d_av,'solldown',sollwdown,
+c    .              'Down. IR rad. at surface','W/m2')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
+      CALL histwrite(nid_day,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'bils',bils,
+c    .              'Surf. total heat flux','W/m2')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
+      CALL histwrite(nid_day,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'sens',sens,
+c    .              'Sensible heat flux','W/m2')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
+      CALL histwrite(nid_day,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'fder',fder,
+c    .              'Heat flux derivation','W/m2')
+c
+c
+      DO nsrf = 1, nbsrf
+CXXX
+        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+c       call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
+c    .                pctsrf( 1 : klon, nsrf),
+c    .                'Fraction'//clnsurf(nsrf),'-')
+C
+        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+c       call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
+c    .                ftsol( 1 : klon, nsrf),
+c    .                'Surf. Temp'//clnsurf(nsrf),'K')
+C 
+        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+c       call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
+c    .                fluxt( 1 : klon, 1, nsrf),
+c    .                'Sensible heat flux '//clnsurf(nsrf),'W/m2')
+C  
+        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+c       call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
+c    .                fluxlat( 1 : klon, nsrf),
+c    .                'Latent heat flux '//clnsurf(nsrf),'W/m2')
+C
+        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+c       call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
+c    .                fluxu( 1 : klon, 1, nsrf),
+c    .                'Zonal wind stress '//clnsurf(nsrf),'Pa')
+C      
+        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d)
+c       call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
+c    .                fluxv( 1 : klon, 1, nsrf),
+c    .                'Meridional wind stress '//clnsurf(nsrf),'Pa')
+C
+        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+c       call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
+c    .                falbe( 1 : klon, nsrf),
+c    .                'Albedo surf. SW'//clnsurf(nsrf),'-')
+c       call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
+c    .                falblw( 1 : klon, nsrf),
+c    .                'Albedo surf. LW'//clnsurf(nsrf),'-')
+C
+        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+c       call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
+c    .                frugs( 1 : klon, nsrf),
+c    .                'Rugosity '//clnsurf(nsrf),' - ')
+C 
+      END DO  
+C
+cXXX      DO i = 1, klon
+cXXX         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
+cXXX      ENDDO
+cXXX      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+cXXX      CALL histwrite(nid_day,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
+      CALL histwrite(nid_day,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'cldl',cldl,
+c    .              'Low-level cloudiness','-')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
+      CALL histwrite(nid_day,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'cldm',cldm,
+c    .              'Mid-level cloudiness','-')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
+      CALL histwrite(nid_day,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'cldh',cldh,
+c    .              'High-level cloudiness','-')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
+      CALL histwrite(nid_day,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'cldt',cldt,
+c    .              'Total cloudiness','-')
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
+      CALL histwrite(nid_day,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c     call writephy(fid_day,prof2d_av,'cldq',cldq,
+c    .              'Cloud liquid water path','-')
+c
+c Champs 3D:
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c Essai writephys
+      varname = 'temp'
+      vartitle= 'temperature 3D'
+      varunits= 'K'
+c     call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
+      CALL histwrite(nid_day,"ovap",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c     call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
+c    .              'Specific humidity','Kg/Kg')
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c     call writephy(fid_day,prof3d_av,'geop',zphi,
+c    .              'Geopotential height','m')
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c     call writephy(fid_day,prof3d_av,'vitu',u_seri,
+c    .              'Zonal wind','m/s')
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c     call writephy(fid_day,prof3d_av,'vitv',v_seri,
+c    .              'Meridional wind','m/s')
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
+      CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c     call writephy(fid_day,prof3d_av,'vitw',omega,
+c    .              'Vertical wind','m/s')
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c     call writephy(fid_day,prof3d_av,'pres',pplay,
+c    .              'Air pressure','Pa')
+cccIM
+      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day, "SWupTOA",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day, "SWupSFC",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day, "SWdnTOA",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_day, "SWdnSFC",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      if (ok_sync) then
+c       call writephy_sync(fid_day)
+        call histsync(nid_day)
+      endif
+      ENDIF
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histhf.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histhf.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histhf.h	(revision 418)
@@ -0,0 +1,58 @@
+      if (ok_hf) then
+
+c   Comprendre comment marche el i=nint(zout/zsto)
+c
+      print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
+      ndex2d = 0
+      ndex3d = 0
+c
+c
+c     i = NINT(zout/zsto)
+c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+c     CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     i = NINT(zout/zsto)
+c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
+c     CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
+      CALL histwrite(nid_hf,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_hf,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_hf,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, u850,zx_tmp_2d)
+      CALL histwrite(nid_hf,"u850",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, v850,zx_tmp_2d)
+      CALL histwrite(nid_hf,"v850",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, u500,zx_tmp_2d)
+      CALL histwrite(nid_hf,"u500",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, v500,zx_tmp_2d)
+      CALL histwrite(nid_hf,"v500",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, u200,zx_tmp_2d)
+      CALL histwrite(nid_hf,"u200",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, v200,zx_tmp_2d)
+      CALL histwrite(nid_hf,"v200",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, phi500,zx_tmp_2d)
+      CALL histwrite(nid_hf,"phi500",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      if (ok_sync) then
+        call histsync(nid_hf)
+      endif
+
+      endif
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histins.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histins.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histins.h	(revision 418)
@@ -0,0 +1,198 @@
+      IF (ok_instan) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+c
+c Champs 2D:
+c
+         zsto = dtime * ecrit_ins
+         zout = dtime * ecrit_ins
+         itau_w = itau_phy + itap
+
+         i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      CALL histwrite(nid_ins,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+         i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
+      CALL histwrite(nid_ins,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_ins,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_ins,"precip",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_ins,"plul",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_ins,"pluc",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
+      CALL histwrite(nid_ins,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+cccIM
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m, zx_tmp_2d)
+      CALL histwrite(nid_ins,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m, zx_tmp_2d)
+      CALL histwrite(nid_ins,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m, zx_tmp_2d)
+      CALL histwrite(nid_ins,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m, zx_tmp_2d)
+      CALL histwrite(nid_ins,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
+      CALL histwrite(nid_ins,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+      CALL histwrite(nid_ins,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+      CALL histwrite(nid_ins,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      CALL histwrite(nid_ins,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
+      CALL histwrite(nid_ins,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      CALL histwrite(nid_ins,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      CALL histwrite(nid_ins,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
+      CALL histwrite(nid_ins,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
+     .                ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
+      CALL histwrite(nid_ins,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
+      CALL histwrite(nid_ins,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
+      CALL histwrite(nid_ins,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
+      CALL histwrite(nid_ins,"dtsvdfo",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
+      CALL histwrite(nid_ins,"dtsvdft",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
+      CALL histwrite(nid_ins,"dtsvdfg",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
+      CALL histwrite(nid_ins,"dtsvdfi",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+
+      DO nsrf = 1, nbsrf
+CXXX
+        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C 
+        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C
+        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C
+        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C
+        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C      
+        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C
+        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C 
+      END DO  
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
+      CALL histwrite(nid_ins,"albs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
+      CALL histwrite(nid_ins,"albslw",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
+      CALL histwrite(nid_ins,"snow_mass",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d)
+      CALL histwrite(nid_ins,"rugs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+c Champs 3D:
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      CALL histwrite(nid_ins,"temp",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      CALL histwrite(nid_ins,"vitu",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      CALL histwrite(nid_ins,"vitv",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      CALL histwrite(nid_ins,"geop",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      CALL histwrite(nid_ins,"pres",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
+      CALL histwrite(nid_ins,"dtvdf",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
+      CALL histwrite(nid_ins,"dqvdf",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+
+c
+      if (ok_sync) then
+        call histsync(nid_ins)
+      endif
+      ENDIF
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmth.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmth.h	(revision 418)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmth.h	(revision 418)
@@ -0,0 +1,450 @@
+      IF (ok_mensuel) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+c
+c Champs 2D:
+c
+         zsto = dtime
+         zout = dtime * ecrit_mth
+         itau_w = itau_phy + itap
+
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
+      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
+      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+cccIM
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
+      CALL histwrite(nid_mth,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
+      CALL histwrite(nid_mth,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
+      CALL histwrite(nid_mth,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
+      CALL histwrite(nid_mth,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
+      CALL histwrite(nid_mth,"qsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth,"precip",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth,"plul",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth,"pluc",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
+      CALL histwrite(nid_mth,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
+      CALL histwrite(nid_mth,"snow_mass",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
+      CALL histwrite(nid_mth,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
+      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
+      CALL histwrite(nid_mth,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
+     .               ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
+      CALL histwrite(nid_mth,"tops0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
+      CALL histwrite(nid_mth,"topl0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
+      CALL histwrite(nid_mth,"sols0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
+      CALL histwrite(nid_mth,"soll0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
+      CALL histwrite(nid_mth,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
+      CALL histwrite(nid_mth,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
+      CALL histwrite(nid_mth,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+c
+c      DO i = 1, klon
+c         zx_tmp_fi2d(i) = fluxu(i,1)
+c      ENDDO
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+c      CALL histwrite(nid_mth,"frtu",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+c      DO i = 1, klon
+c         zx_tmp_fi2d(i) = fluxv(i,1)
+c      ENDDO
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+c      CALL histwrite(nid_mth,"frtv",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO nsrf = 1, nbsrf
+CYYY
+        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C 
+        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C
+        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
+C      
+        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d)
+C 
+        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d)
+C
+        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
+        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+        CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itau_w,
+     $      zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
+      CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itau_w
+     $    ,zx_tmp_2d,iim*jjmp1,ndex2d)
+
+      END DO  
+cXXX      DO i = 1, klon
+cXXX         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
+cXXX      ENDDO
+cXXX      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+cXXX      CALL histwrite(nid_mth,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
+      CALL histwrite(nid_mth,"albs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
+      CALL histwrite(nid_mth,"albslw",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
+      CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
+      CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
+      CALL histwrite(nid_mth,"uq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
+      CALL histwrite(nid_mth,"vq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+cKE43
+      IF (iflag_con .GE. 3) THEN ! sb
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
+      CALL histwrite(nid_mth,"cape",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
+      CALL histwrite(nid_mth,"pbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
+      CALL histwrite(nid_mth,"ptop",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
+      CALL histwrite(nid_mth,"fbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+c
+      ENDIF
+c34EK
+c
+c Champs 3D:
+C
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
+      CALL histwrite(nid_mth,"ovap",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
+      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
+      CALL histwrite(nid_mth,"rneb",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
+      CALL histwrite(nid_mth,"rhum",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
+      CALL histwrite(nid_mth,"oliq",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, clwcon0, zx_tmp_3d)
+      CALL histwrite(nid_mth,"clwcon",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dqdyn",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtcon",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dqcon",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtlsc",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dqlsc",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dqvdf",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dteva",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dqeva",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zpt_conv = 0.
+      where (ptconv) zpt_conv = 1.
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
+      CALL histwrite(nid_mth,"ptconv",itau_w,zx_tmp_3d,
+     .                                   iim*(jjmp1)*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
+      CALL histwrite(nid_mth,"ratqs",itau_w,zx_tmp_3d,
+     .                                   iim*(jjmp1)*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dqajs",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtsw0",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtlw0",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ec, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
+      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      IF (ok_orodr) THEN
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
+      CALL histwrite(nid_mth,"duoro",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dvoro",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF
+C
+      IF (ok_orolf) THEN
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dulif",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dvlif",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+      ENDIF
+C
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
+      CALL histwrite(nid_mth,"ozone",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      IF (nqmax.GE.3) THEN
+      DO iq=1,nqmax-2
+      IF (iq.LE.99) THEN
+         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
+         WRITE(str2,'(i2.2)') iq
+         CALL histwrite(nid_mth,"trac"//str2,itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+      ELSE
+         PRINT*, "Trop de traceurs"
+         CALL abort
+      ENDIF
+      ENDDO
+      ENDIF
+cKE43
+      IF (iflag_con.GE.3) THEN ! (sb)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
+      CALL histwrite(nid_mth,"upwd",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dnwd",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dnwd0",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
+      CALL histwrite(nid_mth,"Ma",itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+cccIM
+      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth, "SWupTOA",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth, "SWupSFC",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth, "SWdnTOA",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
+      CALL histwrite(nid_mth, "SWdnSFC",itau_w,zx_tmp_2d,
+     .                               iim*jjmp1,ndex2d)
+c
+      
+      ENDIF
+
+      if (ok_sync) then
+        call histsync(nid_mth)
+      endif
+      ENDIF
+
