Index: /LMDZ5/trunk/libf/phylmd/cv3_enthalpmix.F90
===================================================================
--- /LMDZ5/trunk/libf/phylmd/cv3_enthalpmix.F90	(revision 2902)
+++ /LMDZ5/trunk/libf/phylmd/cv3_enthalpmix.F90	(revision 2902)
@@ -0,0 +1,215 @@
+SUBROUTINE cv3_enthalpmix(len, nd, iflag, plim1, plim2, p, ph, &
+                       t, q, u, v, w, &
+                       wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl)
+  ! **************************************************************
+  ! *
+  ! CV3_ENTHALPMIX   Brassage adiabatique d'une couche d'epaisseur *
+  ! arbitraire.                                   *
+  ! *
+  ! written by   : Grandpeix Jean-Yves, 28/12/2001, 13.14.24    *
+  ! modified by :  Filiberti M-A 06/2005 vectorisation          *
+  ! **************************************************************
+
+  IMPLICIT NONE
+  ! ==============================================================
+
+  ! vertmix : determines theta, t, q, qs, u and v of the mixture generated by
+  ! adiabatic mixing of air between plim1 and plim2 with weighting w.
+  ! If plim1 and plim2 fall within the same model layer, then theta, ... v
+  ! are those of that layer.
+  ! A minimum value (dpmin) is imposed upon plim1-plim2
+
+  ! ===============================================================
+
+  include "cvthermo.h"
+  include "YOETHF.h"
+  include "YOMCST.h"
+  include "FCTTRE.h"
+!inputs:
+  INTEGER, INTENT (IN)                      :: nd, len
+  INTEGER, DIMENSION (len), INTENT (IN)     :: nk
+  REAL, DIMENSION (len), INTENT (IN)        :: plim1, plim2
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: t, q
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: u, v
+  REAL, DIMENSION (nd), INTENT (IN)         :: w
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: p
+  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
+!input/output:
+  INTEGER, DIMENSION (len), INTENT (INOUT)  ::  iflag
+!outputs:
+  REAL, DIMENSION (len), INTENT (OUT)       :: tmix, thmix, qmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: umix, vmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: qsmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: plcl
+  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
+!internal variables :
+  INTEGER i, j
+  INTEGER niflag7
+  INTEGER, DIMENSION(len)                   :: j1, j2
+  REAL                                      :: a, b
+  REAL                                      :: cpn
+  REAL                                      :: x, y, p0, p0m1, zdelta, zcor
+  REAL                                      :: dpmin=1.
+!$OMP THREADPRIVATE(dpmin)
+  REAL, DIMENSION(len)                      :: plim2p  ! = min(plim2(:),plim1(:)-dpmin)
+  REAL, DIMENSION(len)                      :: akm     ! mixture enthalpy
+  REAL, DIMENSION(len)                      :: dpw, coef
+  REAL, DIMENSION(len)                      :: rdcp, a2, b2, pnk
+  REAL, DIMENSION(len)                      :: rh, chi
+  REAL, DIMENSION(len)                      :: eqwght
+  REAL, DIMENSION(len,nd)                   :: p1, p2
+
+
+!!  print *,' ->cv3_vertmix, plim1,plim2 ', plim1,plim2   !jyg
+  plim2p(:) = min(plim2(:),plim1(:)-dpmin)
+  j1(:)=nd
+  j2(:) = 0
+  DO j = 1, nd
+    DO i = 1, len
+      IF (plim1(i)<=ph(i,j)) j1(i) = j
+!!!      IF (plim2p(i)>=ph(i,j+1) .AND. plim2p(i)<ph(i,j)) j2(i) = j
+      IF (plim2p(i)< ph(i,j)) j2(i) = j
+    END DO
+  END DO
+
+  DO j = 1, nd
+    DO i = 1, len
+      wi(i, j) = 0.
+    END DO
+  END DO
+  DO i = 1, len
+    akm(i) = 0.
+    qmix(i) = 0.
+    umix(i) = 0.
+    vmix(i) = 0.
+    dpw(i) = 0.
+    a2(i) = 0.0
+    b2(i) = 0.
+    pnk(i) = p(i, nk(i))
+  END DO
+  eqwght(:) = 0.
+
+  p0 = 1000.
+  p0m1 = 1./p0
+
+  DO i = 1, len
+    IF (j2(i) < j1(i)) THEN
+      coef(i) = 1.
+      eqwght(i) = 1.
+    ELSE
+      coef(i) = 1./(plim1(i)-plim2p(i))
+    ENDIF
+  END DO
+
+!!  print *,'cv3_vertmix, j1,j2,coef ', j1,j2,coef  !jyg
+
+  DO j = 1, nd
+    DO i = 1, len
+      IF (j>=j1(i) .AND. j<=j2(i)) THEN
+        p1(i, j) = min(ph(i,j), plim1(i))
+        p2(i, j) = max(ph(i,j+1), plim2p(i))
+        ! CRtest:couplage thermiques: deja normalise
+        ! wi(i,j) = w(j)
+        ! print*,'wi',wi(i,j)
+        wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i)+eqwght(i)
+        dpw(i) = dpw(i) + wi(i, j)
+
+!!  print *,'cv3_vertmix, j, wi(1,j),dpw ', j, wi(1,j),dpw  !jyg
+
+      END IF
+    END DO
+  END DO
+
+  ! CR:print
+  ! do i=1,len
+  ! print*,'plim',plim1(i),plim2p(i)
+  ! enddo
+  DO j = 1, nd
+    DO i = 1, len
+      IF (j>=j1(i) .AND. j<=j2(i)) THEN
+        wi(i, j) = wi(i, j)/dpw(i)
+        akm(i) = akm(i) + (cpd*(1.-q(i,j))+q(i,j)*cpv)*t(i, j)*wi(i, j)
+        qmix(i) = qmix(i) + q(i, j)*wi(i, j)
+        umix(i) = umix(i) + u(i, j)*wi(i, j)
+        vmix(i) = vmix(i) + v(i, j)*wi(i, j)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, len
+    rdcp(i) = (rrd*(1.-qmix(i))+qmix(i)*rrv)/(cpd*(1.-qmix(i))+qmix(i)*cpv)
+  END DO
+
+
+!!  print *,'cv3_vertmix, rdcp ', rdcp  !jyg
+
+
+
+  DO j = 1, nd
+    DO i = 1, len
+      IF (j>=j1(i) .AND. j<=j2(i)) THEN
+        ! c            x=(.5*(p1(i,j)+p2(i,j))*p0m1)**rdcp(i)
+        y = (.5*(p1(i,j)+p2(i,j))/pnk(i))**rdcp(i)
+        ! c            a2(i)=a2(i)+(cpd*(1.-qmix(i))+qmix(i)*cpv)*x*wi(i,j)
+        b2(i) = b2(i) + (cpd*(1.-qmix(i))+qmix(i)*cpv)*y*wi(i, j)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, len
+    tmix(i) = akm(i)/b2(i)
+    thmix(i) = tmix(i)*(p0/pnk(i))**rdcp(i)
+    ! print*,'thmix akm',akm(i),b2(i)
+    ! print*,'thmix t',tmix(i),p0
+    ! print*,'thmix p',pnk(i),rdcp(i)
+    ! print*,'thmix',thmix(i)
+    ! c         thmix(i) = akm(i)/a2(i)
+    ! c         tmix(i)= thmix(i)*(pnk(i)*p0m1)**rdcp(i)
+    zdelta = max(0., sign(1.,rtt-tmix(i)))
+    qsmix(i) = r2es*foeew(tmix(i), zdelta)/(pnk(i)*100.)
+    qsmix(i) = min(0.5, qsmix(i))
+    zcor = 1./(1.-retv*qsmix(i))
+    qsmix(i) = qsmix(i)*zcor
+  END DO
+
+  ! -------------------------------------------------------------------
+  ! --- 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
+
+
+  niflag7 = 0
+  DO i = 1, len
+
+    IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002
+
+      rh(i) = qmix(i)/qsmix(i)
+      chi(i) = tmix(i)/(a-b*rh(i)-tmix(i)) ! convect3
+      ! ATTENTION, la LIGNE DESSOUS A ETE RAJOUTEE ARBITRAIREMENT ET
+      ! MASQUE UN PB POTENTIEL
+      chi(i) = max(chi(i), 0.)
+      rh(i) = max(rh(i), 0.)
+      plcl(i) = pnk(i)*(rh(i)**chi(i))
+      IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) &
+          iflag(i) = 8
+
+    ELSE
+
+      niflag7 = niflag7 + 1
+      plcl(i) = plim2p(i)
+
+    END IF ! iflag=7
+
+    ! print*,'NIFLAG7  =',niflag7
+
+  END DO
+
+!!  print *,' cv3_vertmix->'  !jyg
+
+
+  RETURN
+END SUBROUTINE cv3_enthalpmix
+
Index: /LMDZ5/trunk/libf/phylmd/cv3_estatmix.F90
===================================================================
--- /LMDZ5/trunk/libf/phylmd/cv3_estatmix.F90	(revision 2902)
+++ /LMDZ5/trunk/libf/phylmd/cv3_estatmix.F90	(revision 2902)
@@ -0,0 +1,198 @@
+SUBROUTINE cv3_estatmix(len, nd, iflag, plim1, plim2, p, ph, &
+                       t, q, u, v, h, gz, w, &
+                       wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl)
+  ! **************************************************************
+  ! *
+  ! CV3_ESTATMIX  Determine the properties of an adiabatic updraft  *
+  !                made of air coming from several layers by        *
+  !                mixing static energy                             *
+  !                                                                 *
+  ! written by   : Grandpeix Jean-Yves, 28/12/2001, 13.14.24        *
+  ! modified by :  Filiberti M-A 06/2005 vectorisation              *
+  ! ****************************************************************
+
+  IMPLICIT NONE
+  ! ==============================================================
+
+  ! estatmix : determines theta, t, q, qs, u and v of the lifted mixture
+  ! made of air between plim1 and plim2 with weighting w.
+  ! If plim1 and plim2 fall within the same model layer, then theta, ... v
+  ! are those of that layer.
+  ! A minimum value (dpmin) is imposed upon plim1-plim2
+
+  ! ===============================================================
+
+  include "cvthermo.h"
+  include "YOETHF.h"
+  include "YOMCST.h"
+  include "FCTTRE.h"
+!inputs:
+  INTEGER, INTENT (IN)                      :: nd, len
+  INTEGER, DIMENSION (len), INTENT (IN)     :: nk
+  REAL, DIMENSION (len), INTENT (IN)        :: plim1, plim2
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: t, q
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: u, v
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: h ! static energy of the layers
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: gz
+  REAL, DIMENSION (nd), INTENT (IN)         :: w
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: p
+  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
+!input/output:
+  INTEGER, DIMENSION (len), INTENT (INOUT)  ::  iflag
+!outputs:
+  REAL, DIMENSION (len), INTENT (OUT)       :: tmix, thmix, qmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: umix, vmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: qsmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: plcl
+  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
+!internal variables :
+  INTEGER i, j
+  INTEGER niflag7
+  INTEGER, DIMENSION(len)                   :: j1, j2
+  REAL                                      :: a, b
+  REAL                                      :: cpn
+  REAL                                      :: x, y, p0, zdelta, zcor
+  REAL                                      :: dpmin=1.
+!$OMP THREADPRIVATE(dpmin)
+  REAL, DIMENSION(len)                      :: plim2p  ! = min(plim2(:),plim1(:)-dpmin)
+  REAL, DIMENSION(len)                      :: dpw, coef
+  REAL, DIMENSION(len)                      :: hmix ! static energy of the updraft
+  REAL, DIMENSION(len)                      :: rdcp, pnk
+  REAL, DIMENSION(len)                      :: rh, chi
+  REAL, DIMENSION(len)                      :: eqwght
+  REAL, DIMENSION(len,nd)                   :: p1, p2
+
+
+!!  print *,' ->cv3_vertmix, plim1,plim2 ', plim1,plim2   !jyg
+  plim2p(:) = min(plim2(:),plim1(:)-dpmin)
+  j1(:)=nd
+  j2(:) = 0
+  DO j = 1, nd
+    DO i = 1, len
+      IF (plim1(i)<=ph(i,j)) j1(i) = j
+!!!      IF (plim2p(i)>=ph(i,j+1) .AND. plim2p(i)<ph(i,j)) j2(i) = j
+      IF (plim2p(i)< ph(i,j)) j2(i) = j
+    END DO
+  END DO
+
+  DO j = 1, nd
+    DO i = 1, len
+      wi(i, j) = 0.
+    END DO
+  END DO
+  DO i = 1, len
+    hmix(i) = 0.
+    qmix(i) = 0.
+    umix(i) = 0.
+    vmix(i) = 0.
+    dpw(i) = 0.
+    pnk(i) = p(i, nk(i))
+  END DO
+  eqwght(:) = 0.
+
+  p0 = 1000.
+
+  DO i = 1, len
+    IF (j2(i) < j1(i)) THEN
+      coef(i) = 1.
+      eqwght(i) = 1.
+    ELSE
+      coef(i) = 1./(plim1(i)-plim2p(i))
+    ENDIF
+  END DO
+
+!!  print *,'cv3_vertmix, j1,j2,coef ', j1,j2,coef  !jyg
+
+  DO j = 1, nd
+    DO i = 1, len
+      IF (j>=j1(i) .AND. j<=j2(i)) THEN
+        p1(i, j) = min(ph(i,j), plim1(i))
+        p2(i, j) = max(ph(i,j+1), plim2p(i))
+        ! CRtest:couplage thermiques: deja normalise
+        ! wi(i,j) = w(j)
+        ! print*,'wi',wi(i,j)
+        wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i)+eqwght(i)
+        dpw(i) = dpw(i) + wi(i, j)
+
+!!  print *,'cv3_vertmix, j, wi(1,j),dpw ', j, wi(1,j),dpw  !jyg
+
+      END IF
+    END DO
+  END DO
+
+  ! CR:print
+  ! do i=1,len
+  ! print*,'plim',plim1(i),plim2p(i)
+  ! enddo
+  DO j = 1, nd
+    DO i = 1, len
+      IF (j>=j1(i) .AND. j<=j2(i)) THEN
+        wi(i, j) = wi(i, j)/dpw(i)
+        hmix(i) = hmix(i) + h(i, j)*wi(i, j)
+        qmix(i) = qmix(i) +  q(i, j)*wi(i, j)
+        umix(i) = umix(i) +  u(i, j)*wi(i, j)
+        vmix(i) = vmix(i) +  v(i, j)*wi(i, j)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, len
+    rdcp(i) = (rrd*(1.-qmix(i))+qmix(i)*rrv)/(cpd*(1.-qmix(i))+qmix(i)*cpv)
+  END DO
+
+
+!!  print *,'cv3_vertmix, rdcp ', rdcp  !jyg
+
+  DO i = 1, len
+    tmix(i) = (hmix(i) - gz(i,1))/(cpd*(1.-qmix(i)) + qmix(i)*cpv)
+    !      (Use of Cpv since we are dealing with dry static energy)
+    thmix(i) = tmix(i)*(p0/pnk(i))**rdcp(i)
+    ! print*,'tmix thmix hmix ',tmix(i),thmix(i),hmix(i)
+    zdelta = max(0., sign(1.,rtt-tmix(i)))
+    qsmix(i) = r2es*foeew(tmix(i), zdelta)/(pnk(i)*100.)
+    qsmix(i) = min(0.5, qsmix(i))
+    zcor = 1./(1.-retv*qsmix(i))
+    qsmix(i) = qsmix(i)*zcor
+  END DO
+
+  ! -------------------------------------------------------------------
+  ! --- 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
+
+
+  niflag7 = 0
+  DO i = 1, len
+
+    IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002
+
+      rh(i) = qmix(i)/qsmix(i)
+      chi(i) = tmix(i)/(a-b*rh(i)-tmix(i)) ! convect3
+      ! ATTENTION, la LIGNE DESSOUS A ETE RAJOUTEE ARBITRAIREMENT ET
+      ! MASQUE UN PB POTENTIEL
+      chi(i) = max(chi(i), 0.)
+      rh(i) = max(rh(i), 0.)
+      plcl(i) = pnk(i)*(rh(i)**chi(i))
+      IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) &
+          iflag(i) = 8
+
+    ELSE
+
+      niflag7 = niflag7 + 1
+      plcl(i) = plim2p(i)
+
+    END IF ! iflag=7
+
+    ! print*,'NIFLAG7  =',niflag7
+
+  END DO
+
+!!  print *,' cv3_vertmix->'  !jyg
+
+
+  RETURN
+END SUBROUTINE cv3_estatmix
+
Index: /LMDZ5/trunk/libf/phylmd/cv3_routines.F90
===================================================================
--- /LMDZ5/trunk/libf/phylmd/cv3_routines.F90	(revision 2901)
+++ /LMDZ5/trunk/libf/phylmd/cv3_routines.F90	(revision 2902)
@@ -280,5 +280,5 @@
 
 SUBROUTINE cv3_feed(len, nd, ok_conserv_q, &
-                    t, q, u, v, p, ph, hm, gz, &
+                    t, q, u, v, p, ph, h, gz, &
                     p1feed, p2feed, wght, &
                     wghti, tnk, thnk, qnk, qsnk, unk, vnk, &
@@ -286,4 +286,5 @@
 
   USE mod_phys_lmdz_transfert_para, ONLY : bcast
+  USE add_phys_tend_mod, ONLY: fl_cor_ebil
   IMPLICIT NONE
 
@@ -295,4 +296,5 @@
 ! - here, nk(i)=minorig
 ! - icb defined differently (plcl compared with ph instead of p)
+! - dry static energy as argument instead of moist static energy
 
 ! Main differences with convect3:
@@ -310,5 +312,5 @@
   REAL, DIMENSION (len, nd), INTENT (IN)             :: t, q, p
   REAL, DIMENSION (len, nd), INTENT (IN)             :: u, v
-  REAL, DIMENSION (len, nd), INTENT (IN)             :: hm, gz
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: h, gz
   REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph
   REAL, DIMENSION (len), INTENT (IN)                 :: p1feed
@@ -381,14 +383,26 @@
     pup(i) = p2feed(i)
   END DO
-  CALL cv3_vertmix(len, nd, iflag, p1feed, pup, p, ph, &
-                   t, q, u, v, wght, &
-                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+  IF (fl_cor_ebil >=2 ) THEN
+    CALL cv3_estatmix(len, nd, iflag, p1feed, pup, p, ph, &
+                     t, q, u, v, h, gz, wght, &
+                     wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+  ELSE
+    CALL cv3_enthalpmix(len, nd, iflag, p1feed, pup, p, ph, &
+                       t, q, u, v, wght, &
+                       wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+  ENDIF  ! (fl_cor_ebil >=2 ) 
 ! 1.b- LCL associated with ph(nk+1)
   DO i = 1, len
     plo(i) = ph(i, nk(i)+1)
   END DO
-  CALL cv3_vertmix(len, nd, iflag, p1feed, plo, p, ph, &
-                   t, q, u, v, wght, &
-                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  IF (fl_cor_ebil >=2 ) THEN
+    CALL cv3_estatmix(len, nd, iflag, p1feed, plo, p, ph, &
+                     t, q, u, v, h, gz, wght, &
+                     wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  ELSE
+    CALL cv3_enthalpmix(len, nd, iflag, p1feed, plo, p, ph, &
+                       t, q, u, v, wght, &
+                       wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  ENDIF  ! (fl_cor_ebil >=2 ) 
 ! 2- Iterations
   niter = 5
@@ -437,7 +451,13 @@
 !jyg>
 
-    CALL cv3_vertmix(len, nd, iflag, p1feed, pfeed, p, ph, &
-                   t, q, u, v, wght, &
-                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+    IF (fl_cor_ebil >=2 ) THEN
+      CALL cv3_estatmix(len, nd, iflag, p1feed, pfeed, p, ph, &
+                       t, q, u, v, h, gz, wght, &
+                       wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+    ELSE
+      CALL cv3_enthalpmix(len, nd, iflag, p1feed, pfeed, p, ph, &
+                         t, q, u, v, wght, &
+                         wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+    ENDIF  ! (fl_cor_ebil >=2 ) 
 !jyg20140217<
     IF (ok_new_feed) THEN
@@ -1650,4 +1670,10 @@
       DO i = 1, ncum
         IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
+!jyg<   (energy conservation tests)
+!!          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*tp(i,k))*ep(i, k)*clw(i, k)
+!!          hp(i, k) = ( hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k) ) / &
+!!                     (1. - ep(i,k)*clw(i,k))
+!!          hp(i, k) = ( hnk(i) + (lv(i,k)+(cpd-cl)*t(i,k))*ep(i, k)*clw(i, k) ) / &
+!!                     (1. - ep(i,k)*clw(i,k))
           hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k)
         END IF
@@ -3543,7 +3569,5 @@
                                     t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
         END IF
-
-
-
+!
 ! sb: on ne fait pas encore la correction permettant de mieux
 ! conserver l'eau:
Index: DZ5/trunk/libf/phylmd/cv3_vertmix.F90
===================================================================
--- /LMDZ5/trunk/libf/phylmd/cv3_vertmix.F90	(revision 2901)
+++ 	(revision )
@@ -1,214 +1,0 @@
-SUBROUTINE cv3_vertmix(len, nd, iflag, plim1, plim2, p, ph, &
-                       t, q, u, v, w, &
-                       wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl)
-  ! **************************************************************
-  ! *
-  ! CV3_VERTMIX   Brassage adiabatique d'une couche d'epaisseur *
-  ! arbitraire.                                   *
-  ! *
-  ! written by   : Grandpeix Jean-Yves, 28/12/2001, 13.14.24    *
-  ! modified by :  Filiberti M-A 06/2005 vectorisation          *
-  ! **************************************************************
-
-  IMPLICIT NONE
-  ! ==============================================================
-
-  ! vertmix : determines theta, t, q, qs, u and v of the mixture generated by
-  ! adiabatic mixing of air between plim1 and plim2 with weighting w.
-  ! If plim1 and plim2 fall within the same model layer, then theta, ... v
-  ! are those of that layer.
-  ! A minimum value (dpmin) is imposed upon plim1-plim2
-
-  ! ===============================================================
-
-  include "cvthermo.h"
-  include "YOETHF.h"
-  include "YOMCST.h"
-  include "FCTTRE.h"
-!inputs:
-  INTEGER, INTENT (IN)                      ::  nd, len
-  INTEGER, DIMENSION (len), INTENT (IN)     ::  nk
-  REAL, DIMENSION (nd), INTENT (IN)        ::  w
-  REAL, DIMENSION (len), INTENT (IN)        :: plim1, plim2
-  REAL, DIMENSION (len,nd), INTENT (IN)     :: t, q
-  REAL, DIMENSION (len,nd), INTENT (IN)     :: u, v
-  REAL, DIMENSION (len,nd), INTENT (IN)     :: p
-  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
-!input/output:
-  INTEGER, DIMENSION (len), INTENT (INOUT)  ::  iflag
-!outputs:
-  REAL, DIMENSION (len), INTENT (OUT)       :: tmix, thmix, qmix
-  REAL, DIMENSION (len), INTENT (OUT)       :: umix, vmix
-  REAL, DIMENSION (len), INTENT (OUT)       :: qsmix
-  REAL, DIMENSION (len), INTENT (OUT)       :: plcl
-  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
-!internal variables :
-  INTEGER i, j
-  INTEGER niflag7
-  INTEGER, DIMENSION(len)                   :: j1, j2
-  REAL                                      :: a, b
-  REAL                                      :: cpn
-  REAL                                      :: x, y, p0, p0m1, zdelta, zcor
-  REAL                                      :: dpmin=1.
-!$OMP THREADPRIVATE(dpmin)
-  REAL, DIMENSION(len)                      :: plim2p  ! = min(plim2(:),plim1(:)-dpmin)
-  REAL, DIMENSION(len)                      :: ahm, dpw, coef
-  REAL, DIMENSION(len)                      :: rdcp, a2, b2, pnk
-  REAL, DIMENSION(len)                      :: rh, chi
-  REAL, DIMENSION(len)                      :: eqwght
-  REAL, DIMENSION(len,nd)                   :: p1, p2
-
-
-!!  print *,' ->cv3_vertmix, plim1,plim2 ', plim1,plim2   !jyg
-  plim2p(:) = min(plim2(:),plim1(:)-dpmin)
-  j1(:)=nd
-  j2(:) = 0
-  DO j = 1, nd
-    DO i = 1, len
-      IF (plim1(i)<=ph(i,j)) j1(i) = j
-!!!      IF (plim2p(i)>=ph(i,j+1) .AND. plim2p(i)<ph(i,j)) j2(i) = j
-      IF (plim2p(i)< ph(i,j)) j2(i) = j
-    END DO
-  END DO
-
-  DO j = 1, nd
-    DO i = 1, len
-      wi(i, j) = 0.
-    END DO
-  END DO
-  DO i = 1, len
-    ahm(i) = 0.
-    qmix(i) = 0.
-    umix(i) = 0.
-    vmix(i) = 0.
-    dpw(i) = 0.
-    a2(i) = 0.0
-    b2(i) = 0.
-    pnk(i) = p(i, nk(i))
-  END DO
-  eqwght(:) = 0.
-
-  p0 = 1000.
-  p0m1 = 1./p0
-
-  DO i = 1, len
-    IF (j2(i) < j1(i)) THEN
-      coef(i) = 1.
-      eqwght(i) = 1.
-    ELSE
-      coef(i) = 1./(plim1(i)-plim2p(i))
-    ENDIF
-  END DO
-
-!!  print *,'cv3_vertmix, j1,j2,coef ', j1,j2,coef  !jyg
-
-  DO j = 1, nd
-    DO i = 1, len
-      IF (j>=j1(i) .AND. j<=j2(i)) THEN
-        p1(i, j) = min(ph(i,j), plim1(i))
-        p2(i, j) = max(ph(i,j+1), plim2p(i))
-        ! CRtest:couplage thermiques: deja normalise
-        ! wi(i,j) = w(j)
-        ! print*,'wi',wi(i,j)
-        wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i)+eqwght(i)
-        dpw(i) = dpw(i) + wi(i, j)
-
-!!  print *,'cv3_vertmix, j, wi(1,j),dpw ', j, wi(1,j),dpw  !jyg
-
-      END IF
-    END DO
-  END DO
-
-  ! CR:print
-  ! do i=1,len
-  ! print*,'plim',plim1(i),plim2p(i)
-  ! enddo
-  DO j = 1, nd
-    DO i = 1, len
-      IF (j>=j1(i) .AND. j<=j2(i)) THEN
-        wi(i, j) = wi(i, j)/dpw(i)
-        ahm(i) = ahm(i) + (cpd*(1.-q(i,j))+q(i,j)*cpv)*t(i, j)*wi(i, j)
-        qmix(i) = qmix(i) + q(i, j)*wi(i, j)
-        umix(i) = umix(i) + u(i, j)*wi(i, j)
-        vmix(i) = vmix(i) + v(i, j)*wi(i, j)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, len
-    rdcp(i) = (rrd*(1.-qmix(i))+qmix(i)*rrv)/(cpd*(1.-qmix(i))+qmix(i)*cpv)
-  END DO
-
-
-!!  print *,'cv3_vertmix, rdcp ', rdcp  !jyg
-
-
-
-  DO j = 1, nd
-    DO i = 1, len
-      IF (j>=j1(i) .AND. j<=j2(i)) THEN
-        ! c            x=(.5*(p1(i,j)+p2(i,j))*p0m1)**rdcp(i)
-        y = (.5*(p1(i,j)+p2(i,j))/pnk(i))**rdcp(i)
-        ! c            a2(i)=a2(i)+(cpd*(1.-qmix(i))+qmix(i)*cpv)*x*wi(i,j)
-        b2(i) = b2(i) + (cpd*(1.-qmix(i))+qmix(i)*cpv)*y*wi(i, j)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, len
-    tmix(i) = ahm(i)/b2(i)
-    thmix(i) = tmix(i)*(p0/pnk(i))**rdcp(i)
-    ! print*,'thmix ahm',ahm(i),b2(i)
-    ! print*,'thmix t',tmix(i),p0
-    ! print*,'thmix p',pnk(i),rdcp(i)
-    ! print*,'thmix',thmix(i)
-    ! c         thmix(i) = ahm(i)/a2(i)
-    ! c         tmix(i)= thmix(i)*(pnk(i)*p0m1)**rdcp(i)
-    zdelta = max(0., sign(1.,rtt-tmix(i)))
-    qsmix(i) = r2es*foeew(tmix(i), zdelta)/(pnk(i)*100.)
-    qsmix(i) = min(0.5, qsmix(i))
-    zcor = 1./(1.-retv*qsmix(i))
-    qsmix(i) = qsmix(i)*zcor
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- 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
-
-
-  niflag7 = 0
-  DO i = 1, len
-
-    IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002
-
-      rh(i) = qmix(i)/qsmix(i)
-      chi(i) = tmix(i)/(a-b*rh(i)-tmix(i)) ! convect3
-      ! ATTENTION, la LIGNE DESSOUS A ETE RAJOUTEE ARBITRAIREMENT ET
-      ! MASQUE UN PB POTENTIEL
-      chi(i) = max(chi(i), 0.)
-      rh(i) = max(rh(i), 0.)
-      plcl(i) = pnk(i)*(rh(i)**chi(i))
-      IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) &
-          iflag(i) = 8
-
-    ELSE
-
-      niflag7 = niflag7 + 1
-      plcl(i) = plim2p(i)
-
-    END IF ! iflag=7
-
-    ! print*,'NIFLAG7  =',niflag7
-
-  END DO
-
-!!  print *,' cv3_vertmix->'  !jyg
-
-
-  RETURN
-END SUBROUTINE cv3_vertmix
-
Index: /LMDZ5/trunk/libf/phylmd/cv3p_mixing.F90
===================================================================
--- /LMDZ5/trunk/libf/phylmd/cv3p_mixing.F90	(revision 2901)
+++ /LMDZ5/trunk/libf/phylmd/cv3p_mixing.F90	(revision 2902)
@@ -254,9 +254,12 @@
         uent(il, i, i) = unk(il)
         vent(il, i, i) = vnk(il)
+        IF (fl_cor_ebil .GE. 2) THEN
+          hent(il, i, i) = hp(il,i)
+        ENDIF
         elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
         Sij(il, i, i) = 0.0
       END IF
     END DO
-  END DO
+  END DO ! i = minorig + 1, nl
 
 !jyg!  DO j = 1, ntra
@@ -663,5 +666,10 @@
         vent(il, i, i) = vnk(il)
         elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
-        Sij(il, i, i) = 0.0
+        IF (fl_cor_ebil .GE. 2) THEN
+          hent(il, i, i) = hp(il,i)
+          Sigij(il, i, i) = 0.0
+        ELSE
+          Sij(il, i, i) = 0.0
+        ENDIF
       END IF
     END DO ! il
Index: /LMDZ5/trunk/libf/phylmd/cva_driver.F90
===================================================================
--- /LMDZ5/trunk/libf/phylmd/cva_driver.F90	(revision 2901)
+++ /LMDZ5/trunk/libf/phylmd/cva_driver.F90	(revision 2902)
@@ -40,4 +40,5 @@
 
   USE print_control_mod, ONLY: prt_level, lunout
+  USE add_phys_tend_mod, ONLY: fl_cor_ebil
   IMPLICIT NONE
 
@@ -730,5 +731,5 @@
              PRINT *, 'cva_driver -> cv3_feed'
     CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
-                  t1, q1, u1, v1, p1, ph1, hm1, gz1, & 
+                  t1, q1, u1, v1, p1, ph1, h1, gz1, & 
                   p1feed1, p2feed1, wght1, &
                   wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
Index: /LMDZ5/trunk/libf/phylmd/physiq_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/phylmd/physiq_mod.F90	(revision 2901)
+++ /LMDZ5/trunk/libf/phylmd/physiq_mod.F90	(revision 2902)
@@ -245,5 +245,5 @@
 
     USE cmp_seri_mod
-    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, prt_enerbil, &
+    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
   &      fl_ebil, fl_cor_ebil
 
