Changeset 5141 for LMDZ6/branches/Amaury_dev

Timestamp:

Jul 29, 2024, 12:37:08 PM (5 months ago)

Author:

abarral

Message:

Put cvthermo.h, cv30param.h, cv3param.h into modules

Location:

LMDZ6/branches/Amaury_dev/libf

Files:

• phylmd/cv30param.h (deleted)
• phylmd/cv3_buoy.F90 (modified) (1 diff)
• phylmd/cv3_cine.F90 (modified) (28 diffs)
• phylmd/cv3_crit.F90 (modified) (1 diff)
• phylmd/cv3_enthalpmix.F90 (modified) (2 diffs)
• phylmd/cv3_estatmix.F90 (modified) (2 diffs)
• phylmd/cv3_mixscale.F90 (modified) (1 diff)
• phylmd/cv3_routines.F90 (modified) (112 diffs)
• phylmd/cv3a_compress.F90 (modified) (1 diff)
• phylmd/cv3a_uncompress.F90 (modified) (1 diff)
• phylmd/cv3p1_closure.F90 (modified) (1 diff)
• phylmd/cv3p2_closure.F90 (modified) (1 diff)
• phylmd/cv3p_mixing.F90 (modified) (1 diff)
• phylmd/cv_driver.F90 (modified) (3 diffs)
• phylmd/cv_routines.F90 (modified) (79 diffs)
• phylmd/lmdz_cv30.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90) (4 diffs)
• phylmd/lmdz_cv3param.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/cv3param.h) (1 diff)
• phylmd/lmdz_cvthermo.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/cvthermo.h) (1 diff)
• phylmdiso/cv30param.h (deleted)
• phylmdiso/cv3_enthalpmix.F90 (modified) (2 diffs)
• phylmdiso/cv3_estatmix.F90 (modified) (2 diffs)
• phylmdiso/cv3_routines.F90 (modified) (25 diffs)
• phylmdiso/cv3a_compress.F90 (modified) (1 diff)
• phylmdiso/cv3a_uncompress.F90 (modified) (1 diff)
• phylmdiso/cv3p_mixing.F90 (modified) (1 diff)
• phylmdiso/cv_driver.F90 (modified) (3 diffs)
• phylmdiso/cv_routines.F90 (modified) (10 diffs)
• phylmdiso/lmdz_cv30.F90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv30_routines.F90) (22 diffs)
• phylmdiso/lmdz_cv3param.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3param.h) (1 diff)
• phylmdiso/lmdz_cvthermo.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmdiso/cvthermo.h) (1 diff)
• phylmdiso/lmdz_wake.F90 (modified) (2 diffs)

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_buoy.F90

@@ -9 +9 @@
   ! modified by :                                               *
   ! **************************************************************
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-  include "cvthermo.h"
-  include "cv3param.h"
   include "YOMCST2.h"
 

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_cine.F90

@@ -1 @@
-
 ! $Id$
 
 SUBROUTINE cv3_cine(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, tvp, &
-    cina, cinb, plfc)
+        cina, cinb, plfc)
 
   ! **************************************************************
@@ -14 +13 @@
   ! modified by :                                               *
   ! **************************************************************
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "cvthermo.h"
-  include "cv3param.h"
   ! input:
   INTEGER ncum, nd, nloc
   INTEGER icb(nloc), inb(nloc)
   REAL pbase(nloc), plcl(nloc)
-  REAL p(nloc, nd), ph(nloc, nd+1)
+  REAL p(nloc, nd), ph(nloc, nd + 1)
   REAL tv(nloc, nd), tvp(nloc, nd)
 
@@ -67 +66 @@
 
   DO il = 1, ncum
-    tvplcl(il) = tvp(il, 1)*(plcl(il)/p(il,1))**(2./7.) !For dry air, R/Cp=2/7
-  END DO
-
-  DO il = 1, ncum
-    IF (plcl(il)>p(il,icb(il))) THEN
+    tvplcl(il) = tvp(il, 1) * (plcl(il) / p(il, 1))**(2. / 7.) !For dry air, R/Cp=2/7
+  END DO
+
+  DO il = 1, ncum
+    IF (plcl(il)>p(il, icb(il))) THEN
       ifst(il) = icb(il)
       isublcl(il) = icb(il) - 1
@@ -81 +80 @@
 
   DO il = 1, ncum
-    tvlcl(il) = tv(il, ifst(il)-1) + (tv(il,ifst(il))-tv(il,ifst(il)-1))*( &
-      plcl(il)-p(il,ifst(il)-1))/(p(il,ifst(il))-p(il,ifst(il)-1))
+    tvlcl(il) = tv(il, ifst(il) - 1) + (tv(il, ifst(il)) - tv(il, ifst(il) - 1)) * (&
+            plcl(il) - p(il, ifst(il) - 1)) / (p(il, ifst(il)) - p(il, ifst(il) - 1))
   END DO
 
@@ -102 +101 @@
     DO il = 1, ncum
       IF (k>=ifst(il)) THEN
-        IF (buoy(il,k)>0.) THEN
+        IF (buoy(il, k)>0.) THEN
           itop(il) = k
           exist_lfc(il) = .TRUE.
@@ -146 +145 @@
   DO il = 1, ncum
     IF (lswitch(il)) THEN
-      IF (p(il,ineg(il))<p(il,icb(il))-dpmax) THEN
+      IF (p(il, ineg(il))<p(il, icb(il)) - dpmax) THEN
         plfc(il) = plcl(il)
         cina(il) = 0.
@@ -173 +172 @@
     DO il = 1, ncum
       IF (lswitch(il)) THEN
-        IF (k>=ineg(il) .AND. buoy(il,k)>0) THEN
+        IF (k>=ineg(il) .AND. buoy(il, k)>0) THEN
           itop(il) = k
         END IF
@@ -191 +190 @@
 
   DO il = 1, ncum
-    lswitch3(il) = itop(il) < nl -1
+    lswitch3(il) = itop(il) < nl - 1
     lswitch(il) = lswitch1(il) .AND. lswitch2(il) .AND. lswitch3(il)
   END DO
@@ -202 +201 @@
       ! de LCL
       ! ---------------------------------------------------------------------------
-      IF (ineg(il)>isublcl(il)+1) THEN
+      IF (ineg(il)>isublcl(il) + 1) THEN
         ! In order to get P0, one may interpolate linearly buoyancies
         ! between P(ineg) and P(ineg-1).
-        p0(il) = (buoy(il,ineg(il))*p(il,ineg(il)-1)-buoy(il,ineg(il)-1)*p(il,ineg(il)))/ &
-          (buoy(il,ineg(il))-buoy(il,ineg(il)-1))
+        p0(il) = (buoy(il, ineg(il)) * p(il, ineg(il) - 1) - buoy(il, ineg(il) - 1) * p(il, ineg(il))) / &
+                (buoy(il, ineg(il)) - buoy(il, ineg(il) - 1))
       ELSE
         ! In order to get P0, one has to interpolate between P(ineg) and
         ! Plcl.
-        p0(il) = (buoy(il,ineg(il))*plcl(il)-buoylcl(il)*p(il,ineg(il)))/ &
-          (buoy(il,ineg(il))-buoylcl(il))
+        p0(il) = (buoy(il, ineg(il)) * plcl(il) - buoylcl(il) * p(il, ineg(il))) / &
+                (buoy(il, ineg(il)) - buoylcl(il))
       END IF
     END IF
@@ -220 +219 @@
   DO il = 1, ncum
     IF (lswitch(il)) THEN
-      plfc(il) = (buoy(il,itop(il))*p(il,itop(il)-1)-buoy(il,itop( &
-        il)-1)*p(il,itop(il)))/(buoy(il,itop(il))-buoy(il,itop(il)-1))
+      plfc(il) = (buoy(il, itop(il)) * p(il, itop(il) - 1) - buoy(il, itop(&
+              il) - 1) * p(il, itop(il))) / (buoy(il, itop(il)) - buoy(il, itop(il) - 1))
     END IF
   END DO
@@ -231 +230 @@
   DO il = 1, ncum
     IF (lswitch(il)) THEN
-      deltap = p(il, itop(il)-1) - plfc(il)
-      dcin = rd*buoy(il, itop(il)-1)*deltap/(p(il,itop(il)-1)+plfc(il))
+      deltap = p(il, itop(il) - 1) - plfc(il)
+      dcin = rd * buoy(il, itop(il) - 1) * deltap / (p(il, itop(il) - 1) + plfc(il))
       cina(il) = min(0., dcin)
     END IF
@@ -241 +240 @@
     DO il = 1, ncum
       IF (lswitch(il)) THEN
-        IF (k>=ineg(il) .AND. k<=itop(il)-2) THEN
-          deltap = p(il, k) - p(il, k+1)
-          dcin = 0.5*rd*(buoy(il,k)+buoy(il,k+1))*deltap/ph(il, k+1)
+        IF (k>=ineg(il) .AND. k<=itop(il) - 2) THEN
+          deltap = p(il, k) - p(il, k + 1)
+          dcin = 0.5 * rd * (buoy(il, k) + buoy(il, k + 1)) * deltap / ph(il, k + 1)
           cina(il) = cina(il) + min(0., dcin)
         END IF
@@ -254 +253 @@
     IF (lswitch(il)) THEN
       deltap = p0(il) - p(il, ineg(il))
-      dcin = rd*buoy(il, ineg(il))*deltap/(p(il,ineg(il))+p0(il))
+      dcin = rd * buoy(il, ineg(il)) * deltap / (p(il, ineg(il)) + p0(il))
       cina(il) = cina(il) + min(0., dcin)
     END IF
@@ -282 +281 @@
   DO k = nl, 1, -1
     DO il = 1, ncum
-      IF (lswitch(il) .AND. k<=icb(il)-1) THEN
-        IF (buoy(il,k)<0.) THEN
+      IF (lswitch(il) .AND. k<=icb(il) - 1) THEN
+        IF (buoy(il, k)<0.) THEN
           ilow(il) = k
         END IF
@@ -295 +294 @@
     IF (lswitch(il)) THEN
       IF (ilow(il)>1) THEN
-        p0(il) = (buoy(il,ilow(il))*p(il,ilow(il)-1)-buoy(il,ilow( &
-          il)-1)*p(il,ilow(il)))/(buoy(il,ilow(il))-buoy(il,ilow(il)-1))
+        p0(il) = (buoy(il, ilow(il)) * p(il, ilow(il) - 1) - buoy(il, ilow(&
+                il) - 1) * p(il, ilow(il))) / (buoy(il, ilow(il)) - buoy(il, ilow(il) - 1))
         buoyz(il) = 0.
       ELSE
@@ -310 +309 @@
   DO il = 1, ncum
     lswitch2(il) = (isublcl(il)==1 .AND. ilow(il)==1) .OR. &
-      (isublcl(il)==ilow(il)-1)
+            (isublcl(il)==ilow(il) - 1)
     lswitch(il) = lswitch1(il) .AND. lswitch2(il)
   END DO
@@ -321 +320 @@
     IF (lswitch(il)) THEN
       deltap = p0(il) - plcl(il)
-      dcin = rd*(buoyz(il)+buoylcl(il))*deltap/(p0(il)+plcl(il))
+      dcin = rd * (buoyz(il) + buoylcl(il)) * deltap / (p0(il) + plcl(il))
       cinb(il) = min(0., dcin)
     END IF
@@ -338 +337 @@
     IF (lswitch(il)) THEN
       deltap = p0(il) - p(il, ilow(il))
-      dcin = rd*(buoyz(il)+buoy(il,ilow(il)))*deltap/(p0(il)+p(il,ilow(il)))
+      dcin = rd * (buoyz(il) + buoy(il, ilow(il))) * deltap / (p0(il) + p(il, ilow(il)))
       cinb(il) = min(0., dcin)
     END IF
@@ -348 +347 @@
   DO k = 1, nl
     DO il = 1, ncum
-      IF (lswitch(il) .AND. k>=ilow(il) .AND. k<=isublcl(il)-1) THEN
-        deltap = p(il, k) - p(il, k+1)
-        dcin = 0.5*rd*(buoy(il,k)+buoy(il,k+1))*deltap/ph(il, k+1)
+      IF (lswitch(il) .AND. k>=ilow(il) .AND. k<=isublcl(il) - 1) THEN
+        deltap = p(il, k) - p(il, k + 1)
+        dcin = 0.5 * rd * (buoy(il, k) + buoy(il, k + 1)) * deltap / ph(il, k + 1)
         cinb(il) = cinb(il) + min(0., dcin)
       END IF
@@ -360 +359 @@
     IF (lswitch(il)) THEN
       deltap = p(il, isublcl(il)) - plcl(il)
-      dcin = rd*(buoy(il,isublcl(il))+buoylcl(il))*deltap/ &
-        (p(il,isublcl(il))+plcl(il))
+      dcin = rd * (buoy(il, isublcl(il)) + buoylcl(il)) * deltap / &
+              (p(il, isublcl(il)) + plcl(il))
       cinb(il) = cinb(il) + min(0., dcin)
     END IF
@@ -373 +372 @@
 
   DO il = 1, ncum
-    lswitch2(il) = plcl(il) > p(il, itop(il)-1)
+    lswitch2(il) = plcl(il) > p(il, itop(il) - 1)
     lswitch(il) = lswitch1(il) .AND. lswitch2(il)
   END DO
@@ -383 +382 @@
   DO il = 1, ncum
     IF (lswitch(il)) THEN
-      plfc(il) = (buoy(il,itop(il))*p(il,itop(il)-1)-buoy(il,itop( &
-        il)-1)*p(il,itop(il)))/(buoy(il,itop(il))-buoy(il,itop(il)-1))
+      plfc(il) = (buoy(il, itop(il)) * p(il, itop(il) - 1) - buoy(il, itop(&
+              il) - 1) * p(il, itop(il))) / (buoy(il, itop(il)) - buoy(il, itop(il) - 1))
     END IF
   END DO
@@ -391 +390 @@
   DO il = 1, ncum
     IF (lswitch(il)) THEN
-      deltap = p(il, itop(il)-1) - plfc(il)
-      dcin = rd*buoy(il, itop(il)-1)*deltap/(p(il,itop(il)-1)+plfc(il))
+      deltap = p(il, itop(il) - 1) - plfc(il)
+      dcin = rd * buoy(il, itop(il) - 1) * deltap / (p(il, itop(il) - 1) + plfc(il))
       cina(il) = min(0., dcin)
     END IF
@@ -400 +399 @@
   DO k = 1, nl
     DO il = 1, ncum
-      IF (lswitch(il) .AND. k>=icb(il)+1 .AND. k<=itop(il)-2) THEN
-        deltap = p(il, k) - p(il, k+1)
-        dcin = 0.5*rd*(buoy(il,k)+buoy(il,k+1))*deltap/ph(il, k+1)
+      IF (lswitch(il) .AND. k>=icb(il) + 1 .AND. k<=itop(il) - 2) THEN
+        deltap = p(il, k) - p(il, k + 1)
+        dcin = 0.5 * rd * (buoy(il, k) + buoy(il, k + 1)) * deltap / ph(il, k + 1)
         cina(il) = cina(il) + min(0., dcin)
       END IF
@@ -411 +410 @@
   DO il = 1, ncum
     IF (lswitch(il)) THEN
-      IF (plcl(il)>p(il,icb(il))) THEN
-        IF (icb(il)<itop(il)-1) THEN
-          deltap = p(il, icb(il)) - p(il, icb(il)+1)
-          dcin = 0.5*rd*(buoy(il,icb(il))+buoy(il,icb(il)+1))*deltap/ &
-            ph(il, icb(il)+1)
+      IF (plcl(il)>p(il, icb(il))) THEN
+        IF (icb(il)<itop(il) - 1) THEN
+          deltap = p(il, icb(il)) - p(il, icb(il) + 1)
+          dcin = 0.5 * rd * (buoy(il, icb(il)) + buoy(il, icb(il) + 1)) * deltap / &
+                  ph(il, icb(il) + 1)
           cina(il) = cina(il) + min(0., dcin)
         END IF
 
         deltap = plcl(il) - p(il, icb(il))
-        dcin = rd*(buoylcl(il)+buoy(il,icb(il)))*deltap/ &
-          (plcl(il)+p(il,icb(il)))
+        dcin = rd * (buoylcl(il) + buoy(il, icb(il))) * deltap / &
+                (plcl(il) + p(il, icb(il)))
         cina(il) = cina(il) + min(0., dcin)
       ELSE
-        deltap = plcl(il) - p(il, icb(il)+1)
-        dcin = rd*(buoylcl(il)+buoy(il,icb(il)+1))*deltap/ &
-          (plcl(il)+p(il,icb(il)+1))
+        deltap = plcl(il) - p(il, icb(il) + 1)
+        dcin = rd * (buoylcl(il) + buoy(il, icb(il) + 1)) * deltap / &
+                (plcl(il) + p(il, icb(il) + 1))
         cina(il) = cina(il) + min(0., dcin)
       END IF
@@ -442 +441 @@
   DO il = 1, ncum
     IF (lswitch(il)) THEN
-      plfc(il) = (buoy(il,itop(il))*plcl(il)-buoylcl(il)*p(il,itop(il)))/ &
-        (buoy(il,itop(il))-buoylcl(il))
+      plfc(il) = (buoy(il, itop(il)) * plcl(il) - buoylcl(il) * p(il, itop(il))) / &
+              (buoy(il, itop(il)) - buoylcl(il))
     END IF
   END DO
@@ -450 +449 @@
     IF (lswitch(il)) THEN
       deltap = plcl(il) - plfc(il)
-      dcin = rd*buoylcl(il)*deltap/(plcl(il)+plfc(il))
+      dcin = rd * buoylcl(il) * deltap / (plcl(il) + plfc(il))
       cina(il) = min(0., dcin)
     END IF
@@ -456 +455 @@
   ! c      ENDIF
 
-
-
-
 END SUBROUTINE cv3_cine

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_crit.F90

@@ -9 +9 @@
   ! modified by :                                               *
   ! **************************************************************
+  USE lmdz_cv3param
 
   IMPLICIT NONE
-
-  include "cv3param.h"
 
   ! input:

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_enthalpmix.F90

@@ -10 +10 @@
   ! modified by :  Filiberti M-A 06/2005 vectorisation          *
   ! **************************************************************
-
+USE lmdz_cvthermo
   IMPLICIT NONE
   ! ==============================================================
@@ -22 +22 @@
   ! ===============================================================
 
-  include "cvthermo.h"
   include "YOETHF.h"
   include "YOMCST.h"

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_estatmix.F90

@@ -11 +11 @@
   ! modified by :  Filiberti M-A 06/2005 vectorisation              *
   ! ****************************************************************
-
+USE lmdz_cvthermo
   IMPLICIT NONE
   ! ==============================================================
@@ -23 +23 @@
   ! ===============================================================
 
-  include "cvthermo.h"
   include "YOETHF.h"
   include "YOMCST.h"

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_mixscale.F90

@@ -9 +9 @@
   ! **************************************************************
 
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
 !inputs:

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90

@@ -1 @@
-
 ! $Id$
 
@@ -11 +10 @@
   USE lmdz_conema3
   USE lmdz_cvflag
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-!------------------------------------------------------------
-!Set parameters for convectL for iflag_con = 3
-!------------------------------------------------------------
-
-
-!***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
-!***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
-!***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***
-!***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
-!***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-!***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***
-!***                        OF CLOUD                         ***
-
-![TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
-!***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
-!***                 APPROACH TO QUASI-EQUILIBRIUM           ***
-!***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
-!***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
-
-!***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
-!***                 APPROACH TO QUASI-EQUILIBRIUM           ***
-!***                     IT MUST BE LESS THAN 0              ***
-
-  include "cv3param.h"
-
-  INTEGER, INTENT(IN)              :: nd
-  INTEGER, INTENT(IN)              :: k_upper
-  REAL, INTENT(IN)                 :: delt ! timestep (seconds)
-
-! Local variables
-  CHARACTER (LEN=20) :: modname = 'cv3_param'
-  CHARACTER (LEN=80) :: abort_message
+  !------------------------------------------------------------
+  !Set parameters for convectL for iflag_con = 3
+  !------------------------------------------------------------
+
+
+  !***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
+  !***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
+  !***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***
+  !***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
+  !***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
+  !***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***
+  !***                        OF CLOUD                         ***
+
+  ![TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
+  !***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
+  !***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+  !***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
+  !***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
+
+  !***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
+  !***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+  !***                     IT MUST BE LESS THAN 0              ***
+
+  INTEGER, INTENT(IN) :: nd
+  INTEGER, INTENT(IN) :: k_upper
+  REAL, INTENT(IN) :: delt ! timestep (seconds)
+
+  ! Local variables
+  CHARACTER (LEN = 20) :: modname = 'cv3_param'
+  CHARACTER (LEN = 80) :: abort_message
 
   LOGICAL, SAVE :: first = .TRUE.
-!$OMP THREADPRIVATE(first)
-
-!glb  noff: integer limit for convection (nd-noff)
-! minorig: First level of convection
-
-! -- limit levels for convection:
-
-!jyg<
-!  noff is chosen such that nl = k_upper so that upmost loops end at about 22 km
-
-  noff = min(max(nd-k_upper, 1), (nd+1)/2)
-!!  noff = 1
-!>jyg
+  !$OMP THREADPRIVATE(first)
+
+  !glb  noff: integer limit for convection (nd-noff)
+  ! minorig: First level of convection
+
+  ! -- limit levels for convection:
+
+  !jyg<
+  !  noff is chosen such that nl = k_upper so that upmost loops end at about 22 km
+
+  noff = min(max(nd - k_upper, 1), (nd + 1) / 2)
+  !!  noff = 1
+  !>jyg
   minorig = 1
   nl = nd - noff
@@ -67 +65 @@
 
   IF (first) THEN
-! -- "microphysical" parameters:
-! IM beg: ajout fis. reglage ep
-! CR+JYG: shedding coefficient (used when iflag_mix_adiab=1)
-! IM lu dans physiq.def via conf_phys.F90     epmax  = 0.993
+    ! -- "microphysical" parameters:
+    ! IM beg: ajout fis. reglage ep
+    ! CR+JYG: shedding coefficient (used when iflag_mix_adiab=1)
+    ! IM lu dans physiq.def via conf_phys.F90     epmax  = 0.993
 
     omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
-! -- misc:
+    ! -- misc:
     dtovsh = -0.2 ! dT for overshoot
-! cc      dttrig = 5.   ! (loose) condition for triggering
+    ! cc      dttrig = 5.   ! (loose) condition for triggering
     dttrig = 10. ! (loose) condition for triggering
     dtcrit = -2.0
-! -- end of convection
-! -- interface cloud parameterization:
+    ! -- end of convection
+    ! -- interface cloud parameterization:
     delta = 0.01 ! cld
-! -- interface with boundary-layer (gust factor): (sb)
+    ! -- interface with boundary-layer (gust factor): (sb)
     betad = 10.0 ! original value (from convect 4.3)
 
-! Var interm pour le getin
-     cv_flag_feed=1
-     CALL getin_p('cv_flag_feed',cv_flag_feed)
-     T_top_max = 1000.
-     CALL getin_p('t_top_max',T_top_max)
-     dpbase=-40.
-     CALL getin_p('dpbase',dpbase)
-     pbcrit=150.0
-     CALL getin_p('pbcrit',pbcrit)
-     ptcrit=500.0
-     CALL getin_p('ptcrit',ptcrit)
-     sigdz=0.01
-     CALL getin_p('sigdz',sigdz)
-     spfac=0.15
-     CALL getin_p('spfac',spfac)
-     tau=8000.
-     CALL getin_p('tau',tau)
-     flag_wb=1
-     CALL getin_p('flag_wb',flag_wb)
-     wbmax=6.
-     CALL getin_p('wbmax',wbmax)
-     ok_convstop=.False.
-     CALL getin_p('ok_convstop ',ok_convstop)
-     tau_stop=15000.
-     CALL getin_p('tau_stop ',tau_stop)
-     ok_intermittent=.False.
-     CALL getin_p('ok_intermittent',ok_intermittent)
-     ok_optim_yield=.False.
-     CALL getin_p('ok_optim_yield',ok_optim_yield)
-     ok_homo_tend=.TRUE.
-     CALL getin_p('ok_homo_tend',ok_homo_tend)
-     ok_entrain=.TRUE.
-     CALL getin_p('ok_entrain',ok_entrain)
-
-     coef_peel=0.25
-     CALL getin_p('coef_peel',coef_peel)
-
-     flag_epKEorig=1
-     CALL getin_p('flag_epKEorig',flag_epKEorig)
-     elcrit=0.0003
-     CALL getin_p('elcrit',elcrit)
-     tlcrit=-55.0
-     CALL getin_p('tlcrit',tlcrit)
-     ejectliq=0.
-     CALL getin_p('ejectliq',ejectliq)
-     ejectice=0.
-     CALL getin_p('ejectice',ejectice)
-     cvflag_prec_eject = .FALSE.
-     CALL getin_p('cvflag_prec_eject',cvflag_prec_eject)
-     qsat_depends_on_qt = .FALSE.
-     CALL getin_p('qsat_depends_on_qt',qsat_depends_on_qt)
-     adiab_ascent_mass_flux_depends_on_ejectliq = .FALSE.
-     CALL getin_p('adiab_ascent_mass_flux_depends_on_ejectliq',adiab_ascent_mass_flux_depends_on_ejectliq)
-     keepbug_ice_frac = .TRUE.
-     CALL getin_p('keepbug_ice_frac', keepbug_ice_frac)
+    ! Var interm pour le getin
+    cv_flag_feed = 1
+    CALL getin_p('cv_flag_feed', cv_flag_feed)
+    T_top_max = 1000.
+    CALL getin_p('t_top_max', T_top_max)
+    dpbase = -40.
+    CALL getin_p('dpbase', dpbase)
+    pbcrit = 150.0
+    CALL getin_p('pbcrit', pbcrit)
+    ptcrit = 500.0
+    CALL getin_p('ptcrit', ptcrit)
+    sigdz = 0.01
+    CALL getin_p('sigdz', sigdz)
+    spfac = 0.15
+    CALL getin_p('spfac', spfac)
+    tau = 8000.
+    CALL getin_p('tau', tau)
+    flag_wb = 1
+    CALL getin_p('flag_wb', flag_wb)
+    wbmax = 6.
+    CALL getin_p('wbmax', wbmax)
+    ok_convstop = .False.
+    CALL getin_p('ok_convstop ', ok_convstop)
+    tau_stop = 15000.
+    CALL getin_p('tau_stop ', tau_stop)
+    ok_intermittent = .False.
+    CALL getin_p('ok_intermittent', ok_intermittent)
+    ok_optim_yield = .False.
+    CALL getin_p('ok_optim_yield', ok_optim_yield)
+    ok_homo_tend = .TRUE.
+    CALL getin_p('ok_homo_tend', ok_homo_tend)
+    ok_entrain = .TRUE.
+    CALL getin_p('ok_entrain', ok_entrain)
+
+    coef_peel = 0.25
+    CALL getin_p('coef_peel', coef_peel)
+
+    flag_epKEorig = 1
+    CALL getin_p('flag_epKEorig', flag_epKEorig)
+    elcrit = 0.0003
+    CALL getin_p('elcrit', elcrit)
+    tlcrit = -55.0
+    CALL getin_p('tlcrit', tlcrit)
+    ejectliq = 0.
+    CALL getin_p('ejectliq', ejectliq)
+    ejectice = 0.
+    CALL getin_p('ejectice', ejectice)
+    cvflag_prec_eject = .FALSE.
+    CALL getin_p('cvflag_prec_eject', cvflag_prec_eject)
+    qsat_depends_on_qt = .FALSE.
+    CALL getin_p('qsat_depends_on_qt', qsat_depends_on_qt)
+    adiab_ascent_mass_flux_depends_on_ejectliq = .FALSE.
+    CALL getin_p('adiab_ascent_mass_flux_depends_on_ejectliq', adiab_ascent_mass_flux_depends_on_ejectliq)
+    keepbug_ice_frac = .TRUE.
+    CALL getin_p('keepbug_ice_frac', keepbug_ice_frac)
 
     WRITE (*, *) 't_top_max=', t_top_max
@@ -160 +158 @@
     WRITE (*, *) 'ejectliq=', ejectliq
     WRITE (*, *) 'ejectice=', ejectice
-    WRITE (*, *) 'cvflag_prec_eject =', cvflag_prec_eject 
-    WRITE (*, *) 'qsat_depends_on_qt =', qsat_depends_on_qt 
+    WRITE (*, *) 'cvflag_prec_eject =', cvflag_prec_eject
+    WRITE (*, *) 'qsat_depends_on_qt =', qsat_depends_on_qt
     WRITE (*, *) 'adiab_ascent_mass_flux_depends_on_ejectliq =', adiab_ascent_mass_flux_depends_on_ejectliq
-    WRITE (*, *) 'keepbug_ice_frac =', keepbug_ice_frac 
+    WRITE (*, *) 'keepbug_ice_frac =', keepbug_ice_frac
 
     first = .FALSE.
   END IF ! (first)
 
-  beta = 1.0 - delt/tau
+  beta = 1.0 - delt / tau
   alpha1 = 1.5E-3
-!JYG    Correction bug alpha
-  alpha1 = alpha1*1.5
-  alpha = alpha1*delt/tau
-!JYG    Bug
-! cc increase alpha to compensate W decrease:
-! c      alpha  = alpha*1.5
-
-  noconv_stop = max(2.,tau_stop/delt)
-
+  !JYG    Correction bug alpha
+  alpha1 = alpha1 * 1.5
+  alpha = alpha1 * delt / tau
+  !JYG    Bug
+  ! cc increase alpha to compensate W decrease:
+  ! c      alpha  = alpha*1.5
+
+  noconv_stop = max(2., tau_stop / delt)
 
 END SUBROUTINE cv3_param
@@ -184 +181 @@
 SUBROUTINE cv3_incrcount(len, nd, delt, sig)
   USE lmdz_cvflag
-
-IMPLICIT NONE
-
-! =====================================================================
-!  Increment the counter sig(nd)
-! =====================================================================
-
-  include "cv3param.h"
-
-!inputs:
-  INTEGER, INTENT(IN)                     :: len
-  INTEGER, INTENT(IN)                     :: nd
-  REAL, INTENT(IN)                        :: delt ! timestep (seconds)
-
-!input/output
-  REAL, DIMENSION(len,nd), INTENT(INOUT)  :: sig
-
-!local variables
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
+  IMPLICIT NONE
+
+  ! =====================================================================
+  !  Increment the counter sig(nd)
+  ! =====================================================================
+
+  !inputs:
+  INTEGER, INTENT(IN) :: len
+  INTEGER, INTENT(IN) :: nd
+  REAL, INTENT(IN) :: delt ! timestep (seconds)
+
+  !input/output
+  REAL, DIMENSION(len, nd), INTENT(INOUT) :: sig
+
+  !local variables
   INTEGER il
 
-!    print *,'cv3_incrcount : noconv_stop ',noconv_stop
-!    print *,'cv3_incrcount in, sig(1,nd) ',sig(1,nd)
-    IF(ok_convstop) THEN
-      DO il = 1, len
-        sig(il, nd) = sig(il, nd) + 1.
-        sig(il, nd) = min(sig(il,nd), noconv_stop+0.1)
-      END DO
-    ELSE
-      DO il = 1, len
-        sig(il, nd) = sig(il, nd) + 1.
-        sig(il, nd) = min(sig(il,nd), 12.1)
-      END DO
-    ENDIF  ! (ok_convstop)
-!    print *,'cv3_incrcount out, sig(1,nd) ',sig(1,nd)
-
+  !    print *,'cv3_incrcount : noconv_stop ',noconv_stop
+  !    print *,'cv3_incrcount in, sig(1,nd) ',sig(1,nd)
+  IF(ok_convstop) THEN
+    DO il = 1, len
+      sig(il, nd) = sig(il, nd) + 1.
+      sig(il, nd) = min(sig(il, nd), noconv_stop + 0.1)
+    END DO
+  ELSE
+    DO il = 1, len
+      sig(il, nd) = sig(il, nd) + 1.
+      sig(il, nd) = min(sig(il, nd), 12.1)
+    END DO
+  ENDIF  ! (ok_convstop)
+  !    print *,'cv3_incrcount out, sig(1,nd) ',sig(1,nd)
 
 END SUBROUTINE cv3_incrcount
 
-SUBROUTINE cv3_prelim(len, nd, ndp1, t, q, p, ph, &
-                      lv, lf, cpn, tv, gz, h, hm, th)
+SUBROUTINE cv3_prelim(len, nd, ndp1, t, q, p, ph, lv, lf, cpn, tv, gz, h, hm, th)
+  USE lmdz_cv3param
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-! =====================================================================
-! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
-! "ori": from convect4.3 (vectorized)
-! "convect3": to be exactly consistent with convect3
-! =====================================================================
-
-! inputs:
+  ! =====================================================================
+  ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+  ! "ori": from convect4.3 (vectorized)
+  ! "convect3": to be exactly consistent with convect3
+  ! =====================================================================
+
+  ! inputs:
   INTEGER len, nd, ndp1
   REAL t(len, nd), q(len, nd), p(len, nd), ph(len, ndp1)
 
-! outputs:
+  ! outputs:
   REAL lv(len, nd), lf(len, nd), cpn(len, nd), tv(len, nd)
   REAL gz(len, nd), h(len, nd), hm(len, nd)
   REAL th(len, nd)
 
-! local variables:
+  ! local variables:
   INTEGER k, i
   REAL rdcp
@@ -247 +245 @@
   REAL cpx(len, nd)
 
-  include "cvthermo.h"
-  include "cv3param.h"
-
-
-! ori      do 110 k=1,nlp
-! abderr     do 110 k=1,nl ! convect3
+  ! ori      do 110 k=1,nlp
+  ! abderr     do 110 k=1,nl ! convect3
   DO k = 1, nlp
 
     DO i = 1, len
-! debug          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
-      lv(i, k) = lv0 - clmcpv*(t(i,k)-273.15)
-!!      lf(i, k) = lf0 - clmci*(t(i,k)-273.15)   ! erreur de signe !!
-      lf(i, k) = lf0 + clmci*(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)
-! 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
-    END DO
-  END DO
-
-! gz = phi at the full levels (same as p).
-
-!!  DO i = 1, len                    !jyg
-!!    gz(i, 1) = 0.0                 !jyg
-!!  END DO                           !jyg
-    gz(:,:) = 0.                     !jyg: initialization of the whole array
-! ori      do 140 k=2,nlp
+      ! debug          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
+      lv(i, k) = lv0 - clmcpv * (t(i, k) - 273.15)
+      !!      lf(i, k) = lf0 - clmci*(t(i,k)-273.15)   ! erreur de signe !!
+      lf(i, k) = lf0 + clmci * (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)
+      ! 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
+    END DO
+  END DO
+
+  ! gz = phi at the full levels (same as p).
+
+  !!  DO i = 1, len                    !jyg
+  !!    gz(i, 1) = 0.0                 !jyg
+  !!  END DO                           !jyg
+  gz(:, :) = 0.                     !jyg: initialization of the whole array
+  ! ori      do 140 k=2,nlp
   DO k = 2, nl ! convect3
     DO 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        print *,' gz(',k,')',gz(i,k),' tvx',tvx,' tvy ',tvy
-
-! ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
-! ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
-    END DO
-  END DO
-
-! h  = phi + cpT (dry static energy).
-! hm = phi + cp(T-Tbase)+Lq
-
-! ori      do 170 k=1,nlp
+      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        print *,' gz(',k,')',gz(i,k),' tvx',tvx,' tvy ',tvy
+
+      ! ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
+      ! ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
+    END DO
+  END DO
+
+  ! h  = phi + cpT (dry static energy).
+  ! hm = phi + cp(T-Tbase)+Lq
+
+  ! ori      do 170 k=1,nlp
   DO k = 1, nl ! convect3
     DO 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)
-    END DO
-  END DO
-
+      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)
+    END DO
+  END DO
 
 END SUBROUTINE cv3_prelim
 
 SUBROUTINE cv3_feed(len, nd, ok_conserv_q, &
-                    t, q, u, v, p, ph, h, gz, &
-                    p1feed, p2feed, wght, &
-                    wghti, tnk, thnk, qnk, qsnk, unk, vnk, &
-                    cpnk, hnk, nk, icb, icbmax, iflag, gznk, plcl)
+        t, q, u, v, p, ph, h, gz, &
+        p1feed, p2feed, wght, &
+        wghti, tnk, thnk, qnk, qsnk, unk, vnk, &
+        cpnk, hnk, nk, icb, icbmax, iflag, gznk, plcl)
 
   USE lmdz_phys_transfert_para, ONLY: bcast
   USE add_phys_tend_mod, ONLY: fl_cor_ebil
   USE lmdz_print_control, ONLY: prt_level
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
-! ================================================================
-! Purpose: CONVECTIVE FEED
-
-! Main differences with cv_feed:
-! - ph added in input
-! - 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:
-! - we do not compute dplcldt and dplcldr of CLIFT anymore
-! - values iflag different (but tests identical)
-! - A,B explicitely defined (!...)
-! ================================================================
-
-  include "cv3param.h"
-  include "cvthermo.h"
-
-!inputs:
-  INTEGER, INTENT (IN)                               :: len, nd
-  LOGICAL, INTENT (IN)                               :: ok_conserv_q
-  REAL, DIMENSION (len, nd), INTENT (IN)             :: t, q, p
-  REAL, DIMENSION (len, nd), INTENT (IN)             :: u, v
-  REAL, DIMENSION (len, nd), INTENT (IN)             :: h, gz
-  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph
-  REAL, DIMENSION (len), INTENT (IN)                 :: p1feed
-  REAL, DIMENSION (nd), INTENT (IN)                  :: wght
-!input-output
-  REAL, DIMENSION (len), INTENT (INOUT)              :: p2feed
-!outputs:
-  INTEGER, INTENT (OUT)                              :: icbmax
-  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag, nk, icb
-  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti
-  REAL, DIMENSION (len), INTENT (OUT)                :: tnk, thnk, qnk, qsnk
-  REAL, DIMENSION (len), INTENT (OUT)                :: unk, vnk
-  REAL, DIMENSION (len), INTENT (OUT)                :: cpnk, hnk, gznk
-  REAL, DIMENSION (len), INTENT (OUT)                :: plcl
-
-!local variables:
+  ! ================================================================
+  ! Purpose: CONVECTIVE FEED
+
+  ! Main differences with cv_feed:
+  ! - ph added in input
+  ! - 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:
+  ! - we do not compute dplcldt and dplcldr of CLIFT anymore
+  ! - values iflag different (but tests identical)
+  ! - A,B explicitely defined (!...)
+  ! ================================================================
+
+  !inputs:
+  INTEGER, INTENT (IN) :: len, nd
+  LOGICAL, INTENT (IN) :: ok_conserv_q
+  REAL, DIMENSION (len, nd), INTENT (IN) :: t, q, p
+  REAL, DIMENSION (len, nd), INTENT (IN) :: u, v
+  REAL, DIMENSION (len, nd), INTENT (IN) :: h, gz
+  REAL, DIMENSION (len, nd + 1), INTENT (IN) :: ph
+  REAL, DIMENSION (len), INTENT (IN) :: p1feed
+  REAL, DIMENSION (nd), INTENT (IN) :: wght
+  !input-output
+  REAL, DIMENSION (len), INTENT (INOUT) :: p2feed
+  !outputs:
+  INTEGER, INTENT (OUT) :: icbmax
+  INTEGER, DIMENSION (len), INTENT (OUT) :: iflag, nk, icb
+  REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti
+  REAL, DIMENSION (len), INTENT (OUT) :: tnk, thnk, qnk, qsnk
+  REAL, DIMENSION (len), INTENT (OUT) :: unk, vnk
+  REAL, DIMENSION (len), INTENT (OUT) :: cpnk, hnk, gznk
+  REAL, DIMENSION (len), INTENT (OUT) :: plcl
+
+  !local variables:
   INTEGER i, k, iter, niter
   INTEGER ihmin(len)
@@ -363 +356 @@
   LOGICAL nocond(len)
 
-!jyg20140217<
+  !jyg20140217<
   INTEGER iostat
   LOGICAL, SAVE :: first
   LOGICAL, SAVE :: ok_new_feed
   REAL, SAVE :: dp_lcl_feed
-!$OMP THREADPRIVATE (first,ok_new_feed,dp_lcl_feed)
+  !$OMP THREADPRIVATE (first,ok_new_feed,dp_lcl_feed)
   DATA first/.TRUE./
   DATA dp_lcl_feed/2./
 
   IF (first) THEN
-!$OMP MASTER
+    !$OMP MASTER
     ok_new_feed = ok_conserv_q
-    OPEN (98, FILE='cv3feed_param.data', STATUS='old', FORM='formatted', IOSTAT=iostat)
+    OPEN (98, FILE = 'cv3feed_param.data', STATUS = 'old', FORM = 'formatted', IOSTAT = iostat)
     IF (iostat==0) THEN
-      READ (98, *, END=998) ok_new_feed
-998   CONTINUE
+      READ (98, *, END = 998) ok_new_feed
+      998   CONTINUE
       CLOSE (98)
     END IF
     PRINT *, ' ok_new_feed: ', ok_new_feed
-!$OMP END MASTER
+    !$OMP END MASTER
     CALL bcast(ok_new_feed)
-    first = .FALSE.   
+    first = .FALSE.
   END IF
-!jyg>
-! -------------------------------------------------------------------
-! --- Origin level of ascending parcels for convect3:
-! -------------------------------------------------------------------
+  !jyg>
+  ! -------------------------------------------------------------------
+  ! --- Origin level of ascending parcels for convect3:
+  ! -------------------------------------------------------------------
 
   DO i = 1, len
@@ -396 +389 @@
   END DO
 
-! -------------------------------------------------------------------
-! --- Adjust feeding layer thickness so that lifting up to the top of
-! --- the feeding layer does not induce condensation (i.e. so that
-! --- plcl < p2feed).
-! --- Method : iterative secant method.
-! -------------------------------------------------------------------
-
-! 1- First bracketing of the solution : ph(nk+1), p2feed
-
-! 1.a- LCL associated with p2feed
+  ! -------------------------------------------------------------------
+  ! --- Adjust feeding layer thickness so that lifting up to the top of
+  ! --- the feeding layer does not induce condensation (i.e. so that
+  ! --- plcl < p2feed).
+  ! --- Method : iterative secant method.
+  ! -------------------------------------------------------------------
+
+  ! 1- First bracketing of the solution : ph(nk+1), p2feed
+
+  ! 1.a- LCL associated with p2feed
   DO i = 1, len
     pup(i) = p2feed(i)
   END DO
-  IF (fl_cor_ebil >=2 ) THEN
+  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)
+            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)
+            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
-  IF (fl_cor_ebil >=2 ) THEN
+    plo(i) = ph(i, nk(i) + 1)
+  END DO
+  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)
+            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
+            t, q, u, v, wght, &
+            wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  ENDIF  ! (fl_cor_ebil >=2 )
+  ! 2- Iterations
   niter = 5
   DO iter = 1, niter
@@ -443 +436 @@
         pfeed(i) = pup(i)
       ELSE
-!JYG20140217<
+        !JYG20140217<
         IF (ok_new_feed) THEN
-          pfeed(i) = (pup(i)*(plo(i)-plcllo(i)-dp_lcl_feed)+  &
-                      plo(i)*(plclup(i)-pup(i)+dp_lcl_feed))/ &
-                     (plo(i)-plcllo(i)+plclup(i)-pup(i))
+          pfeed(i) = (pup(i) * (plo(i) - plcllo(i) - dp_lcl_feed) + &
+                  plo(i) * (plclup(i) - pup(i) + dp_lcl_feed)) / &
+                  (plo(i) - plcllo(i) + plclup(i) - pup(i))
         ELSE
-          pfeed(i) = (pup(i)*(plo(i)-plcllo(i))+  &
-                      plo(i)*(plclup(i)-pup(i)))/ &
-                     (plo(i)-plcllo(i)+plclup(i)-pup(i))
+          pfeed(i) = (pup(i) * (plo(i) - plcllo(i)) + &
+                  plo(i) * (plclup(i) - pup(i))) / &
+                  (plo(i) - plcllo(i) + plclup(i) - pup(i))
         END IF
-!JYG>
+        !JYG>
       END IF
     END DO
-!jyg20140217<
-! For the last iteration, make sure that the top of the feeding layer
-! and LCL are not in the same layer:
+    !jyg20140217<
+    ! For the last iteration, make sure that the top of the feeding layer
+    ! and LCL are not in the same layer:
     IF (ok_new_feed) THEN
       IF (iter==niter) THEN
-        DO i = 1,len                         !jyg
-          pfeedmin(i) = ph(i,minorig+1)      !jyg
+        DO i = 1, len                         !jyg
+          pfeedmin(i) = ph(i, minorig + 1)      !jyg
         ENDDO                                !jyg
-        DO k = minorig+1, nl                 !jyg
-!!        DO k = minorig, nl                 !jyg
+        DO k = minorig + 1, nl                 !jyg
+          !!        DO k = minorig, nl                 !jyg
           DO i = 1, len
-            IF (ph(i,k)>=plclfeed(i)) pfeedmin(i) = ph(i, k)
+            IF (ph(i, k)>=plclfeed(i)) pfeedmin(i) = ph(i, k)
           END DO
         END DO
@@ -475 +468 @@
       END IF
     END IF
-!jyg>
-
-    IF (fl_cor_ebil >=2 ) THEN
+    !jyg>
+
+    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)
+              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<
+              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
       DO i = 1, len
-        posit(i) = (sign(1.,plclfeed(i)-pfeed(i)+dp_lcl_feed)+1.)*0.5
-        IF (plclfeed(i)-pfeed(i)+dp_lcl_feed==0.) posit(i) = 1.
+        posit(i) = (sign(1., plclfeed(i) - pfeed(i) + dp_lcl_feed) + 1.) * 0.5
+        IF (plclfeed(i) - pfeed(i) + dp_lcl_feed==0.) posit(i) = 1.
       END DO
     ELSE
       DO i = 1, len
-        posit(i) = (sign(1.,plclfeed(i)-pfeed(i))+1.)*0.5
+        posit(i) = (sign(1., plclfeed(i) - pfeed(i)) + 1.) * 0.5
         IF (plclfeed(i)==pfeed(i)) posit(i) = 1.
       END DO
     END IF
-!jyg>
+    !jyg>
     DO i = 1, len
-! - posit = 1 when lcl is below top of feeding layer (plclfeed>pfeed)
-! -               => pup=pfeed
-! - posit = 0 when lcl is above top of feeding layer (plclfeed<pfeed)
-! -               => plo=pfeed
-      pup(i) = posit(i)*pfeed(i) + (1.-posit(i))*pup(i)
-      plo(i) = (1.-posit(i))*pfeed(i) + posit(i)*plo(i)
-      plclup(i) = posit(i)*plclfeed(i) + (1.-posit(i))*plclup(i)
-      plcllo(i) = (1.-posit(i))*plclfeed(i) + posit(i)*plcllo(i)
+      ! - posit = 1 when lcl is below top of feeding layer (plclfeed>pfeed)
+      ! -               => pup=pfeed
+      ! - posit = 0 when lcl is above top of feeding layer (plclfeed<pfeed)
+      ! -               => plo=pfeed
+      pup(i) = posit(i) * pfeed(i) + (1. - posit(i)) * pup(i)
+      plo(i) = (1. - posit(i)) * pfeed(i) + posit(i) * plo(i)
+      plclup(i) = posit(i) * plclfeed(i) + (1. - posit(i)) * plclup(i)
+      plcllo(i) = (1. - posit(i)) * plclfeed(i) + posit(i) * plcllo(i)
     END DO
   END DO !  iter
@@ -517 +510 @@
 
   DO i = 1, len
-    cpnk(i) = cpd*(1.0-qnk(i)) + cpv*qnk(i)
-    hnk(i) = gz(i, 1) + cpnk(i)*tnk(i)
-  END DO
-
-! -------------------------------------------------------------------
-! --- Check whether parcel level temperature and specific humidity
-! --- are reasonable
-! -------------------------------------------------------------------
+    cpnk(i) = cpd * (1.0 - qnk(i)) + cpv * qnk(i)
+    hnk(i) = gz(i, 1) + cpnk(i) * tnk(i)
+  END DO
+
+  ! -------------------------------------------------------------------
+  ! --- Check whether parcel level temperature and specific humidity
+  ! --- are reasonable
+  ! -------------------------------------------------------------------
   IF (cv_flag_feed == 1) THEN
     DO i = 1, len
       IF (((tnk(i)<250.0)                       .OR.  &
-           (qnk(i)<=0.0))                       .AND. &
-          (iflag(i)==0)) iflag(i) = 7
+              (qnk(i)<=0.0))                       .AND. &
+              (iflag(i)==0)) iflag(i) = 7
     END DO
   ELSEIF (cv_flag_feed >= 2) THEN
-! --- and demand that LCL be high enough
+    ! --- and demand that LCL be high enough
     DO i = 1, len
       IF (((tnk(i)<250.0)                       .OR.  &
-           (qnk(i)<=0.0)                        .OR.  &
-           (plcl(i)>min(0.99*ph(i,1),ph(i,3)))) .AND. &
-          (iflag(i)==0)) iflag(i) = 7
+              (qnk(i)<=0.0)                        .OR.  &
+              (plcl(i)>min(0.99 * ph(i, 1), ph(i, 3)))) .AND. &
+              (iflag(i)==0)) iflag(i) = 7
     END DO
   ENDIF
   IF (prt_level >= 10) THEN
-    print *,'cv3_feed : iflag(1), pfeed(1), plcl(1), wghti(1,k) ', &
-                        iflag(1), pfeed(1), plcl(1), (wghti(1,k),k=1,10)
+    print *, 'cv3_feed : iflag(1), pfeed(1), plcl(1), wghti(1,k) ', &
+            iflag(1), pfeed(1), plcl(1), (wghti(1, k), k = 1, 10)
   ENDIF
 
-! -------------------------------------------------------------------
-! --- 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
+  ! -------------------------------------------------------------------
+  ! --- 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
 
   DO i = 1, len
@@ -568 +561 @@
   END DO
 
-! la modification consiste a comparer plcl a ph et non a p:
-! icb est defini par :  ph(icb)<plcl<ph(icb-1)
-!@      do 290 k=minorig,nl
+  ! la modification consiste a comparer plcl a ph et non a p:
+  ! icb est defini par :  ph(icb)<plcl<ph(icb-1)
+  !@      do 290 k=minorig,nl
   DO k = 3, nl - 1 ! modif pour que icb soit sup/egal a 2
     DO i = 1, len
-      IF (ph(i,k)<plcl(i)) icb(i) = min(icb(i), k)
-    END DO
-  END DO
-
-
-! PRINT*,'icb dans cv3_feed '
-! WRITE(*,'(64i2)') icb(2:len-1)
-! CALL dump2d(64,43,'plcl dans cv3_feed ',plcl(2:len-1))
+      IF (ph(i, k)<plcl(i)) icb(i) = min(icb(i), k)
+    END DO
+  END DO
+
+
+  ! PRINT*,'icb dans cv3_feed '
+  ! WRITE(*,'(64i2)') icb(2:len-1)
+  ! CALL dump2d(64,43,'plcl dans cv3_feed ',plcl(2:len-1))
 
   DO i = 1, len
-!@        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
+    !@        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
     IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
   END DO
@@ -591 +584 @@
   END DO
 
-! Compute icbmax.
+  ! Compute icbmax.
 
   icbmax = 2
   DO i = 1, len
-!!        icbmax=max(icbmax,icb(i))
+    !!        icbmax=max(icbmax,icb(i))
     IF (iflag(i)<7) icbmax = max(icbmax, icb(i))     ! sb Jun7th02
   END DO
 
-
 END SUBROUTINE cv3_feed
 
 SUBROUTINE cv3_undilute1(len, nd, t, qs, gz, plcl, p, icb, tnk, qnk, gznk, &
-                         tp, tvp, clw, icbs)
+        tp, tvp, clw, icbs)
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
   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 "cv3param.h"
-
-! inputs:
-  INTEGER, INTENT (IN)                              :: len, nd
-  INTEGER, DIMENSION (len), INTENT (IN)             :: icb
-  REAL, DIMENSION (len, nd), INTENT (IN)            :: t, qs, gz
-  REAL, DIMENSION (len), INTENT (IN)                :: tnk, qnk, gznk
-  REAL, DIMENSION (len, nd), INTENT (IN)            :: p
-  REAL, DIMENSION (len), INTENT (IN)                :: plcl              ! convect3
-
-! outputs:
-  INTEGER, DIMENSION (len), INTENT (OUT)            :: icbs
-  REAL, DIMENSION (len, nd), INTENT (OUT)           :: tp, tvp, clw
-
-! local variables:
+  ! ----------------------------------------------------------------
+  ! 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)
+  ! ----------------------------------------------------------------
+
+  ! inputs:
+  INTEGER, INTENT (IN) :: len, nd
+  INTEGER, DIMENSION (len), INTENT (IN) :: icb
+  REAL, DIMENSION (len, nd), INTENT (IN) :: t, qs, gz
+  REAL, DIMENSION (len), INTENT (IN) :: tnk, qnk, gznk
+  REAL, DIMENSION (len, nd), INTENT (IN) :: p
+  REAL, DIMENSION (len), INTENT (IN) :: plcl              ! convect3
+
+  ! outputs:
+  INTEGER, DIMENSION (len), INTENT (OUT) :: icbs
+  REAL, DIMENSION (len, nd), INTENT (OUT) :: tp, tvp, clw
+
+  ! local variables:
   INTEGER i, k
   INTEGER icb1(len), icbsmax2                                            ! convect3
@@ -643 +635 @@
   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.
-! -------------------------------------------------------------------
-
-
-! ***  Calculate certain parcel quantities, including static energy   ***
+  ! -------------------------------------------------------------------
+  ! --- 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.
+  ! -------------------------------------------------------------------
+
+
+  ! ***  Calculate certain parcel quantities, including static energy   ***
 
   DO 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)
-  END DO
-
-! ***   Calculate lifted parcel quantities below cloud base   ***
+    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)
+  END DO
+
+  ! ***   Calculate lifted parcel quantities below cloud base   ***
 
   DO i = 1, len                                           !convect3
     icb1(i) = min(max(icb(i), 2), nl)
-! if icb is below LCL, start loop at ICB+1:
-! (icbs est le premier niveau au-dessus du LCL)
+    ! if icb is below LCL, start loop at ICB+1:
+    ! (icbs est le premier niveau au-dessus du LCL)
     icbs(i) = icb1(i)                                     !convect3
-    IF (plcl(i)<p(i,icb1(i))) THEN
-      icbs(i) = min(icbs(i)+1, nl)                        !convect3
+    IF (plcl(i)<p(i, icb1(i))) THEN
+      icbs(i) = min(icbs(i) + 1, nl)                        !convect3
     END IF
   END DO                                                  !convect3
@@ -678 +670 @@
 
 
-! Re-compute icbsmax (icbsmax2):                          !convect3
-!                                                         !convect3
+  ! Re-compute icbsmax (icbsmax2):                          !convect3
+  !                                                         !convect3
   icbsmax2 = 2                                            !convect3
   DO i = 1, len                                           !convect3
@@ -685 +677 @@
   END DO                                                  !convect3
 
-! initialization outputs:
+  ! initialization outputs:
 
   DO k = 1, icbsmax2                                      ! convect3
@@ -695 +687 @@
   END DO                                                  ! convect3
 
-! tp and tvp below cloud base:
+  ! tp and tvp below cloud base:
 
   DO k = minorig, icbsmax2 - 1
     DO 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)
-    END DO
-  END DO
-
-! ***  Find lifted parcel quantities above cloud base    ***
+      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)
+    END DO
+  END DO
+
+  ! ***  Find lifted parcel quantities above cloud base    ***
 
   DO i = 1, len
     tg = ticb(i)
-! ori         qg=qs(i,icb(i))
+    ! ori         qg=qs(i,icb(i))
     qg = qsicb(i) ! convect3
-! debug         alv=lv0-clmcpv*(ticb(i)-t0)
-    alv = lv0 - clmcpv*(ticb(i)-273.15)
-
-! First iteration.
-
-! 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
-! 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)
-! ori          tg=max(tg,35.0)
-! debug          tc=tg-t0
+    ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
+    alv = lv0 - clmcpv * (ticb(i) - 273.15)
+
+    ! First iteration.
+
+    ! 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
+    ! 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)
+    ! ori          tg=max(tg,35.0)
+    ! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-! ori          IF(tc.ge.0.0)THEN
-    es = 6.112*exp(17.67*tc/denom)
-! ori          else
-! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-! ori          endif
-! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-    qg = eps*es/(p(i,icbs(i))-es*(1.-eps))
-
-! Second iteration.
-
-
-! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-! ori          s=1./s
-! 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)
-! ori          tg=max(tg,35.0)
-! debug          tc=tg-t0
+    ! ori          IF(tc.ge.0.0)THEN
+    es = 6.112 * exp(17.67 * tc / denom)
+    ! ori          else
+    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+    ! ori          endif
+    ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+    qg = eps * es / (p(i, icbs(i)) - es * (1. - eps))
+
+    ! Second iteration.
+
+
+    ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+    ! ori          s=1./s
+    ! 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)
+    ! ori          tg=max(tg,35.0)
+    ! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0)                               ! convect3
-! ori          IF(tc.ge.0.0)THEN
-    es = 6.112*exp(17.67*tc/denom)
-! ori          else
-! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-! ori          end if
-! 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)
-
-! ori c approximation here:
-! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-! ori     &   -gz(i,icb(i))-alv*qg)/cpd
-
-! convect3: no approximation:
-    tp(i, icbs(i)) = (ah0(i)-gz(i,icbs(i))-alv*qg)/(cpd+(cl-cpd)*qnk(i))
-
-! ori         clw(i,icb(i))=qnk(i)-qg
-! ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
+    ! ori          IF(tc.ge.0.0)THEN
+    es = 6.112 * exp(17.67 * tc / denom)
+    ! ori          else
+    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+    ! ori          end if
+    ! 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)
+
+    ! ori c approximation here:
+    ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+    ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
+
+    ! convect3: no approximation:
+    tp(i, icbs(i)) = (ah0(i) - gz(i, icbs(i)) - alv * qg) / (cpd + (cl - cpd) * qnk(i))
+
+    ! ori         clw(i,icb(i))=qnk(i)-qg
+    ! 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))
-! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-! 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
-
-  END DO
-
-! ori      do 380 k=minorig,icbsmax2
-! ori       do 370 i=1,len
-! ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
-! ori 370   continue
-! ori 380  continue
-
-
-! -- The following is only for convect3:
-
-! * icbs is the first level above the LCL:
-! if plcl<p(icb), then icbs=icb+1
-! if plcl>p(icb), then icbs=icb
-
-! * the routine above computes tvp from minorig to icbs (included).
-
-! * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
-! must be known. This is the case if icbs=icb+1, but not if icbs=icb.
-
-! * therefore, in the case icbs=icb, we compute tvp at level icb+1
-! (tvp at other levels will be computed in cv3_undilute2.F)
-
+    clw(i, icbs(i)) = max(0.0, clw(i, icbs(i)))
+
+    rg = qg / (1. - qnk(i))
+    ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+    ! 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
+
+  END DO
+
+  ! ori      do 380 k=minorig,icbsmax2
+  ! ori       do 370 i=1,len
+  ! ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
+  ! ori 370   continue
+  ! ori 380  continue
+
+
+  ! -- The following is only for convect3:
+
+  ! * icbs is the first level above the LCL:
+  ! if plcl<p(icb), then icbs=icb+1
+  ! if plcl>p(icb), then icbs=icb
+
+  ! * the routine above computes tvp from minorig to icbs (included).
+
+  ! * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
+  ! must be known. This is the case if icbs=icb+1, but not if icbs=icb.
+
+  ! * therefore, in the case icbs=icb, we compute tvp at level icb+1
+  ! (tvp at other levels will be computed in cv3_undilute2.F)
 
   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)
+    ticb(i) = t(i, icb(i) + 1)
+    gzicb(i) = gz(i, icb(i) + 1)
+    qsicb(i) = qs(i, icb(i) + 1)
   END DO
 
@@ -808 +799 @@
     tg = ticb(i)
     qg = qsicb(i) ! convect3
-! debug         alv=lv0-clmcpv*(ticb(i)-t0)
-    alv = lv0 - clmcpv*(ticb(i)-273.15)
-
-! First iteration.
-
-! 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
-! 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)
-! ori          tg=max(tg,35.0)
-! debug          tc=tg-t0
+    ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
+    alv = lv0 - clmcpv * (ticb(i) - 273.15)
+
+    ! First iteration.
+
+    ! 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
+    ! 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)
+    ! ori          tg=max(tg,35.0)
+    ! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0)                                   ! convect3
-! ori          IF(tc.ge.0.0)THEN
-    es = 6.112*exp(17.67*tc/denom)
-! ori          else
-! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-! ori          endif
-! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-    qg = eps*es/(p(i,icb(i)+1)-es*(1.-eps))
-
-! Second iteration.
-
-
-! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-! ori          s=1./s
-! 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)
-! ori          tg=max(tg,35.0)
-! debug          tc=tg-t0
+    ! ori          IF(tc.ge.0.0)THEN
+    es = 6.112 * exp(17.67 * tc / denom)
+    ! ori          else
+    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+    ! ori          endif
+    ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+    qg = eps * es / (p(i, icb(i) + 1) - es * (1. - eps))
+
+    ! Second iteration.
+
+
+    ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+    ! ori          s=1./s
+    ! 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)
+    ! ori          tg=max(tg,35.0)
+    ! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0)                                   ! convect3
-! ori          IF(tc.ge.0.0)THEN
-    es = 6.112*exp(17.67*tc/denom)
-! ori          else
-! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-! ori          end if
-! 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)
-
-! ori c approximation here:
-! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-! ori     &   -gz(i,icb(i))-alv*qg)/cpd
-
-! convect3: no approximation:
-    tp(i, icb(i)+1) = (ah0(i)-gz(i,icb(i)+1)-alv*qg)/(cpd+(cl-cpd)*qnk(i))
-
-! ori         clw(i,icb(i))=qnk(i)-qg
-! 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))
-! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-! 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
-
-  END DO
-
+    ! ori          IF(tc.ge.0.0)THEN
+    es = 6.112 * exp(17.67 * tc / denom)
+    ! ori          else
+    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+    ! ori          end if
+    ! 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)
+
+    ! ori c approximation here:
+    ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+    ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
+
+    ! convect3: no approximation:
+    tp(i, icb(i) + 1) = (ah0(i) - gz(i, icb(i) + 1) - alv * qg) / (cpd + (cl - cpd) * qnk(i))
+
+    ! ori         clw(i,icb(i))=qnk(i)-qg
+    ! 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))
+    ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+    ! 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
+
+  END DO
 
 END SUBROUTINE cv3_undilute1
 
 SUBROUTINE cv3_trigger(len, nd, icb, plcl, p, th, tv, tvp, thnk, &
-                       pbase, buoybase, iflag, sig, w0)
+        pbase, buoybase, iflag, sig, w0)
+  USE lmdz_cv3param
+
   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=14
-! (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 "cv3param.h"
-
-! input:
+  ! -------------------------------------------------------------------
+  ! --- 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=14
+  ! (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
+  ! -------------------------------------------------------------------
+
+  ! input:
   INTEGER len, nd
   INTEGER icb(len)
@@ -906 +896 @@
   REAL thnk(len)
 
-! output:
+  ! output:
   REAL pbase(len), buoybase(len)
 
-! input AND output:
+  ! input AND output:
   INTEGER iflag(len)
   REAL sig(len, nd), w0(len, nd)
 
-! local variables:
+  ! local variables:
   INTEGER i, k
   REAL tvpbase, tvbase, tdif, ath, ath1
 
 
-! ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
+  ! ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
 
   DO 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))
+    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
   END DO
 
 
-! ***   make sure that column is dry adiabatic between the surface  ***
-! ***    and cloud base, and that lifted air is positively buoyant  ***
-! ***                         at cloud base                         ***
-! ***       if not, return to calling program after resetting       ***
-! ***                        sig(i) and w0(i)                       ***
-
-
-! oct3      do 200 i=1,len
-! oct3
-! oct3       tdif = buoybase(i)
-! oct3       ath1 = th(i,1)
-! oct3       ath  = th(i,icb(i)-1) - dttrig
-! oct3
-! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
-! oct3         do 60 k=1,nl
-! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
-! oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
-! oct3            w0(i,k)  = beta*w0(i,k)
-! oct3   60    continue
-! oct3         iflag(i)=4 ! pour version vectorisee
-! oct3c convect3         iflag(i)=0
-! oct3cccc         RETURN
-! oct3       endif
-! oct3
-! oct3200   continue
-
-! -- oct3: on reecrit la boucle 200 (pour la vectorisation)
+  ! ***   make sure that column is dry adiabatic between the surface  ***
+  ! ***    and cloud base, and that lifted air is positively buoyant  ***
+  ! ***                         at cloud base                         ***
+  ! ***       if not, return to calling program after resetting       ***
+  ! ***                        sig(i) and w0(i)                       ***
+
+
+  ! oct3      do 200 i=1,len
+  ! oct3
+  ! oct3       tdif = buoybase(i)
+  ! oct3       ath1 = th(i,1)
+  ! oct3       ath  = th(i,icb(i)-1) - dttrig
+  ! oct3
+  ! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
+  ! oct3         do 60 k=1,nl
+  ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
+  ! oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
+  ! oct3            w0(i,k)  = beta*w0(i,k)
+  ! oct3   60    continue
+  ! oct3         iflag(i)=4 ! pour version vectorisee
+  ! oct3c convect3         iflag(i)=0
+  ! oct3cccc         RETURN
+  ! oct3       endif
+  ! oct3
+  ! oct3200   continue
+
+  ! -- oct3: on reecrit la boucle 200 (pour la vectorisation)
 
   DO k = 1, nl
@@ -963 +953 @@
       tdif = buoybase(i)
       ath1 = thnk(i)
-      ath = th(i, icb(i)-1) - dttrig
+      ath = th(i, icb(i) - 1) - dttrig
 
       IF (tdif<dtcrit .OR. ath>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)
+        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) = 14 ! pour version vectorisee
-! convect3         iflag(i)=0
+        ! convect3         iflag(i)=0
       END IF
 
@@ -976 +966 @@
   END DO
 
-! fin oct3 --
-
+  ! fin oct3 --
 
 END SUBROUTINE cv3_trigger
 
 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, &
-                        iflag, nk, icb, icbs, &
-                        plcl, tnk, qnk, gznk, pbase, buoybase, &
-                        t, q, qs, u, v, gz, th, &
-                        tra, &
-                        h, lv, cpn, p, ph, tv, tp, tvp, clw, &
-                        sig, w0)
+        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, &
+        iflag, nk, icb, icbs, &
+        plcl, tnk, qnk, gznk, pbase, buoybase, &
+        t, q, qs, u, v, gz, th, &
+        tra, &
+        h, lv, cpn, p, ph, tv, tp, tvp, clw, &
+        sig, w0)
   USE lmdz_print_control, ONLY: lunout
   USE lmdz_abort_physic, ONLY: abort_physic
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
-  include "cv3param.h"
-
-!inputs:
+  !inputs:
   INTEGER len, ncum, nd, ntra, nloc
   INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len)
@@ -1007 +996 @@
   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 p1(len, nd), ph1(len, nd + 1), tv1(len, nd), tp1(len, nd)
   REAL tvp1(len, nd), clw1(len, nd)
   REAL th1(len, nd)
@@ -1013 +1002 @@
   REAL tra1(len, nd, ntra)
 
-!outputs:
-! en fait, on a nloc=len pour l'instant (cf cv_driver)
+  !outputs:
+  ! 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)
@@ -1020 +1009 @@
   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 p(nloc, nd), ph(nloc, nd + 1), tv(nloc, nd), tp(nloc, nd)
   REAL tvp(nloc, nd), clw(nloc, nd)
   REAL th(nloc, nd)
@@ -1026 +1015 @@
   REAL tra(nloc, nd, ntra)
 
-!local variables:
+  !local variables:
   INTEGER i, k, nn, j
 
-  CHARACTER (LEN=20) :: modname = 'cv3_compress'
-  CHARACTER (LEN=80) :: abort_message
+  CHARACTER (LEN = 20) :: modname = 'cv3_compress'
+  CHARACTER (LEN = 80) :: abort_message
 
   DO k = 1, nl + 1
@@ -1059 +1048 @@
   END DO
 
-!AC!      do 121 j=1,ntra
-!AC!ccccc      do 111 k=1,nl+1
-!AC!      do 111 k=1,nd
-!AC!       nn=0
-!AC!      do 101 i=1,len
-!AC!      IF(iflag1(i).EQ.0)THEN
-!AC!       nn=nn+1
-!AC!       tra(nn,k,j)=tra1(i,k,j)
-!AC!      endif
-!AC! 101  continue
-!AC! 111  continue
-!AC! 121  continue
+  !AC!      do 121 j=1,ntra
+  !AC!ccccc      do 111 k=1,nl+1
+  !AC!      do 111 k=1,nd
+  !AC!       nn=0
+  !AC!      do 101 i=1,len
+  !AC!      IF(iflag1(i).EQ.0)THEN
+  !AC!       nn=nn+1
+  !AC!       tra(nn,k,j)=tra1(i,k,j)
+  !AC!      endif
+  !AC! 101  continue
+  !AC! 111  continue
+  !AC! 121  continue
 
   IF (nn/=ncum) THEN
@@ -1095 +1084 @@
   END DO
 
-
 END SUBROUTINE cv3_compress
 
@@ -1102 +1090 @@
 
 
-!JAM--------------------------------------------------------------------
-! Calcul de la quantité d'eau sous forme de glace
-! --------------------------------------------------------------------
+  !JAM--------------------------------------------------------------------
+  ! Calcul de la quantité d'eau sous forme de glace
+  ! --------------------------------------------------------------------
   INTEGER nl, len
   REAL qi(len, nl)
@@ -1113 +1101 @@
   DO k = 3, nl
     DO i = 1, len
-      IF (t(i,k)>263.15) THEN
+      IF (t(i, k)>263.15) THEN
         qi(i, k) = 0.
       ELSE
-        IF (t(i,k)<243.15) THEN
+        IF (t(i, k)<243.15) THEN
           qi(i, k) = clw(i, k)
         ELSE
-          fracg = (263.15-t(i,k))/20
-          qi(i, k) = clw(i, k)*fracg
+          fracg = (263.15 - t(i, k)) / 20
+          qi(i, k) = clw(i, k) * fracg
         END IF
       END IF
-! PRINT*,t(i,k),qi(i,k),'temp,testglace'
-    END DO
-  END DO
-
-
+      ! PRINT*,t(i,k),qi(i,k),'temp,testglace'
+    END DO
+  END DO
 
 END SUBROUTINE icefrac
 
 SUBROUTINE cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &
-                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
-                         p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
-                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
-                         frac_a, frac_s, qpreca, qta)
+        tnk, qnk, gznk, hnk, t, q, qs, gz, &
+        p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
+        inb, tp, tvp, clw, hp, ep, sigp, buoy, &
+        frac_a, frac_s, qpreca, qta)
   USE lmdz_print_control, ONLY: prt_level
   USE lmdz_conema3
   USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-! ---------------------------------------------------------------------
-! Purpose:
-! 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
-
-! Main differences convect3/convect4:
-!   - icbs (input) is the first level above LCL (may differ from icb)
-!   - many minor differences in the iterations
-!   - condensed water not removed from tvp in convect3
-!   - vertical profile of buoyancy computed here (use of buoybase)
-!   - the determination of inb is different
-!   - no inb1, ONLY inb in output
-! ---------------------------------------------------------------------
-
-  include "cvthermo.h"
-  include "cv3param.h"
+  ! ---------------------------------------------------------------------
+  ! Purpose:
+  ! 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
+
+  ! Main differences convect3/convect4:
+  !   - icbs (input) is the first level above LCL (may differ from icb)
+  !   - many minor differences in the iterations
+  !   - condensed water not removed from tvp in convect3
+  !   - vertical profile of buoyancy computed here (use of buoybase)
+  !   - the determination of inb is different
+  !   - no inb1, ONLY inb in output
+  ! ---------------------------------------------------------------------
+
   include "YOMCST2.h"
 
-!inputs:
-  INTEGER, INTENT (IN)                               :: ncum, nd, nloc
-  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, icbs, nk
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, q, qs, gz
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
-  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
-  REAL, DIMENSION (nloc), INTENT (IN)                :: tnk, qnk, gznk
-  REAL, DIMENSION (nloc), INTENT (IN)                :: hnk
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: lv, lf, tv, h
-  REAL, DIMENSION (nloc), INTENT (IN)                :: pbase, buoybase, plcl
-
-!input/outputs:
-  REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: tp, tvp, clw   ! Input for k = 1, icb+1 (computed in cv3_undilute1)
-                                                                       ! Output above
-  INTEGER, DIMENSION (nloc), INTENT (INOUT)          :: iflag
-
-!outputs:
-  INTEGER, DIMENSION (nloc), INTENT (OUT)            :: inb
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ep, sigp, hp
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: buoy
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: frac_a, frac_s
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qpreca
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qta
-
-!local variables:
+  !inputs:
+  INTEGER, INTENT (IN) :: ncum, nd, nloc
+  INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, icbs, nk
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, q, qs, gz
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: p
+  REAL, DIMENSION (nloc, nd + 1), INTENT (IN) :: ph
+  REAL, DIMENSION (nloc), INTENT (IN) :: tnk, qnk, gznk
+  REAL, DIMENSION (nloc), INTENT (IN) :: hnk
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: lv, lf, tv, h
+  REAL, DIMENSION (nloc), INTENT (IN) :: pbase, buoybase, plcl
+
+  !input/outputs:
+  REAL, DIMENSION (nloc, nd), INTENT (INOUT) :: tp, tvp, clw   ! Input for k = 1, icb+1 (computed in cv3_undilute1)
+  ! Output above
+  INTEGER, DIMENSION (nloc), INTENT (INOUT) :: iflag
+
+  !outputs:
+  INTEGER, DIMENSION (nloc), INTENT (OUT) :: inb
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: ep, sigp, hp
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: buoy
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: frac_a, frac_s
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: qpreca
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: qta
+
+  !local variables:
   INTEGER i, j, k
   REAL smallestreal
   REAL tg, qg, dqgdT, ahg, alv, alf, s, tc, es, esi, denom, rg, tca, elacrit
-  REAL                                               :: phinu2p
-  REAL                                               :: qhthreshold
-  REAL                                               :: als
-  REAL                                               :: qsat_new, snew
-  REAL, DIMENSION (nloc,nd)                          :: qi
-  REAL, DIMENSION (nloc,nd)                          :: ha    ! moist static energy of adiabatic ascents 
-                                                              ! taking into account precip ejection
-  REAL, DIMENSION (nloc,nd)                          :: hla   ! liquid water static energy of adiabatic ascents 
-                                                              ! taking into account precip ejection
-  REAL, DIMENSION (nloc,nd)                          :: qcld  ! specific cloud water
-  REAL, DIMENSION (nloc,nd)                          :: qhsat    ! specific humidity at saturation
-  REAL, DIMENSION (nloc,nd)                          :: dqhsatdT ! dqhsat/dT
-  REAL, DIMENSION (nloc,nd)                          :: frac  ! ice fraction function of envt temperature
-  REAL, DIMENSION (nloc,nd)                          :: qps   ! specific solid precipitation
-  REAL, DIMENSION (nloc,nd)                          :: qpl   ! specific liquid precipitation
-  REAL, DIMENSION (nloc)                             :: ah0, cape, capem, byp
-  LOGICAL, DIMENSION (nloc)                          :: lcape
-  INTEGER, DIMENSION (nloc)                          :: iposit
-  REAL                                               :: denomm1
-  REAL                                               :: by, defrac, pden, tbis
-  REAL                                               :: fracg
-  REAL                                               :: deltap
-  REAL, SAVE                                         :: Tx, Tm
+  REAL :: phinu2p
+  REAL :: qhthreshold
+  REAL :: als
+  REAL :: qsat_new, snew
+  REAL, DIMENSION (nloc, nd) :: qi
+  REAL, DIMENSION (nloc, nd) :: ha    ! moist static energy of adiabatic ascents
+  ! taking into account precip ejection
+  REAL, DIMENSION (nloc, nd) :: hla   ! liquid water static energy of adiabatic ascents
+  ! taking into account precip ejection
+  REAL, DIMENSION (nloc, nd) :: qcld  ! specific cloud water
+  REAL, DIMENSION (nloc, nd) :: qhsat    ! specific humidity at saturation
+  REAL, DIMENSION (nloc, nd) :: dqhsatdT ! dqhsat/dT
+  REAL, DIMENSION (nloc, nd) :: frac  ! ice fraction function of envt temperature
+  REAL, DIMENSION (nloc, nd) :: qps   ! specific solid precipitation
+  REAL, DIMENSION (nloc, nd) :: qpl   ! specific liquid precipitation
+  REAL, DIMENSION (nloc) :: ah0, cape, capem, byp
+  LOGICAL, DIMENSION (nloc) :: lcape
+  INTEGER, DIMENSION (nloc) :: iposit
+  REAL :: denomm1
+  REAL :: by, defrac, pden, tbis
+  REAL :: fracg
+  REAL :: deltap
+  REAL, SAVE :: Tx, Tm
   DATA Tx/263.15/, Tm/243.15/
-!$OMP THREADPRIVATE(Tx, Tm)
-  REAL                                               :: aa, bb, dd, ddelta, discr
-  REAL                                               :: ff, fp
-  REAL                                               :: coefx, coefm, Zx, Zm, Ux, U, Um
+  !$OMP THREADPRIVATE(Tx, Tm)
+  REAL :: aa, bb, dd, ddelta, discr
+  REAL :: ff, fp
+  REAL :: coefx, coefm, Zx, Zm, Ux, U, Um
 
   IF (prt_level >= 10) THEN
-    print *,'cv3_undilute2.0. icvflag_Tpa, t(1,k), q(1,k), qs(1,k) ', &
-                        icvflag_Tpa, (k, t(1,k), q(1,k), qs(1,k), k = 1,nl)
+    print *, 'cv3_undilute2.0. icvflag_Tpa, t(1,k), q(1,k), qs(1,k) ', &
+            icvflag_Tpa, (k, t(1, k), q(1, k), qs(1, k), k = 1, nl)
   ENDIF
-  smallestreal=tiny(smallestreal)
-
-! =====================================================================
-! --- SOME INITIALIZATIONS
-! =====================================================================
+  smallestreal = tiny(smallestreal)
+
+  ! =====================================================================
+  ! --- SOME INITIALIZATIONS
+  ! =====================================================================
 
   DO k = 1, nl
@@ -1238 +1224 @@
 
 
-! =====================================================================
-! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-! =====================================================================
-
-! ---       The procedure is to solve the equation.
-!                cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-
-! ***  Calculate certain parcel quantities, including static energy   ***
-
+  ! =====================================================================
+  ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+  ! =====================================================================
+
+  ! ---       The procedure is to solve the equation.
+  !                cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+
+  ! ***  Calculate certain parcel quantities, including static energy   ***
 
   DO i = 1, ncum
-    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)+ & 
-! debug          qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
-             qnk(i)*(lv0-clmcpv*(tnk(i)-273.15)) + gznk(i)
-  END DO
-
-!  Ice fraction
+    ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) + &
+            ! debug          qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
+            qnk(i) * (lv0 - clmcpv * (tnk(i) - 273.15)) + gznk(i)
+  END DO
+
+  !  Ice fraction
 
   IF (cvflag_ice) THEN
     DO k = minorig, nl
       DO i = 1, ncum
-          frac(i, k) = (Tx - t(i,k))/(Tx - Tm)
-          frac(i, k) = min(max(frac(i,k),0.0), 1.0)
+        frac(i, k) = (Tx - t(i, k)) / (Tx - Tm)
+        frac(i, k) = min(max(frac(i, k), 0.0), 1.0)
       END DO
     END DO
-! Below cloud base, set ice fraction to cloud base value
+    ! Below cloud base, set ice fraction to cloud base value
     DO k = 1, nl
       DO i = 1, ncum
         IF (k<icb(i)) THEN
-          frac(i,k) = frac(i,icb(i))
+          frac(i, k) = frac(i, icb(i))
         END IF
       END DO
@@ -1274 +1259 @@
     DO k = 1, nl
       DO i = 1, ncum
-          frac(i,k) = 0.
+        frac(i, k) = 0.
       END DO
     END DO
   ENDIF ! (cvflag_ice)
 
-
   DO k = minorig, nl
-    DO i = 1,ncum
-      ha(i,k) = ah0(i)
-      hla(i,k) = hnk(i)
-      qta(i,k) = qnk(i)
-      qpreca(i,k) = 0.
-      frac_a(i,k) = 0.
-      frac_s(i,k) = frac(i,k)
-      qpl(i,k) = 0.
-      qps(i,k) = 0.
-      qhsat(i,k) = qs(i,k)
-      qcld(i,k) = max(qta(i,k)-qhsat(i,k),0.)
-      IF (k <= icb(i)+1) THEN
-        qhsat(i,k) = qnk(i)-clw(i,k)
-        qcld(i,k) = clw(i,k)
-      ENDIF 
+    DO i = 1, ncum
+      ha(i, k) = ah0(i)
+      hla(i, k) = hnk(i)
+      qta(i, k) = qnk(i)
+      qpreca(i, k) = 0.
+      frac_a(i, k) = 0.
+      frac_s(i, k) = frac(i, k)
+      qpl(i, k) = 0.
+      qps(i, k) = 0.
+      qhsat(i, k) = qs(i, k)
+      qcld(i, k) = max(qta(i, k) - qhsat(i, k), 0.)
+      IF (k <= icb(i) + 1) THEN
+        qhsat(i, k) = qnk(i) - clw(i, k)
+        qcld(i, k) = clw(i, k)
+      ENDIF
     ENDDO
   ENDDO
 
-!jyg<
-! =====================================================================
-! --- SET THE THE FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
-! =====================================================================
+  !jyg<
+  ! =====================================================================
+  ! --- SET THE THE FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+  ! =====================================================================
   DO k = 1, nl
     DO i = 1, ncum
@@ -1309 +1293 @@
     END DO
   END DO
-!>jyg
-
-! ***  Find lifted parcel quantities above cloud base    ***
-
-!----------------------------------------------------------------------------
+  !>jyg
+
+  ! ***  Find lifted parcel quantities above cloud base    ***
+
+  !----------------------------------------------------------------------------
 
   IF (icvflag_Tpa == 2) THEN
 
-!----------------------------------------------------------------------------
+    !----------------------------------------------------------------------------
 
     DO k = minorig + 1, nl
-      DO i = 1,ncum
-        tp(i,k) = t(i,k)
+      DO i = 1, ncum
+        tp(i, k) = t(i, k)
       ENDDO
-!!      alv = lv0 - clmcpv*(t(i,k)-273.15)
-!!      alf = lf0 + clmci*(t(i,k)-273.15)
-!!      als = alf + alv
-      DO j = 1,4
+      !!      alv = lv0 - clmcpv*(t(i,k)-273.15)
+      !!      alf = lf0 + clmci*(t(i,k)-273.15)
+      !!      als = alf + alv
+      DO j = 1, 4
         DO i = 1, ncum
-! ori       IF(k.ge.(icb(i)+1))THEN
-          IF (k>=(icbs(i)+1)) THEN                                ! convect3
+          ! ori     IF(k.ge.(icb(i)+1))THEN
+          IF (k>=(icbs(i) + 1)) THEN                                ! convect3
             tg = tp(i, k)
             IF (tg > Tx) THEN
-              es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15))
-              qg = eps*es/(p(i,k)-es*(1.-eps))
+              es = 6.112 * exp(17.67 * (tg - 273.15) / (tg + 243.5 - 273.15))
+              qg = eps * es / (p(i, k) - es * (1. - eps))
             ELSE
-              esi = exp(23.33086-(6111.72784/tg)+0.15215*log(tg))
-              qg = eps*esi/(p(i,k)-esi*(1.-eps))
+              esi = exp(23.33086 - (6111.72784 / tg) + 0.15215 * log(tg))
+              qg = eps * esi / (p(i, k) - esi * (1. - eps))
             ENDIF
-! Ice fraction
+            ! Ice fraction
             ff = 0.
-            fp = 1./(Tx - Tm)
+            fp = 1. / (Tx - Tm)
             IF (tg < Tx) THEN
               IF (tg > Tm) THEN
-                ff = (Tx - tg)*fp
+                ff = (Tx - tg) * fp
               ELSE
                 ff = 1.
               ENDIF ! (tg > Tm)
             ENDIF ! (tg < Tx)
-! Intermediate variables
-            aa = cpd + (cl-cpd)*qnk(i) + lv(i,k)*lv(i,k)*qg/(rrv*tg*tg)
-            ahg = (cpd + (cl-cpd)*qnk(i))*tg + lv(i,k)*qg - &
-                  lf(i,k)*ff*(qnk(i) - qg) + gz(i,k)
-            dd = lf(i,k)*lv(i,k)*qg/(rrv*tg*tg)
-            ddelta = lf(i,k)*(qnk(i) - qg)
-            bb = aa + ddelta*fp + dd*fp*(Tx-tg)
-! Compute Zx and Zm
+            ! Intermediate variables
+            aa = cpd + (cl - cpd) * qnk(i) + lv(i, k) * lv(i, k) * qg / (rrv * tg * tg)
+            ahg = (cpd + (cl - cpd) * qnk(i)) * tg + lv(i, k) * qg - &
+                    lf(i, k) * ff * (qnk(i) - qg) + gz(i, k)
+            dd = lf(i, k) * lv(i, k) * qg / (rrv * tg * tg)
+            ddelta = lf(i, k) * (qnk(i) - qg)
+            bb = aa + ddelta * fp + dd * fp * (Tx - tg)
+            ! Compute Zx and Zm
             coefx = aa
             coefm = aa + dd
             IF (tg > Tx) THEN
-              Zx = ahg            + coefx*(Tx - tg)
-              Zm = ahg - ddelta   + coefm*(Tm - tg)
+              Zx = ahg + coefx * (Tx - tg)
+              Zm = ahg - ddelta + coefm * (Tm - tg)
             ELSE
               IF (tg > Tm) THEN
-                Zx = ahg          + (coefx +fp*ddelta)*(Tx - Tg)
-                Zm = ahg          + (coefm +fp*ddelta)*(Tm - Tg)
+                Zx = ahg + (coefx + fp * ddelta) * (Tx - Tg)
+                Zm = ahg + (coefm + fp * ddelta) * (Tm - Tg)
               ELSE
-                Zx = ahg + ddelta + coefx*(Tx - tg)
-                Zm = ahg          + coefm*(Tm - tg)
+                Zx = ahg + ddelta + coefx * (Tx - tg)
+                Zm = ahg + coefm * (Tm - tg)
               ENDIF ! (tg .gt. Tm)
             ENDIF ! (tg .gt. Tx)
-! Compute the masks Um, U, Ux
-            Um = (sign(1., Zm-ah0(i))+1.)/2.
-            Ux = (sign(1., ah0(i)-Zx)+1.)/2.
-            U = (1. - Um)*(1. - Ux)
-! Compute the updated parcell temperature Tp : 3 cases depending on tg value
+            ! Compute the masks Um, U, Ux
+            Um = (sign(1., Zm - ah0(i)) + 1.) / 2.
+            Ux = (sign(1., ah0(i) - Zx) + 1.) / 2.
+            U = (1. - Um) * (1. - Ux)
+            ! Compute the updated parcell temperature Tp : 3 cases depending on tg value
             IF (tg > Tx) THEN
-              discr = bb*bb - 4*dd*fp*(ah0(i) - ahg + ddelta*fp*(Tx-tg))
-              Tp(i,k) = tg + &
-                  Um*  (ah0(i) - ahg + ddelta)           /(aa + dd) + &
-                  U *2*(ah0(i) - ahg + ddelta*fp*(Tx-tg))/(bb + sqrt(discr)) + &
-                  Ux*  (ah0(i) - ahg)                    /aa
+              discr = bb * bb - 4 * dd * fp * (ah0(i) - ahg + ddelta * fp * (Tx - tg))
+              Tp(i, k) = tg + &
+                      Um * (ah0(i) - ahg + ddelta) / (aa + dd) + &
+                      U * 2 * (ah0(i) - ahg + ddelta * fp * (Tx - tg)) / (bb + sqrt(discr)) + &
+                      Ux * (ah0(i) - ahg) / aa
             ELSEIF (tg > Tm) THEN
-              discr = bb*bb - 4*dd*fp*(ah0(i) - ahg)
-              Tp(i,k) = tg + &
-                  Um*  (ah0(i) - ahg + ddelta*fp*(tg-Tm))/(aa + dd) + &
-                  U *2*(ah0(i) - ahg)                    /(bb + sqrt(discr)) + &
-                  Ux*  (ah0(i) - ahg + ddelta*fp*(tg-Tx))/aa
+              discr = bb * bb - 4 * dd * fp * (ah0(i) - ahg)
+              Tp(i, k) = tg + &
+                      Um * (ah0(i) - ahg + ddelta * fp * (tg - Tm)) / (aa + dd) + &
+                      U * 2 * (ah0(i) - ahg) / (bb + sqrt(discr)) + &
+                      Ux * (ah0(i) - ahg + ddelta * fp * (tg - Tx)) / aa
             ELSE
-              discr = bb*bb - 4*dd*fp*(ah0(i) - ahg + ddelta*fp*(Tm-tg))
-              Tp(i,k) = tg + &
-                  Um*  (ah0(i) - ahg)                    /(aa + dd) + &
-                  U *2*(ah0(i) - ahg + ddelta*fp*(Tm-tg))/(bb + sqrt(discr)) + &
-                  Ux*  (ah0(i) - ahg - ddelta)           /aa
+              discr = bb * bb - 4 * dd * fp * (ah0(i) - ahg + ddelta * fp * (Tm - tg))
+              Tp(i, k) = tg + &
+                      Um * (ah0(i) - ahg) / (aa + dd) + &
+                      U * 2 * (ah0(i) - ahg + ddelta * fp * (Tm - tg)) / (bb + sqrt(discr)) + &
+                      Ux * (ah0(i) - ahg - ddelta) / aa
             ENDIF ! (tg .gt. Tx)
 
-!!     print *,' j, k, Um, U, Ux, aa, bb, discr, dd, ddelta ', j, k, Um, U, Ux, aa, bb, discr, dd, ddelta
-!!     print *,' j, k, ah0(i), ahg, tg, qg, tp(i,k), ff ', j, k, ah0(i), ahg, tg, qg, tp(i,k), ff
+            !!     print *,' j, k, Um, U, Ux, aa, bb, discr, dd, ddelta ', j, k, Um, U, Ux, aa, bb, discr, dd, ddelta
+            !!     print *,' j, k, ah0(i), ahg, tg, qg, tp(i,k), ff ', j, k, ah0(i), ahg, tg, qg, tp(i,k), ff
           END IF ! (k>=(icbs(i)+1))
         END DO ! i = 1, ncum
       END DO ! j = 1,4
       DO i = 1, ncum
-        IF (k>=(icbs(i)+1)) THEN                                ! convect3
+        IF (k>=(icbs(i) + 1)) THEN                                ! convect3
           tg = tp(i, k)
           IF (tg > Tx) THEN
-            es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15))
-            qg = eps*es/(p(i,k)-es*(1.-eps))
+            es = 6.112 * exp(17.67 * (tg - 273.15) / (tg + 243.5 - 273.15))
+            qg = eps * es / (p(i, k) - es * (1. - eps))
           ELSE
-            esi = exp(23.33086-(6111.72784/tg)+0.15215*log(tg))
-            qg = eps*esi/(p(i,k)-esi*(1.-eps))
+            esi = exp(23.33086 - (6111.72784 / tg) + 0.15215 * log(tg))
+            qg = eps * esi / (p(i, k) - esi * (1. - eps))
           ENDIF
           clw(i, k) = qnk(i) - qg
-          clw(i, k) = max(0.0, clw(i,k))
-          tvp(i, k) = max(0., tp(i,k)*(1.+qg/eps-qnk(i)))
-! PRINT*,tvp(i,k),'tvp'
-          IF (clw(i,k)<1.E-11) THEN
+          clw(i, k) = max(0.0, clw(i, k))
+          tvp(i, k) = max(0., tp(i, k) * (1. + qg / eps - qnk(i)))
+          ! PRINT*,tvp(i,k),'tvp'
+          IF (clw(i, k)<1.E-11) THEN
             tp(i, k) = tv(i, k)
             tvp(i, k) = tv(i, k)
@@ -1421 +1405 @@
       END DO ! i = 1, ncum
     END DO ! k = minorig + 1, nl
-!----------------------------------------------------------------------------
+    !----------------------------------------------------------------------------
 
   ELSE IF (icvflag_Tpa == 1) THEN  ! (icvflag_Tpa == 2)
 
-!----------------------------------------------------------------------------
+    !----------------------------------------------------------------------------
 
     DO k = minorig + 1, nl
-      DO i = 1,ncum
-        tp(i,k) = t(i,k)
+      DO i = 1, ncum
+        tp(i, k) = t(i, k)
       ENDDO
-!!      alv = lv0 - clmcpv*(t(i,k)-273.15)
-!!      alf = lf0 + clmci*(t(i,k)-273.15)
-!!      als = alf + alv
-      DO j = 1,4
+      !!      alv = lv0 - clmcpv*(t(i,k)-273.15)
+      !!      alf = lf0 + clmci*(t(i,k)-273.15)
+      !!      als = alf + alv
+      DO j = 1, 4
         DO i = 1, ncum
-! ori       IF(k.ge.(icb(i)+1))THEN
-          IF (k>=(icbs(i)+1)) THEN                                ! convect3
+          ! ori     IF(k.ge.(icb(i)+1))THEN
+          IF (k>=(icbs(i) + 1)) THEN                                ! convect3
             tg = tp(i, k)
             IF (tg > Tx .OR. .NOT.cvflag_ice) THEN
-              es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15))
-              qg = eps*es/(p(i,k)-es*(1.-eps))
-              dqgdT = lv(i,k)*qg/(rrv*tg*tg)
+              es = 6.112 * exp(17.67 * (tg - 273.15) / (tg + 243.5 - 273.15))
+              qg = eps * es / (p(i, k) - es * (1. - eps))
+              dqgdT = lv(i, k) * qg / (rrv * tg * tg)
             ELSE
-              esi = exp(23.33086-(6111.72784/tg)+0.15215*log(tg))
-              qg = eps*esi/(p(i,k)-esi*(1.-eps))
-              dqgdT = (lv(i,k)+lf(i,k))*qg/(rrv*tg*tg)
+              esi = exp(23.33086 - (6111.72784 / tg) + 0.15215 * log(tg))
+              qg = eps * esi / (p(i, k) - esi * (1. - eps))
+              dqgdT = (lv(i, k) + lf(i, k)) * qg / (rrv * tg * tg)
             ENDIF
             IF (qsat_depends_on_qt) THEN
-              dqgdT = dqgdT*(1.-qta(i,k-1))/(1.-qg)**2
-              qg = qg*(1.-qta(i,k-1))/(1.-qg)            
+              dqgdT = dqgdT * (1. - qta(i, k - 1)) / (1. - qg)**2
+              qg = qg * (1. - qta(i, k - 1)) / (1. - qg)
             ENDIF
-            ahg = (cpd + (cl-cpd)*qta(i,k-1))*tg + lv(i,k)*qg - &
-                  lf(i,k)*frac(i,k)*(qta(i,k-1) - qg) + gz(i,k)
-            Tp(i,k) = tg + (ah0(i) - ahg)/ &
-                    (cpd + (cl-cpd)*qta(i,k-1) + (lv(i,k)+frac(i,k)*lf(i,k))*dqgdT)
-!!   print *,'undilute2 iterations k, Tp(i,k), ah0(i), ahg ', &
-!!                                 k, Tp(i,k), ah0(i), ahg
+            ahg = (cpd + (cl - cpd) * qta(i, k - 1)) * tg + lv(i, k) * qg - &
+                    lf(i, k) * frac(i, k) * (qta(i, k - 1) - qg) + gz(i, k)
+            Tp(i, k) = tg + (ah0(i) - ahg) / &
+                    (cpd + (cl - cpd) * qta(i, k - 1) + (lv(i, k) + frac(i, k) * lf(i, k)) * dqgdT)
+            !!   print *,'undilute2 iterations k, Tp(i,k), ah0(i), ahg ', &
+            !!                                 k, Tp(i,k), ah0(i), ahg
           END IF ! (k>=(icbs(i)+1))
         END DO ! i = 1, ncum
       END DO ! j = 1,4
       DO i = 1, ncum
-        IF (k>=(icbs(i)+1)) THEN                                ! convect3
+        IF (k>=(icbs(i) + 1)) THEN                                ! convect3
           tg = tp(i, k)
           IF (tg > Tx .OR. .NOT.cvflag_ice) THEN
-            es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15))
-            qg = eps*es/(p(i,k)-es*(1.-eps))
+            es = 6.112 * exp(17.67 * (tg - 273.15) / (tg + 243.5 - 273.15))
+            qg = eps * es / (p(i, k) - es * (1. - eps))
           ELSE
-            esi = exp(23.33086-(6111.72784/tg)+0.15215*log(tg))
-            qg = eps*esi/(p(i,k)-esi*(1.-eps))
+            esi = exp(23.33086 - (6111.72784 / tg) + 0.15215 * log(tg))
+            qg = eps * esi / (p(i, k) - esi * (1. - eps))
           ENDIF
           IF (qsat_depends_on_qt) THEN
-            qg = qg*(1.-qta(i,k-1))/(1.-qg)            
+            qg = qg * (1. - qta(i, k - 1)) / (1. - qg)
           ENDIF
-          qhsat(i,k) = qg
+          qhsat(i, k) = qg
         END IF ! (k>=(icbs(i)+1))
       END DO ! i = 1, ncum
       DO i = 1, ncum
-        IF (k>=(icbs(i)+1)) THEN                                ! convect3
-          clw(i, k) = qta(i,k-1) - qhsat(i,k)
-          clw(i, k) = max(0.0, clw(i,k))
-          tvp(i, k) = max(0., tp(i,k)*(1.+qhsat(i,k)/eps-qta(i,k-1)))
-! PRINT*,tvp(i,k),'tvp'
-          IF (clw(i,k)<1.E-11) THEN
+        IF (k>=(icbs(i) + 1)) THEN                                ! convect3
+          clw(i, k) = qta(i, k - 1) - qhsat(i, k)
+          clw(i, k) = max(0.0, clw(i, k))
+          tvp(i, k) = max(0., tp(i, k) * (1. + qhsat(i, k) / eps - qta(i, k - 1)))
+          ! PRINT*,tvp(i,k),'tvp'
+          IF (clw(i, k)<1.E-11) THEN
             tp(i, k) = tv(i, k)
             tvp(i, k) = tv(i, k)
@@ -1492 +1476 @@
       IF (cvflag_prec_eject) THEN
         DO i = 1, ncum
-          IF (k>=(icbs(i)+1)) THEN                                ! convect3
-!  Specific precipitation (liquid and solid) and ice content 
-!  before ejection of precipitation                                                     !!jygprl
-            elacrit = elcrit*min(max(1.-(tp(i,k)-T0)/Tlcrit, 0.), 1.)                   !!jygprl
-!!!!            qcld(i,k) = min(clw(i,k), elacrit)                                          !!jygprl
-            qhthreshold = elacrit*(1.-qta(i,k-1))/(1.-elacrit)
-            qcld(i,k) = min(clw(i,k), qhthreshold)             !!jygprl
-!!!!            phinu2p = max(qhsat(i,k-1) + qcld(i,k-1) - (qhsat(i,k) + qcld(i,k)),0.)   !!jygprl
-            phinu2p = max(clw(i,k) - max(qta(i,k-1) - qhsat(i,k-1), qhthreshold), 0.)
-            qpl(i,k) = qpl(i,k-1) + (1.-frac(i,k))*phinu2p                            !!jygprl
-            qps(i,k) = qps(i,k-1) + frac(i,k)     *phinu2p                            !!jygprl
-            qi(i,k) = (1.-ejectliq)*clw(i,k)*frac(i,k) + &                            !!jygprl
-                     ejectliq*(qps(i,k-1) + frac(i,k)*(phinu2p+qcld(i,k)))            !!jygprl
-!!
-!  =====================================================================================
-!  Ejection of precipitation from adiabatic ascents if requested (cvflag_prec_eject=True):
-!  Compute the steps of total water (qta), of moist static energy (ha), of specific 
-!  precipitation (qpl and qps) and of specific cloud water (qcld) associated with precipitation
-!   ejection.
-!  =====================================================================================
-
-!   Verif
-            qpreca(i,k) = ejectliq*qpl(i,k) + ejectice*qps(i,k)                                   !!jygprl
-            frac_a(i,k) = ejectice*qps(i,k)/max(qpreca(i,k),smallestreal)                         !!jygprl
-            frac_s(i,k) = (1.-ejectliq)*frac(i,k) + &                                             !!jygprl
-               ejectliq*(1. - (qpl(i,k)+(1.-frac(i,k))*qcld(i,k))/max(clw(i,k),smallestreal))     !!jygprl
-
-            denomm1 = 1./(1. - qpreca(i,k))
-
-            qta(i,k) = qta(i,k-1) - &
-                      qpreca(i,k)*(1.-qta(i,k-1))*denomm1
-            ha(i,k)  = ha(i,k-1) + &
-                      ( qpreca(i,k)*(-(1.-qta(i,k-1))*(cl-cpd)*tp(i,k) + &
-                                  lv(i,k)*qhsat(i,k) - lf(i,k)*(frac_s(i,k)*qcld(i,k)+qps(i,k))) + &
-                        lf(i,k)*ejectice*qps(i,k))*denomm1
-            hla(i,k) = hla(i,k-1) + &
-                      ( qpreca(i,k)*(-(1.-qta(i,k-1))*(cpv-cpd)*tp(i,k) - &
-                                  lv(i,k)*((1.-frac_s(i,k))*qcld(i,k)+qpl(i,k)) - &
-                                  (lv(i,k)+lf(i,k))*(frac_s(i,k)*qcld(i,k)+qps(i,k))) + &
-                        lv(i,k)*ejectliq*qpl(i,k) + (lv(i,k)+lf(i,k))*ejectice*qps(i,k))*denomm1
-            qpl(i,k) = qpl(i,k)*(1.-ejectliq)*denomm1
-            qps(i,k) = qps(i,k)*(1.-ejectice)*denomm1
-            qcld(i,k) = qcld(i,k)*denomm1
-            qhsat(i,k) = qhsat(i,k)*(1.-qta(i,k))/(1.-qta(i,k-1))
-         END IF ! (k>=(icbs(i)+1))
+          IF (k>=(icbs(i) + 1)) THEN                                ! convect3
+            !  Specific precipitation (liquid and solid) and ice content
+            !  before ejection of precipitation                                                     !!jygprl
+            elacrit = elcrit * min(max(1. - (tp(i, k) - T0) / Tlcrit, 0.), 1.)                   !!jygprl
+            !!!!            qcld(i,k) = min(clw(i,k), elacrit)                                          !!jygprl
+            qhthreshold = elacrit * (1. - qta(i, k - 1)) / (1. - elacrit)
+            qcld(i, k) = min(clw(i, k), qhthreshold)             !!jygprl
+            !!!!            phinu2p = max(qhsat(i,k-1) + qcld(i,k-1) - (qhsat(i,k) + qcld(i,k)),0.)   !!jygprl
+            phinu2p = max(clw(i, k) - max(qta(i, k - 1) - qhsat(i, k - 1), qhthreshold), 0.)
+            qpl(i, k) = qpl(i, k - 1) + (1. - frac(i, k)) * phinu2p                            !!jygprl
+            qps(i, k) = qps(i, k - 1) + frac(i, k) * phinu2p                            !!jygprl
+            qi(i, k) = (1. - ejectliq) * clw(i, k) * frac(i, k) + &                            !!jygprl
+                    ejectliq * (qps(i, k - 1) + frac(i, k) * (phinu2p + qcld(i, k)))            !!jygprl
+            !!
+            !  =====================================================================================
+            !  Ejection of precipitation from adiabatic ascents if requested (cvflag_prec_eject=True):
+            !  Compute the steps of total water (qta), of moist static energy (ha), of specific
+            !  precipitation (qpl and qps) and of specific cloud water (qcld) associated with precipitation
+            !   ejection.
+            !  =====================================================================================
+
+            !   Verif
+            qpreca(i, k) = ejectliq * qpl(i, k) + ejectice * qps(i, k)                                   !!jygprl
+            frac_a(i, k) = ejectice * qps(i, k) / max(qpreca(i, k), smallestreal)                         !!jygprl
+            frac_s(i, k) = (1. - ejectliq) * frac(i, k) + &                                             !!jygprl
+                    ejectliq * (1. - (qpl(i, k) + (1. - frac(i, k)) * qcld(i, k)) / max(clw(i, k), smallestreal))     !!jygprl
+
+            denomm1 = 1. / (1. - qpreca(i, k))
+
+            qta(i, k) = qta(i, k - 1) - &
+                    qpreca(i, k) * (1. - qta(i, k - 1)) * denomm1
+            ha(i, k) = ha(i, k - 1) + &
+                    (qpreca(i, k) * (-(1. - qta(i, k - 1)) * (cl - cpd) * tp(i, k) + &
+                            lv(i, k) * qhsat(i, k) - lf(i, k) * (frac_s(i, k) * qcld(i, k) + qps(i, k))) + &
+                            lf(i, k) * ejectice * qps(i, k)) * denomm1
+            hla(i, k) = hla(i, k - 1) + &
+                    (qpreca(i, k) * (-(1. - qta(i, k - 1)) * (cpv - cpd) * tp(i, k) - &
+                            lv(i, k) * ((1. - frac_s(i, k)) * qcld(i, k) + qpl(i, k)) - &
+                            (lv(i, k) + lf(i, k)) * (frac_s(i, k) * qcld(i, k) + qps(i, k))) + &
+                            lv(i, k) * ejectliq * qpl(i, k) + (lv(i, k) + lf(i, k)) * ejectice * qps(i, k)) * denomm1
+            qpl(i, k) = qpl(i, k) * (1. - ejectliq) * denomm1
+            qps(i, k) = qps(i, k) * (1. - ejectice) * denomm1
+            qcld(i, k) = qcld(i, k) * denomm1
+            qhsat(i, k) = qhsat(i, k) * (1. - qta(i, k)) / (1. - qta(i, k - 1))
+          END IF ! (k>=(icbs(i)+1))
         END DO ! i = 1, ncum
       ENDIF  ! (cvflag_prec_eject)
@@ -1542 +1526 @@
     END DO ! k = minorig + 1, nl
 
-!----------------------------------------------------------------------------
+    !----------------------------------------------------------------------------
 
   ELSE IF (icvflag_Tpa == 0) THEN! (icvflag_Tpa == 2) ELSE IF(icvflag_Tpa == 1)
 
-!----------------------------------------------------------------------------
-
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-! ori       IF(k.ge.(icb(i)+1))THEN
-      IF (k>=(icbs(i)+1)) THEN                                ! convect3
-        tg = t(i, k)
-        qg = qs(i, k)
-! debug       alv=lv0-clmcpv*(t(i,k)-t0)
-        alv = lv0 - clmcpv*(t(i,k)-273.15)
-
-! First iteration.
-
-! 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
-! 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)
-! ori          tg=max(tg,35.0)
-! debug        tc=tg-t0
-        tc = tg - 273.15
-        denom = 243.5 + tc
-        denom = max(denom, 1.0)                               ! convect3
-! ori          IF(tc.ge.0.0)THEN
-        es = 6.112*exp(17.67*tc/denom)
-! ori          else
-! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-! ori          endif
-        qg = eps*es/(p(i,k)-es*(1.-eps))
-
-! Second iteration.
-
-! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-! ori          s=1./s
-! 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)
-! ori          tg=max(tg,35.0)
-! debug        tc=tg-t0
-        tc = tg - 273.15
-        denom = 243.5 + tc
-        denom = max(denom, 1.0)                               ! convect3
-! ori          IF(tc.ge.0.0)THEN
-        es = 6.112*exp(17.67*tc/denom)
-! ori          else
-! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-! ori          endif
-        qg = eps*es/(p(i,k)-es*(1.-eps))
-
-! debug        alv=lv0-clmcpv*(t(i,k)-t0)
-        alv = lv0 - clmcpv*(t(i,k)-273.15)
-! PRINT*,'cpd dans convect2 ',cpd
-! PRINT*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
-! PRINT*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
-
-! ori c approximation here:
-! ori        tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-
-! convect3: no approximation:
-        IF (cvflag_ice) THEN
-          tp(i, k) = max(0., (ah0(i)-gz(i,k)-alv*qg)/(cpd+(cl-cpd)*qnk(i)))
-        ELSE
-          tp(i, k) = (ah0(i)-gz(i,k)-alv*qg)/(cpd+(cl-cpd)*qnk(i))
-        END IF
-
-        clw(i, k) = qnk(i) - qg
-        clw(i, k) = max(0.0, clw(i,k))
-        rg = qg/(1.-qnk(i))
-! ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
-! convect3: (qg utilise au lieu du vrai mixing ratio rg):
-        tvp(i, k) = tp(i, k)*(1.+qg/eps-qnk(i)) ! whole thing
-        IF (cvflag_ice) THEN
-          IF (clw(i,k)<1.E-11) THEN
-            tp(i, k) = tv(i, k)
-            tvp(i, k) = tv(i, k)
+    !----------------------------------------------------------------------------
+
+    DO k = minorig + 1, nl
+      DO i = 1, ncum
+        ! ori       IF(k.ge.(icb(i)+1))THEN
+        IF (k>=(icbs(i) + 1)) THEN                                ! convect3
+          tg = t(i, k)
+          qg = qs(i, k)
+          ! debug             alv=lv0-clmcpv*(t(i,k)-t0)
+          alv = lv0 - clmcpv * (t(i, k) - 273.15)
+
+          ! First iteration.
+
+          ! 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
+          ! 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)
+          ! ori        tg=max(tg,35.0)
+          ! debug              tc=tg-t0
+          tc = tg - 273.15
+          denom = 243.5 + tc
+          denom = max(denom, 1.0)                               ! convect3
+          ! ori        IF(tc.ge.0.0)THEN
+          es = 6.112 * exp(17.67 * tc / denom)
+          ! ori        else
+          ! ori                 es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori        endif
+          qg = eps * es / (p(i, k) - es * (1. - eps))
+
+          ! Second iteration.
+
+          ! ori        s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+          ! ori        s=1./s
+          ! 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)
+          ! ori        tg=max(tg,35.0)
+          ! debug              tc=tg-t0
+          tc = tg - 273.15
+          denom = 243.5 + tc
+          denom = max(denom, 1.0)                               ! convect3
+          ! ori        IF(tc.ge.0.0)THEN
+          es = 6.112 * exp(17.67 * tc / denom)
+          ! ori        else
+          ! ori                 es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori        endif
+          qg = eps * es / (p(i, k) - es * (1. - eps))
+
+          ! debug              alv=lv0-clmcpv*(t(i,k)-t0)
+          alv = lv0 - clmcpv * (t(i, k) - 273.15)
+          ! PRINT*,'cpd dans convect2 ',cpd
+          ! PRINT*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
+          ! PRINT*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
+
+          ! ori c approximation here:
+          ! ori        tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
+
+          ! convect3: no approximation:
+          IF (cvflag_ice) THEN
+            tp(i, k) = max(0., (ah0(i) - gz(i, k) - alv * qg) / (cpd + (cl - cpd) * qnk(i)))
+          ELSE
+            tp(i, k) = (ah0(i) - gz(i, k) - alv * qg) / (cpd + (cl - cpd) * qnk(i))
           END IF
-        END IF
-!jyg<
-!!      END IF  ! Endif moved to the end of the loop
-!>jyg
-
-      IF (cvflag_ice) THEN
-!CR:attention boucle en klon dans Icefrac
-! Call Icefrac(t,clw,qi,nl,nloc)
-        IF (t(i,k)>263.15) THEN
-          qi(i, k) = 0.
-        ELSE
-          IF (t(i,k)<243.15) THEN
-            qi(i, k) = clw(i, k)
-          ELSE
-            fracg = (263.15-t(i,k))/20
-            qi(i, k) = clw(i, k)*fracg
+
+          clw(i, k) = qnk(i) - qg
+          clw(i, k) = max(0.0, clw(i, k))
+          rg = qg / (1. - qnk(i))
+          ! ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
+          ! convect3: (qg utilise au lieu du vrai mixing ratio rg):
+          tvp(i, k) = tp(i, k) * (1. + qg / eps - qnk(i)) ! whole thing
+          IF (cvflag_ice) THEN
+            IF (clw(i, k)<1.E-11) THEN
+              tp(i, k) = tv(i, k)
+              tvp(i, k) = tv(i, k)
+            END IF
           END IF
-        END IF
-!CR: fin test
-        IF (t(i,k)<263.15) THEN
-!CR: on commente les calculs d'Arnaud car division par zero
-! nouveau calcul propose par JYG
-!       alv=lv0-clmcpv*(t(i,k)-273.15)
-!       alf=lf0-clmci*(t(i,k)-273.15)
-!       tg=tp(i,k)
-!       tc=tp(i,k)-273.15
-!       denom=243.5+tc
-!       do j=1,3
-! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-! il faudra que esi vienne en argument de la convection
-! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!        tbis=t(i,k)+(tp(i,k)-tg)
-!        esi=exp(23.33086-(6111.72784/tbis) + &
-!                       0.15215*log(tbis))
-!        qsat_new=eps*esi/(p(i,k)-esi*(1.-eps))
-!        snew=cpd*(1.-qnk(i))+cl*qnk(i)+alv*alv*qsat_new/ &
-!                                       (rrv*tbis*tbis)
-!        snew=1./snew
-!        PRINT*,esi,qsat_new,snew,'esi,qsat,snew'
-!        tp(i,k)=tg+(alf*qi(i,k)+alv*qg*(1.-(esi/es)))*snew
-!        PRINT*,k,tp(i,k),qnk(i),'avec glace'
-!        PRINT*,'tpNAN',tg,alf,qi(i,k),alv,qg,esi,es,snew
-!       enddo
-
-          alv = lv0 - clmcpv*(t(i,k)-273.15)
-          alf = lf0 + clmci*(t(i,k)-273.15)
-          als = alf + alv
-          tg = tp(i, k)
-          tp(i, k) = t(i, k)
-          DO j = 1, 3
-            esi = exp(23.33086-(6111.72784/tp(i,k))+0.15215*log(tp(i,k)))
-            qsat_new = eps*esi/(p(i,k)-esi*(1.-eps))
-            snew = cpd*(1.-qnk(i)) + cl*qnk(i) + alv*als*qsat_new/ &
-                                                 (rrv*tp(i,k)*tp(i,k))
-            snew = 1./snew
-! c             PRINT*,esi,qsat_new,snew,'esi,qsat,snew'
-            tp(i, k) = tp(i, k) + &
-                       ((cpd*(1.-qnk(i))+cl*qnk(i))*(tg-tp(i,k)) + &
-                        alv*(qg-qsat_new)+alf*qi(i,k))*snew
-! PRINT*,k,tp(i,k),qsat_new,qnk(i),qi(i,k), &
-!              'k,tp,q,qt,qi avec glace'
-          END DO
-
-!CR:reprise du code AJ
-          clw(i, k) = qnk(i) - qsat_new
-          clw(i, k) = max(0.0, clw(i,k))
-          tvp(i, k) = max(0., tp(i,k)*(1.+qsat_new/eps-qnk(i)))
-! PRINT*,tvp(i,k),'tvp'
-        END IF
-        IF (clw(i,k)<1.E-11) THEN
-          tp(i, k) = tv(i, k)
-          tvp(i, k) = tv(i, k)
-        END IF
-      END IF ! (cvflag_ice)
-!jyg<
-      END IF ! (k>=(icbs(i)+1))
-!>jyg
-    END DO
-  END DO
-
-!----------------------------------------------------------------------------
+          !jyg<
+          !!      END IF  ! Endif moved to the end of the loop
+          !>jyg
+
+          IF (cvflag_ice) THEN
+            !CR:attention boucle en klon dans Icefrac
+            ! Call Icefrac(t,clw,qi,nl,nloc)
+            IF (t(i, k)>263.15) THEN
+              qi(i, k) = 0.
+            ELSE
+              IF (t(i, k)<243.15) THEN
+                qi(i, k) = clw(i, k)
+              ELSE
+                fracg = (263.15 - t(i, k)) / 20
+                qi(i, k) = clw(i, k) * fracg
+              END IF
+            END IF
+            !CR: fin test
+            IF (t(i, k)<263.15) THEN
+              !CR: on commente les calculs d'Arnaud car division par zero
+              ! nouveau calcul propose par JYG
+              !       alv=lv0-clmcpv*(t(i,k)-273.15)
+              !       alf=lf0-clmci*(t(i,k)-273.15)
+              !       tg=tp(i,k)
+              !       tc=tp(i,k)-273.15
+              !       denom=243.5+tc
+              !       do j=1,3
+              ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+              ! il faudra que esi vienne en argument de la convection
+              ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+              !        tbis=t(i,k)+(tp(i,k)-tg)
+              !        esi=exp(23.33086-(6111.72784/tbis) + &
+              !                       0.15215*log(tbis))
+              !        qsat_new=eps*esi/(p(i,k)-esi*(1.-eps))
+              !        snew=cpd*(1.-qnk(i))+cl*qnk(i)+alv*alv*qsat_new/ &
+              !                                       (rrv*tbis*tbis)
+              !        snew=1./snew
+              !        PRINT*,esi,qsat_new,snew,'esi,qsat,snew'
+              !        tp(i,k)=tg+(alf*qi(i,k)+alv*qg*(1.-(esi/es)))*snew
+              !        PRINT*,k,tp(i,k),qnk(i),'avec glace'
+              !        PRINT*,'tpNAN',tg,alf,qi(i,k),alv,qg,esi,es,snew
+              !       enddo
+
+              alv = lv0 - clmcpv * (t(i, k) - 273.15)
+              alf = lf0 + clmci * (t(i, k) - 273.15)
+              als = alf + alv
+              tg = tp(i, k)
+              tp(i, k) = t(i, k)
+              DO j = 1, 3
+                esi = exp(23.33086 - (6111.72784 / tp(i, k)) + 0.15215 * log(tp(i, k)))
+                qsat_new = eps * esi / (p(i, k) - esi * (1. - eps))
+                snew = cpd * (1. - qnk(i)) + cl * qnk(i) + alv * als * qsat_new / &
+                        (rrv * tp(i, k) * tp(i, k))
+                snew = 1. / snew
+                ! c             PRINT*,esi,qsat_new,snew,'esi,qsat,snew'
+                tp(i, k) = tp(i, k) + &
+                        ((cpd * (1. - qnk(i)) + cl * qnk(i)) * (tg - tp(i, k)) + &
+                                alv * (qg - qsat_new) + alf * qi(i, k)) * snew
+                ! PRINT*,k,tp(i,k),qsat_new,qnk(i),qi(i,k), &
+                !              'k,tp,q,qt,qi avec glace'
+              END DO
+
+              !CR:reprise du code AJ
+              clw(i, k) = qnk(i) - qsat_new
+              clw(i, k) = max(0.0, clw(i, k))
+              tvp(i, k) = max(0., tp(i, k) * (1. + qsat_new / eps - qnk(i)))
+              ! PRINT*,tvp(i,k),'tvp'
+            END IF
+            IF (clw(i, k)<1.E-11) THEN
+              tp(i, k) = tv(i, k)
+              tvp(i, k) = tv(i, k)
+            END IF
+          END IF ! (cvflag_ice)
+          !jyg<
+        END IF ! (k>=(icbs(i)+1))
+        !>jyg
+      END DO
+    END DO
+
+    !----------------------------------------------------------------------------
 
   ENDIF ! (icvflag_Tpa == 2) ELSEIF (icvflag_Tpa == 1) ELSE (icvflag_Tpa == 0)
 
-!----------------------------------------------------------------------------
-
-! =====================================================================
-! --- SET THE PRECIPITATION EFFICIENCIES 
-! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
-! =====================================================================
+  !----------------------------------------------------------------------------
+
+  ! =====================================================================
+  ! --- SET THE PRECIPITATION EFFICIENCIES
+  ! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
+  ! =====================================================================
 
   IF (flag_epkeorig/=1) THEN
     DO k = 1, nl ! convect3
       DO i = 1, ncum
-!jyg<
-       IF(k>=icb(i)) THEN
-!>jyg
-         pden = ptcrit - pbcrit
-         ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax
-         ep(i, k) = max(ep(i,k), 0.0)
-         ep(i, k) = min(ep(i,k), epmax)
-!!         sigp(i, k) = spfac  ! jyg
+        !jyg<
+        IF(k>=icb(i)) THEN
+          !>jyg
+          pden = ptcrit - pbcrit
+          ep(i, k) = (plcl(i) - p(i, k) - pbcrit) / pden * epmax
+          ep(i, k) = max(ep(i, k), 0.0)
+          ep(i, k) = min(ep(i, k), epmax)
+          !!         sigp(i, k) = spfac  ! jyg
         ENDIF   ! (k>=icb(i))
       END DO
@@ -1733 +1717 @@
       DO i = 1, ncum
         IF(k>=icb(i)) THEN
-!!        IF (k>=(nk(i)+1)) THEN
-!>jyg
+          !!        IF (k>=(nk(i)+1)) THEN
+          !>jyg
           tca = tp(i, k) - t0
           IF (tca>=0.0) THEN
             elacrit = elcrit
           ELSE
-            elacrit = elcrit*(1.0-tca/tlcrit)
+            elacrit = elcrit * (1.0 - tca / tlcrit)
           END IF
           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), epmax)
-!!          sigp(i, k) = spfac  ! jyg
+          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), epmax)
+          !!          sigp(i, k) = spfac  ! jyg
         END IF  ! (k>=icb(i))
       END DO
@@ -1751 +1735 @@
   END IF
 
-!   =========================================================================
+  !   =========================================================================
   IF (prt_level >= 10) THEN
-    print *,'cv3_undilute2.1. tp(1,k), tvp(1,k) ', &
-                          (k, tp(1,k), tvp(1,k), k = 1,nl)
+    print *, 'cv3_undilute2.1. tp(1,k), tvp(1,k) ', &
+            (k, tp(1, k), tvp(1, k), k = 1, nl)
   ENDIF
 
-! =====================================================================
-! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
-! --- VIRTUAL TEMPERATURE
-! =====================================================================
-
-! dans convect3, tvp est calcule en une seule fois, et sans retirer
-! l'eau condensee (~> reversible CAPE)
-
-! ori      do 340 k=minorig+1,nl
-! ori        do 330 i=1,ncum
-! ori        IF(k.ge.(icb(i)+1))THEN
-! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
-! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
-! oric         PRINT*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
-! ori        endif
-! ori 330    continue
-! ori 340  continue
-
-! ori      do 350 i=1,ncum
-! ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
-! ori 350  continue
+  ! =====================================================================
+  ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
+  ! --- VIRTUAL TEMPERATURE
+  ! =====================================================================
+
+  ! dans convect3, tvp est calcule en une seule fois, et sans retirer
+  ! l'eau condensee (~> reversible CAPE)
+
+  ! ori      do 340 k=minorig+1,nl
+  ! ori        do 330 i=1,ncum
+  ! ori        IF(k.ge.(icb(i)+1))THEN
+  ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
+  ! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
+  ! oric         PRINT*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
+  ! ori        endif
+  ! ori 330    continue
+  ! ori 340  continue
+
+  ! ori      do 350 i=1,ncum
+  ! ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
+  ! ori 350  continue
 
   DO i = 1, ncum                                           ! convect3
@@ -1783 +1767 @@
   END DO                                                   ! convect3
 
-! =====================================================================
-! --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
-! =====================================================================
-
-! -- this is for convect3 only:
-
-! first estimate of buoyancy:
-
-!jyg : k-loop outside i-loop (07042015)
+  ! =====================================================================
+  ! --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
+  ! =====================================================================
+
+  ! -- this is for convect3 only:
+
+  ! first estimate of buoyancy:
+
+  !jyg : k-loop outside i-loop (07042015)
   DO k = 1, nl
     DO i = 1, ncum
@@ -1798 +1782 @@
   END DO
 
-! set buoyancy=buoybase for all levels below base
-! for safety, set buoy(icb)=buoybase
-
-!jyg : k-loop outside i-loop (07042015)
+  ! set buoyancy=buoybase for all levels below base
+  ! for safety, set buoy(icb)=buoybase
+
+  !jyg : k-loop outside i-loop (07042015)
   DO k = 1, nl
     DO i = 1, ncum
-      IF ((k>=icb(i)) .AND. (k<=nl) .AND. (p(i,k)>=pbase(i))) THEN
+      IF ((k>=icb(i)) .AND. (k<=nl) .AND. (p(i, k)>=pbase(i))) THEN
         buoy(i, k) = buoybase(i)
       END IF
@@ -1810 +1794 @@
   END DO
   DO i = 1, ncum
-!    buoy(icb(i),k)=buoybase(i)
+    !    buoy(icb(i),k)=buoybase(i)
     buoy(i, icb(i)) = buoybase(i)
   END DO
 
-! -- end convect3
-
-! =====================================================================
-! --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
-! --- LEVEL OF NEUTRAL BUOYANCY
-! =====================================================================
-
-! -- this is for convect3 only:
+  ! -- end convect3
+
+  ! =====================================================================
+  ! --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
+  ! --- LEVEL OF NEUTRAL BUOYANCY
+  ! =====================================================================
+
+  ! -- this is for convect3 only:
 
   DO i = 1, ncum
@@ -1829 +1813 @@
 
 
-! --    iposit(i) = first level, above icb, with positive buoyancy
+  ! --    iposit(i) = first level, above icb, with positive buoyancy
   DO k = 1, nl - 1
     DO i = 1, ncum
-      IF (k>=icb(i) .AND. buoy(i,k)>0.) THEN
+      IF (k>=icb(i) .AND. buoy(i, k)>0.) THEN
         iposit(i) = min(iposit(i), k)
       END IF
@@ -1846 +1830 @@
   DO k = 1, nl - 1
     DO i = 1, ncum
-      IF ((k>=iposit(i)) .AND. (buoy(i,k)<dtovsh)) THEN
+      IF ((k>=iposit(i)) .AND. (buoy(i, k)<dtovsh)) THEN
         inb(i) = min(inb(i), k)
       END IF
@@ -1852 +1836 @@
   END DO
 
-!CR fix computation of inb
-!keep flag or modify in all cases?
+  !CR fix computation of inb
+  !keep flag or modify in all cases?
   IF (iflag_mix_adiab==1) THEN
+    DO i = 1, ncum
+      cape(i) = 0.
+      inb(i) = icb(i) + 1
+    ENDDO
+
+    DO k = 2, nl
+      DO i = 1, ncum
+        IF ((k>=iposit(i))) THEN
+          deltap = min(plcl(i), ph(i, k - 1)) - min(plcl(i), ph(i, k))
+          cape(i) = cape(i) + rrd * buoy(i, k - 1) * deltap / p(i, k - 1)
+          IF (cape(i)>0.) THEN
+            inb(i) = max(inb(i), k)
+          END IF
+        ENDIF
+      ENDDO
+    ENDDO
+
+    !  DO i = 1, ncum
+    !     PRINT*,"inb",inb(i)
+    !  ENDDO
+
+  ENDIF
+
+  ! -- end convect3
+
+  ! ori      do 510 i=1,ncum
+  ! ori        cape(i)=0.0
+  ! ori        capem(i)=0.0
+  ! ori        inb(i)=icb(i)+1
+  ! ori        inb1(i)=inb(i)
+  ! ori 510  continue
+
+  ! Originial Code
+
+  !    do 530 k=minorig+1,nl-1
+  !     do 520 i=1,ncum
+  !      IF(k.ge.(icb(i)+1))THEN
+  !       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+  !       byp=(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
+  !     byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
+  !     cape(i)=capem(i)+byp
+  !     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
+
+  !    K Emanuel fix
+
+  !    CALL zilch(byp,ncum)
+  !    do 530 k=minorig+1,nl-1
+  !     do 520 i=1,ncum
+  !      IF(k.ge.(icb(i)+1))THEN
+  !       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+  !       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)
+  !        byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+  !       endif
+  !      endif
+  !520    continue
+  !530  continue
+  !    do 540 i=1,ncum
+  !     inb(i)=max(inb(i),inb1(i))
+  !     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
+
+  ! J Teixeira fix
+
+  ! ori      CALL zilch(byp,ncum)
+  ! ori      do 515 i=1,ncum
+  ! ori        lcape(i)=.TRUE.
+  ! ori 515  continue
+  ! ori      do 530 k=minorig+1,nl-1
+  ! ori        do 520 i=1,ncum
+  ! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
+  ! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
+  ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+  ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+  ! ori            cape(i)=cape(i)+by
+  ! ori            IF(by.ge.0.0)inb1(i)=k+1
+  ! ori            IF(cape(i).gt.0.0)THEN
+  ! ori              inb(i)=k+1
+  ! ori              capem(i)=cape(i)
+  ! ori            endif
+  ! ori          endif
+  ! ori 520    continue
+  ! ori 530  continue
+  ! ori      do 540 i=1,ncum
+  ! ori          cape(i)=capem(i)+byp(i)
+  ! ori          defrac=capem(i)-cape(i)
+  ! ori          defrac=max(defrac,0.001)
+  ! ori          frac(i)=-cape(i)/defrac
+  ! ori          frac(i)=min(frac(i),1.0)
+  ! ori          frac(i)=max(frac(i),0.0)
+  ! ori 540  continue
+
+  ! --------------------------------------------------------------------
+  !   Prevent convection when top is too hot
+  ! --------------------------------------------------------------------
   DO i = 1, ncum
-     cape(i)=0.
-     inb(i)=icb(i)+1
+    IF (t(i, inb(i)) > T_top_max) iflag(i) = 10
   ENDDO
-  
-  DO k = 2, nl 
-    DO i = 1, ncum
-       IF ((k>=iposit(i))) THEN
-       deltap = min(plcl(i), ph(i,k-1)) - min(plcl(i), ph(i,k))
-       cape(i) = cape(i) + rrd*buoy(i, k-1)*deltap/p(i, k-1)
-       IF (cape(i)>0.) THEN
-        inb(i) = max(inb(i), k)
-       END IF
-       ENDIF
-    ENDDO
-  ENDDO
-
-!  DO i = 1, ncum
-!     PRINT*,"inb",inb(i)
-!  ENDDO
-
-  ENDIF
-
-! -- end convect3
-
-! ori      do 510 i=1,ncum
-! ori        cape(i)=0.0
-! ori        capem(i)=0.0
-! ori        inb(i)=icb(i)+1
-! ori        inb1(i)=inb(i)
-! ori 510  continue
-
-! Originial Code
-
-!    do 530 k=minorig+1,nl-1
-!     do 520 i=1,ncum
-!      IF(k.ge.(icb(i)+1))THEN
-!       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-!       byp=(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
-!     byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
-!     cape(i)=capem(i)+byp
-!     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
-
-!    K Emanuel fix
-
-!    CALL zilch(byp,ncum)
-!    do 530 k=minorig+1,nl-1
-!     do 520 i=1,ncum
-!      IF(k.ge.(icb(i)+1))THEN
-!       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-!       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)
-!        byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-!       endif
-!      endif
-!520    continue
-!530  continue
-!    do 540 i=1,ncum
-!     inb(i)=max(inb(i),inb1(i))
-!     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
-
-! J Teixeira fix
-
-! ori      CALL zilch(byp,ncum)
-! ori      do 515 i=1,ncum
-! ori        lcape(i)=.TRUE.
-! ori 515  continue
-! ori      do 530 k=minorig+1,nl-1
-! ori        do 520 i=1,ncum
-! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
-! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
-! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-! ori            cape(i)=cape(i)+by
-! ori            IF(by.ge.0.0)inb1(i)=k+1
-! ori            IF(cape(i).gt.0.0)THEN
-! ori              inb(i)=k+1
-! ori              capem(i)=cape(i)
-! ori            endif
-! ori          endif
-! ori 520    continue
-! ori 530  continue
-! ori      do 540 i=1,ncum
-! ori          cape(i)=capem(i)+byp(i)
-! ori          defrac=capem(i)-cape(i)
-! ori          defrac=max(defrac,0.001)
-! ori          frac(i)=-cape(i)/defrac
-! ori          frac(i)=min(frac(i),1.0)
-! ori          frac(i)=max(frac(i),0.0)
-! ori 540  continue
-
-! --------------------------------------------------------------------
-!   Prevent convection when top is too hot
-! --------------------------------------------------------------------
-  DO i = 1,ncum
-    IF (t(i,inb(i)) > T_top_max) iflag(i) = 10
-  ENDDO
-
-! =====================================================================
-! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
-! =====================================================================
+
+  ! =====================================================================
+  ! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
+  ! =====================================================================
 
   DO k = 1, nl
@@ -1987 +1971 @@
   END DO
 
-!jyg : cvflag_ice test outside the loops (07042015)
+  !jyg : cvflag_ice test outside the loops (07042015)
 
   IF (cvflag_ice) THEN
 
-  IF (cvflag_prec_eject) THEN
-!!    DO k = minorig + 1, nl
-!!      DO i = 1, ncum
-!!        IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
-!!          frac_s(i,k) = qi(i,k)/max(clw(i,k),smallestreal)    
-!!          frac_s(i,k) = 1. - (qpl(i,k)+(1.-frac_s(i,k))*qcld(i,k))/max(clw(i,k),smallestreal)    
-!!        END IF
-!!      END DO
-!!    END DO
-  ELSE    ! (cvflag_prec_eject)
+    IF (cvflag_prec_eject) THEN
+      !!    DO k = minorig + 1, nl
+      !!      DO i = 1, ncum
+      !!        IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
+      !!          frac_s(i,k) = qi(i,k)/max(clw(i,k),smallestreal)
+      !!          frac_s(i,k) = 1. - (qpl(i,k)+(1.-frac_s(i,k))*qcld(i,k))/max(clw(i,k),smallestreal)
+      !!        END IF
+      !!      END DO
+      !!    END DO
+    ELSE    ! (cvflag_prec_eject)
+      DO k = minorig + 1, nl
+        DO i = 1, ncum
+          IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
+            !jyg< frac computation moved to beginning of cv3_undilute2.
+            !     kept here for compatibility test with CMip6 version
+            frac_s(i, k) = 1. - (t(i, k) - 243.15) / (263.15 - 243.15)
+            frac_s(i, k) = min(max(frac_s(i, k), 0.0), 1.0)
+          END IF
+        END DO
+      END DO
+    ENDIF  ! (cvflag_prec_eject) ELSE
     DO k = minorig + 1, nl
       DO i = 1, ncum
         IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
-!jyg< frac computation moved to beginning of cv3_undilute2.
-!     kept here for compatibility test with CMip6 version
-          frac_s(i, k) = 1. - (t(i,k)-243.15)/(263.15-243.15)
-          frac_s(i, k) = min(max(frac_s(i,k),0.0), 1.0)
+          !!          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac_s(i,k)*lf(i,k))* &     !!jygprl
+          !!                              ep(i, k)*clw(i, k)                                    !!jygprl
+          hp(i, k) = hla(i, k - 1) + (lv(i, k) + (cpd - cpv) * t(i, k) + frac_s(i, k) * lf(i, k)) * &   !!jygprl
+                  ep(i, k) * clw(i, k)                                      !!jygprl
         END IF
       END DO
     END DO
-  ENDIF  ! (cvflag_prec_eject) ELSE
+
+  ELSE   ! (cvflag_ice)
+
     DO k = minorig + 1, nl
       DO i = 1, ncum
         IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
-!!          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac_s(i,k)*lf(i,k))* &     !!jygprl
-!!                              ep(i, k)*clw(i, k)                                    !!jygprl
-          hp(i, k) = hla(i,k-1) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac_s(i,k)*lf(i,k))* &   !!jygprl
-                              ep(i, k)*clw(i, k)                                      !!jygprl
+          !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
       END DO
     END DO
 
-  ELSE   ! (cvflag_ice)
-
-    DO k = minorig + 1, nl
-      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
-      END DO
-    END DO
-
   END IF  ! (cvflag_ice)
 
-
 END SUBROUTINE cv3_undilute2
 
-SUBROUTINE cv3_closure(nloc, ncum, nd, icb, inb, &
-                       pbase, p, ph, tv, buoy, &
-                       sig, w0, cape, m, iflag)
+SUBROUTINE cv3_closure(nloc, ncum, nd, icb, inb, pbase, p, ph, tv, buoy, &
+        sig, w0, cape, m, iflag)
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
-! ===================================================================
-! ---  CLOSURE OF CONVECT3
-
-! vectorization: S. Bony
-! ===================================================================
-
-  include "cvthermo.h"
-  include "cv3param.h"
-
-!input:
+  ! ===================================================================
+  ! ---  CLOSURE OF CONVECT3
+
+  ! vectorization: S. Bony
+  ! ===================================================================
+
+  !input:
   INTEGER ncum, nd, nloc
   INTEGER icb(nloc), inb(nloc)
   REAL pbase(nloc)
-  REAL p(nloc, nd), ph(nloc, nd+1)
+  REAL p(nloc, nd), ph(nloc, nd + 1)
   REAL tv(nloc, nd), buoy(nloc, nd)
 
-!input/output:
+  !input/output:
   REAL sig(nloc, nd), w0(nloc, nd)
   INTEGER iflag(nloc)
 
-!output:
+  !output:
   REAL cape(nloc)
   REAL m(nloc, nd)
 
-!local variables:
+  !local variables:
   INTEGER i, j, k, icbmax
   REAL deltap, fac, w, amu
@@ -2080 +2062 @@
 
 
-! -------------------------------------------------------
-! -- Initialization
-! -------------------------------------------------------
+  ! -------------------------------------------------------
+  ! -- Initialization
+  ! -------------------------------------------------------
 
   DO k = 1, nl
@@ -2090 +2072 @@
   END DO
 
-! -------------------------------------------------------
-! -- Reset sig(i) and w0(i) for i>inb and i<icb
-! -------------------------------------------------------
-
-! update sig and w0 above LNB:
+  ! -------------------------------------------------------
+  ! -- Reset sig(i) and w0(i) for i>inb and i<icb
+  ! -------------------------------------------------------
+
+  ! update sig and w0 above LNB:
 
   DO k = 1, nl - 1
     DO i = 1, ncum
-      IF ((inb(i)<(nl-1)) .AND. (k>=(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)
+      IF ((inb(i)<(nl - 1)) .AND. (k>=(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)
       END IF
     END DO
   END DO
 
-! compute icbmax:
+  ! compute icbmax:
 
   icbmax = 2
@@ -2114 +2096 @@
   END DO
 
-! update sig and w0 below cloud base:
+  ! update sig and w0 below cloud base:
 
   DO k = 1, icbmax
     DO i = 1, ncum
       IF (k<=icb(i)) THEN
-        sig(i, k) = beta*sig(i, k) - &
-                    2.*alpha*buoy(i, icb(i))*buoy(i, icb(i))
-        sig(i, k) = max(sig(i,k), 0.0)
-        w0(i, k) = beta*w0(i, k)
+        sig(i, k) = beta * sig(i, k) - &
+                2. * alpha * buoy(i, icb(i)) * buoy(i, icb(i))
+        sig(i, k) = max(sig(i, k), 0.0)
+        w0(i, k) = beta * w0(i, k)
       END IF
     END DO
   END DO
 
-!!      IF(inb.lt.(nl-1))THEN
-!!         do 85 i=inb+1,nl-1
-!!            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
-!!     1              abs(buoy(inb))
-!!            sig(i)=max(sig(i),0.0)
-!!            w0(i)=beta*w0(i)
-!!   85    continue
-!!      end if
-
-!!      do 87 i=1,icb
-!!         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
-!!         sig(i)=max(sig(i),0.0)
-!!         w0(i)=beta*w0(i)
-!!   87 continue
-
-! -------------------------------------------------------------
-! -- Reset fractional areas of updrafts and w0 at initial time
-! -- and after 10 time steps of no convection
-! -------------------------------------------------------------
+  !!      IF(inb.lt.(nl-1))THEN
+  !!         do 85 i=inb+1,nl-1
+  !!            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
+  !!     1              abs(buoy(inb))
+  !!            sig(i)=max(sig(i),0.0)
+  !!            w0(i)=beta*w0(i)
+  !!   85    continue
+  !!      end if
+
+  !!      do 87 i=1,icb
+  !!         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
+  !!         sig(i)=max(sig(i),0.0)
+  !!         w0(i)=beta*w0(i)
+  !!   87 continue
+
+  ! -------------------------------------------------------------
+  ! -- Reset fractional areas of updrafts and w0 at initial time
+  ! -- and after 10 time steps of no convection
+  ! -------------------------------------------------------------
 
   DO k = 1, nl - 1
     DO i = 1, ncum
-      IF (sig(i,nd)<1.5 .OR. sig(i,nd)>12.0) THEN
+      IF (sig(i, nd)<1.5 .OR. sig(i, nd)>12.0) THEN
         sig(i, k) = 0.0
         w0(i, k) = 0.0
@@ -2156 +2138 @@
   END DO
 
-! -------------------------------------------------------------
-! -- Calculate convective available potential energy (cape),
-! -- vertical velocity (w), fractional area covered by
-! -- undilute updraft (sig), and updraft mass flux (m)
-! -------------------------------------------------------------
+  ! -------------------------------------------------------------
+  ! -- Calculate convective available potential energy (cape),
+  ! -- vertical velocity (w), fractional area covered by
+  ! -- undilute updraft (sig), and updraft mass flux (m)
+  ! -------------------------------------------------------------
 
   DO i = 1, ncum
@@ -2166 +2148 @@
   END DO
 
-! compute dtmin (minimum buoyancy between ICB and given level k):
+  ! compute dtmin (minimum buoyancy between ICB and given level k):
 
   DO i = 1, ncum
@@ -2177 +2159 @@
     DO k = 1, nl
       DO j = minorig, nl
-        IF ((k>=(icb(i)+1)) .AND. (k<=inb(i)) .AND. (j>=icb(i)) .AND. (j<=(k-1))) THEN
-          dtmin(i, k) = amin1(dtmin(i,k), buoy(i,j))
+        IF ((k>=(icb(i) + 1)) .AND. (k<=inb(i)) .AND. (j>=icb(i)) .AND. (j<=(k - 1))) THEN
+          dtmin(i, k) = amin1(dtmin(i, k), buoy(i, j))
         END IF
       END DO
@@ -2184 +2166 @@
   END DO
 
-! the interval on which cape is computed starts at pbase :
+  ! the interval on which cape is computed starts at pbase :
 
   DO k = 1, nl
     DO i = 1, ncum
 
-      IF ((k>=(icb(i)+1)) .AND. (k<=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)
+      IF ((k>=(icb(i) + 1)) .AND. (k<=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)
 
-! dtmin(i,k)=100.0
-! do 97 j=icb(i),k-1 ! mauvaise vectorisation
-! dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
-! 97     continue
-
-        sig(i, k) = beta*sig(i, k) + alpha*dtmin(i, k)*abs(dtmin(i,k))
-        sig(i, k) = max(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)
+        ! dtmin(i,k)=100.0
+        ! do 97 j=icb(i),k-1 ! mauvaise vectorisation
+        ! dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
+        ! 97     continue
+
+        sig(i, k) = beta * sig(i, k) + alpha * dtmin(i, k) * abs(dtmin(i, k))
+        sig(i, k) = max(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
       END IF
@@ -2215 +2197 @@
 
   DO 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))
-  END DO
-
-! ccc 3. Compute final cloud base mass flux and set iflag to 3 if
-! ccc    cloud base mass flux is exceedingly small and is decreasing (i.e. if
-! ccc    the final mass flux (cbmflast) is greater than the target mass flux
-! ccc    (cbmf) ??).
-! cc
-! c      do i = 1,ncum
-! c       cbmflast(i) = 0.
-! c      enddo
-! cc
-! c      do k= 1,nl
-! c       do i = 1,ncum
-! c        IF (k .ge. icb(i) .AND. k .le. inb(i)) THEN
-! c         cbmflast(i) = cbmflast(i)+M(i,k)
-! c        ENDIF
-! c       enddo
-! c      enddo
-! cc
-! c      do i = 1,ncum
-! c       IF (cbmflast(i) .lt. 1.e-6) THEN
-! c         iflag(i) = 3
-! c       ENDIF
-! c      enddo
-! cc
-! c      do k= 1,nl
-! c       do i = 1,ncum
-! c        IF (iflag(i) .ge. 3) THEN
-! c         M(i,k) = 0.
-! c         sig(i,k) = 0.
-! c         w0(i,k) = 0.
-! c        ENDIF
-! c       enddo
-! c      enddo
-! cc
-!!      cape=0.0
-!!      do 98 i=icb+1,inb
-!!         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
-!!         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
-!!         dcape=rrd*buoy(i-1)*deltap/p(i-1)
-!!         dlnp=deltap/p(i-1)
-!!         cape=max(0.0,cape)
-!!         sigold=sig(i)
-
-!!         dtmin=100.0
-!!         do 97 j=icb,i-1
-!!            dtmin=amin1(dtmin,buoy(j))
-!!   97    continue
-
-!!         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
-!!         sig(i)=max(sig(i),0.0)
-!!         sig(i)=amin1(sig(i),0.01)
-!!         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
-!!         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
-!!         amu=0.5*(sig(i)+sigold)*w
-!!         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
-!!         w0(i)=w
-!!   98 continue
-!!      w0(icb)=0.5*w0(icb+1)
-!!      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
-!!      sig(icb)=sig(icb+1)
-!!      sig(icb-1)=sig(icb)
-
+    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))
+  END DO
+
+  ! ccc 3. Compute final cloud base mass flux and set iflag to 3 if
+  ! ccc    cloud base mass flux is exceedingly small and is decreasing (i.e. if
+  ! ccc    the final mass flux (cbmflast) is greater than the target mass flux
+  ! ccc    (cbmf) ??).
+  ! cc
+  ! c      do i = 1,ncum
+  ! c       cbmflast(i) = 0.
+  ! c      enddo
+  ! cc
+  ! c      do k= 1,nl
+  ! c       do i = 1,ncum
+  ! c        IF (k .ge. icb(i) .AND. k .le. inb(i)) THEN
+  ! c         cbmflast(i) = cbmflast(i)+M(i,k)
+  ! c        ENDIF
+  ! c       enddo
+  ! c      enddo
+  ! cc
+  ! c      do i = 1,ncum
+  ! c       IF (cbmflast(i) .lt. 1.e-6) THEN
+  ! c         iflag(i) = 3
+  ! c       ENDIF
+  ! c      enddo
+  ! cc
+  ! c      do k= 1,nl
+  ! c       do i = 1,ncum
+  ! c        IF (iflag(i) .ge. 3) THEN
+  ! c         M(i,k) = 0.
+  ! c         sig(i,k) = 0.
+  ! c         w0(i,k) = 0.
+  ! c        ENDIF
+  ! c       enddo
+  ! c      enddo
+  ! cc
+  !!      cape=0.0
+  !!      do 98 i=icb+1,inb
+  !!         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
+  !!         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
+  !!         dcape=rrd*buoy(i-1)*deltap/p(i-1)
+  !!         dlnp=deltap/p(i-1)
+  !!         cape=max(0.0,cape)
+  !!         sigold=sig(i)
+
+  !!         dtmin=100.0
+  !!         do 97 j=icb,i-1
+  !!            dtmin=amin1(dtmin,buoy(j))
+  !!   97    continue
+
+  !!         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
+  !!         sig(i)=max(sig(i),0.0)
+  !!         sig(i)=amin1(sig(i),0.01)
+  !!         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
+  !!         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
+  !!         amu=0.5*(sig(i)+sigold)*w
+  !!         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
+  !!         w0(i)=w
+  !!   98 continue
+  !!      w0(icb)=0.5*w0(icb+1)
+  !!      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
+  !!      sig(icb)=sig(icb+1)
+  !!      sig(icb-1)=sig(icb)
 
 END SUBROUTINE cv3_closure
 
 SUBROUTINE cv3_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, &
-                      ph, t, rr, rs, u, v, tra, h, lv, lf, frac, qnk, &
-                      unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
-                      ment, qent, uent, vent, nent, sij, elij, ments, qents, traent)
+        ph, t, rr, rs, u, v, tra, h, lv, lf, frac, qnk, &
+        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
+        ment, qent, uent, vent, nent, sij, elij, ments, qents, traent)
   USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-! ---------------------------------------------------------------------
-! a faire:
-! - vectorisation de la partie normalisation des flux (do 789...)
-! ---------------------------------------------------------------------
-
-  include "cvthermo.h"
-  include "cv3param.h"
-
-!inputs:
-  INTEGER, INTENT (IN)                               :: ncum, nd, na, ntra, nloc
-  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb, nk
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig
-  REAL, DIMENSION (nloc), INTENT (IN)                :: qnk, unk, vnk
-  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, rr, rs
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: u, v
-  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: tra               ! input of convect3
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lv, h, hp
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lf, frac
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: tv, tvp, ep, clw
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: m                 ! input of convect3
-
-!outputs:
-  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: ment, qent
-  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: uent, vent
-  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: sij, elij
-  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT)  :: traent
-  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT)        :: ments, qents
-  INTEGER, DIMENSION (nloc, nd), INTENT (OUT)         :: nent
-
-!local variables:
+  ! ---------------------------------------------------------------------
+  ! a faire:
+  ! - vectorisation de la partie normalisation des flux (do 789...)
+  ! ---------------------------------------------------------------------
+
+  !inputs:
+  INTEGER, INTENT (IN) :: ncum, nd, na, ntra, nloc
+  INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb, nk
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig
+  REAL, DIMENSION (nloc), INTENT (IN) :: qnk, unk, vnk
+  REAL, DIMENSION (nloc, nd + 1), INTENT (IN) :: ph
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, rr, rs
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: u, v
+  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: tra               ! input of convect3
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: lv, h, hp
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: lf, frac
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: tv, tvp, ep, clw
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: m                 ! input of convect3
+
+  !outputs:
+  REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: ment, qent
+  REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: uent, vent
+  REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: sij, elij
+  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent
+  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT) :: ments, qents
+  INTEGER, DIMENSION (nloc, nd), INTENT (OUT) :: nent
+
+  !local variables:
   INTEGER i, j, k, il, im, jm
   INTEGER num1, num2
@@ -2335 +2315 @@
   LOGICAL lwork(nloc)
 
-! =====================================================================
-! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-! =====================================================================
-
-! ori        do 360 i=1,ncum*nlp
+  ! =====================================================================
+  ! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
+  ! =====================================================================
+
+  ! ori        do 360 i=1,ncum*nlp
   DO j = 1, nl
     DO i = 1, ncum
       nent(i, j) = 0
-! in convect3, m is computed in cv3_closure
-! ori          m(i,1)=0.0
-    END DO
-  END DO
-
-! ori      do 400 k=1,nlp
-! ori       do 390 j=1,nlp
+      ! in convect3, m is computed in cv3_closure
+      ! ori          m(i,1)=0.0
+    END DO
+  END DO
+
+  ! ori      do 400 k=1,nlp
+  ! ori       do 390 j=1,nlp
   DO j = 1, nl
     DO k = 1, nl
@@ -2357 +2337 @@
         vent(i, k, j) = v(i, j)
         elij(i, k, j) = 0.0
-!ym            ment(i,k,j)=0.0
-!ym            sij(i,k,j)=0.0
+        !ym            ment(i,k,j)=0.0
+        !ym            sij(i,k,j)=0.0
       END DO
     END DO
   END DO
 
-!ym
+  !ym
   ment(1:ncum, 1:nd, 1:nd) = 0.0
   sij(1:ncum, 1:nd, 1:nd) = 0.0
 
-!AC!      do k=1,ntra
-!AC!       do j=1,nd  ! instead nlp
-!AC!        do i=1,nd ! instead nlp
-!AC!         do il=1,ncum
-!AC!            traent(il,i,j,k)=tra(il,j,k)
-!AC!         enddo
-!AC!        enddo
-!AC!       enddo
-!AC!      enddo
+  !AC!      do k=1,ntra
+  !AC!       do j=1,nd  ! instead nlp
+  !AC!        do i=1,nd ! instead nlp
+  !AC!         do il=1,ncum
+  !AC!            traent(il,i,j,k)=tra(il,j,k)
+  !AC!         enddo
+  !AC!        enddo
+  !AC!       enddo
+  !AC!      enddo
   zm(:, :) = 0.
 
-! =====================================================================
-! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
-! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
-! --- FRACTION (sij)
-! =====================================================================
+  ! =====================================================================
+  ! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
+  ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
+  ! --- FRACTION (sij)
+  ! =====================================================================
 
   DO i = minorig + 1, nl
@@ -2388 +2368 @@
     DO j = minorig, nl
       DO il = 1, ncum
-        IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)-1)) .AND. (j<=inb(il))) THEN
-
-          rti = qnk(il) - 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)
-
+        IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il) - 1)) .AND. (j<=inb(il))) THEN
+
+          rti = qnk(il) - 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)
 
           IF (cvflag_ice) THEN
-! PRINT*,cvflag_ice,'cvflag_ice dans do 700'
-            IF (t(il,j)<=263.15) THEN
-              bf2 = 1. + (lf(il,j)+lv(il,j))*(lv(il,j)+frac(il,j)* &
-                   lf(il,j))*rs(il, j)/(rrv*t(il,j)*t(il,j)*cpd)
+            ! PRINT*,cvflag_ice,'cvflag_ice dans do 700'
+            IF (t(il, j)<=263.15) THEN
+              bf2 = 1. + (lf(il, j) + lv(il, j)) * (lv(il, j) + frac(il, j) * &
+                      lf(il, j)) * rs(il, j) / (rrv * t(il, j) * t(il, j) * cpd)
             END IF
           END IF
 
-          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)
+          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)<0.01) dei = 0.01
-          sij(il, i, j) = anum/dei
+          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))
+          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<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
 
             IF (cvflag_ice) THEN
-              anum = anum - (lv(il,j)+frac(il,j)*lf(il,j))*(rti-rs(il,j)-cwat*bf2)
-              denom = denom + (lv(il,j)+frac(il,j)*lf(il,j))*(rr(il,i)-rti)
+              anum = anum - (lv(il, j) + frac(il, j) * lf(il, j)) * (rti - rs(il, j) - cwat * bf2)
+              denom = denom + (lv(il, j) + frac(il, j) * lf(il, j)) * (rr(il, i) - rti)
             ELSE
-              anum = anum - lv(il, j)*(rti-rs(il,j)-cwat*bf2)
-              denom = denom + lv(il, j)*(rr(il,i)-rti)
+              anum = anum - lv(il, j) * (rti - rs(il, j) - cwat * bf2)
+              denom = denom + lv(il, j) * (rr(il, i) - rti)
             END IF
 
             IF (abs(denom)<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
+            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)>0.0 .AND. sij(il,i,j)<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))*unk(il)
-            vent(il, i, j) = sij(il, i, j)*v(il, i) + (1.-sij(il,i,j))*vnk(il)
-!!!!      do k=1,ntra
-!!!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
-!!!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
-!!!!      END DO
+          IF (sij(il, i, j)>0.0 .AND. sij(il, i, j)<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)) * unk(il)
+            vent(il, i, j) = sij(il, i, j) * v(il, i) + (1. - sij(il, i, j)) * vnk(il)
+            !!!!      do k=1,ntra
+            !!!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+            !!!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
+            !!!!      END DO
             elij(il, i, j) = altem
-            elij(il, i, j) = max(0.0, elij(il,i,j))
-            ment(il, i, j) = m(il, i)/(1.-sij(il,i,j))
+            elij(il, i, j) = max(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) = max(0.0, sij(il,i,j))
-          sij(il, i, j) = amin1(1.0, sij(il,i,j))
+          sij(il, i, j) = max(0.0, sij(il, i, j))
+          sij(il, i, j) = amin1(1.0, sij(il, i, j))
         END IF ! new
       END DO
     END DO
 
-!AC!       do k=1,ntra
-!AC!        do j=minorig,nl
-!AC!         do il=1,ncum
-!AC!          IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
-!AC!     :       (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
-!AC!            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
-!AC!     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
-!AC!          endif
-!AC!         enddo
-!AC!        enddo
-!AC!       enddo
-
-
-! ***   if no air can entrain at level i assume that updraft detrains  ***
-! ***   at that level and calculate detrained air flux and properties  ***
-
-
-! @      do 170 i=icb(il),inb(il)
+    !AC!       do k=1,ntra
+    !AC!        do j=minorig,nl
+    !AC!         do il=1,ncum
+    !AC!          IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
+    !AC!     :       (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
+    !AC!            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+    !AC!     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
+    !AC!          endif
+    !AC!         enddo
+    !AC!        enddo
+    !AC!       enddo
+
+
+    ! ***   if no air can entrain at level i assume that updraft detrains  ***
+    ! ***   at that level and calculate detrained air flux and properties  ***
+
+
+    ! @      do 170 i=icb(il),inb(il)
 
     DO il = 1, ncum
-      IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
-! @      IF(nent(il,i).EQ.0)THEN
+      IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il, i)==0)) THEN
+        ! @      IF(nent(il,i).EQ.0)THEN
         ment(il, i, i) = m(il, i)
-        qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
+        qent(il, i, i) = qnk(il) - ep(il, i) * clw(il, i)
         uent(il, i, i) = unk(il)
         vent(il, i, i) = vnk(il)
         elij(il, i, i) = clw(il, i)
-! MAF      sij(il,i,i)=1.0
+        ! MAF      sij(il,i,i)=1.0
         sij(il, i, i) = 0.0
       END IF
@@ -2479 +2458 @@
   END DO
 
-!AC!      do j=1,ntra
-!AC!       do i=minorig+1,nl
-!AC!        do il=1,ncum
-!AC!         if (i.ge.icb(il) .AND. i.le.inb(il) .AND. nent(il,i).EQ.0) THEN
-!AC!          traent(il,i,i,j)=tra(il,nk(il),j)
-!AC!         endif
-!AC!        enddo
-!AC!       enddo
-!AC!      enddo
+  !AC!      do j=1,ntra
+  !AC!       do i=minorig+1,nl
+  !AC!        do il=1,ncum
+  !AC!         if (i.ge.icb(il) .AND. i.le.inb(il) .AND. nent(il,i).EQ.0) THEN
+  !AC!          traent(il,i,i,j)=tra(il,nk(il),j)
+  !AC!         endif
+  !AC!        enddo
+  !AC!       enddo
+  !AC!      enddo
 
   DO j = minorig, nl
     DO i = minorig, nl
       DO il = 1, ncum
-        IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<=inb(il))) THEN
+        IF ((j>=(icb(il) - 1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<=inb(il))) THEN
           sigij(il, i, j) = sij(il, i, j)
         END IF
@@ -2498 +2477 @@
     END DO
   END DO
-! @      enddo
-
-! @170   continue
-
-! =====================================================================
-! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
-! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
-! =====================================================================
-
-  CALL zilch(asum, nloc*nd)
-  CALL zilch(csum, nloc*nd)
-  CALL zilch(csum, nloc*nd)
+  ! @      enddo
+
+  ! @170   continue
+
+  ! =====================================================================
+  ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
+  ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
+  ! =====================================================================
+
+  CALL zilch(asum, nloc * nd)
+  CALL zilch(csum, nloc * nd)
+  CALL zilch(csum, nloc * nd)
 
   DO il = 1, ncum
@@ -2523 +2502 @@
     IF (num1<=0) GO TO 789
 
-
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il)) THEN
-        lwork(il) = (nent(il,i)/=0)
-        qp = qnk(il) - ep(il, i)*clw(il, i)
+        lwork(il) = (nent(il, i)/=0)
+        qp = qnk(il) - ep(il, i) * clw(il, i)
 
         IF (cvflag_ice) THEN
 
-          anum = h(il, i) - hp(il, i) - (lv(il,i)+frac(il,i)*lf(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)+frac(il,i)*lf(il,i))* &
-                       (rr(il,i)-qp) + (cpd-cpv)*t(il, i)*(rr(il,i)-qp)
+          anum = h(il, i) - hp(il, i) - (lv(il, i) + frac(il, i) * lf(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) + frac(il, i) * lf(il, i)) * &
+                  (rr(il, i) - qp) + (cpd - cpv) * t(il, i) * (rr(il, i) - qp)
         ELSE
 
-          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)
+          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)
         END IF
 
         IF (abs(denom)<0.01) denom = 0.01
-        scrit(il) = anum/denom
-        alt = qp - rs(il, i) + scrit(il)*(rr(il,i)-qp)
+        scrit(il) = anum / denom
+        alt = qp - rs(il, i) + scrit(il) * (rr(il, i) - qp)
         IF (scrit(il)<=0.0 .OR. alt<=0.0) scrit(il) = 1.0
         smax(il) = 0.0
@@ -2557 +2535 @@
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. &
-            j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
-            lwork(il)) num2 = num2 + 1
+                j>=(icb(il) - 1) .AND. j<=inb(il) .AND. &
+                lwork(il)) num2 = num2 + 1
       END DO
       IF (num2<=0) GO TO 175
@@ -2564 +2542 @@
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. &
-            j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
-            lwork(il)) THEN
-
-          IF (sij(il,i,j)>1.0E-16 .AND. sij(il,i,j)<0.95) THEN
+                j>=(icb(il) - 1) .AND. j<=inb(il) .AND. &
+                lwork(il)) THEN
+
+          IF (sij(il, i, j)>1.0E-16 .AND. sij(il, i, j)<0.95) THEN
             wgh = 1.0
             IF (j>i) THEN
-              sjmax = max(sij(il,i,j+1), smax(il))
+              sjmax = max(sij(il, i, j + 1), smax(il))
               sjmax = amin1(sjmax, scrit(il))
-              smax(il) = max(sij(il,i,j), smax(il))
-              sjmin = max(sij(il,i,j-1), smax(il))
+              smax(il) = max(sij(il, i, j), smax(il))
+              sjmin = max(sij(il, i, j - 1), smax(il))
               sjmin = amin1(sjmin, scrit(il))
-              IF (sij(il,i,j)<(smax(il)-1.0E-16)) wgh = 0.0
-              smid = amin1(sij(il,i,j), scrit(il))
+              IF (sij(il, i, j)<(smax(il) - 1.0E-16)) wgh = 0.0
+              smid = amin1(sij(il, i, j), scrit(il))
             ELSE
-              sjmax = max(sij(il,i,j+1), scrit(il))
-              smid = max(sij(il,i,j), scrit(il))
+              sjmax = max(sij(il, i, j + 1), scrit(il))
+              smid = max(sij(il, i, j), scrit(il))
               sjmin = 0.0
-              IF (j>1) sjmin = sij(il, i, j-1)
+              IF (j>1) sjmin = sij(il, i, j - 1)
               sjmin = max(sjmin, scrit(il))
             END IF
-            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
+            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
           END IF
         END IF
       END DO
 
-175 END DO
+    175 END DO
 
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
         asij(il) = max(1.0E-16, asij(il))
-        asij(il) = 1.0/asij(il)
+        asij(il) = 1.0 / asij(il)
         asum(il, i) = 0.0
         bsum(il, i) = 0.0
@@ -2607 +2585 @@
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
-            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
-          ment(il, i, j) = ment(il, i, j)*asij(il)
+                j>=(icb(il) - 1) .AND. j<=inb(il)) THEN
+          ment(il, i, j) = ment(il, i, j) * asij(il)
         END IF
       END DO
@@ -2616 +2594 @@
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
-            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
+                j>=(icb(il) - 1) .AND. j<=inb(il)) THEN
           asum(il, i) = asum(il, i) + ment(il, i, j)
-          ment(il, i, j) = ment(il, i, j)*sig(il, j)
+          ment(il, i, j) = ment(il, i, j) * sig(il, j)
           bsum(il, i) = bsum(il, i) + ment(il, i, j)
         END IF
@@ -2626 +2604 @@
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
-        bsum(il, i) = max(bsum(il,i), 1.0E-16)
-        bsum(il, i) = 1.0/bsum(il, i)
+        bsum(il, i) = max(bsum(il, i), 1.0E-16)
+        bsum(il, i) = 1.0 / bsum(il, i)
       END IF
     END DO
@@ -2634 +2612 @@
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
-            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
-          ment(il, i, j) = ment(il, i, j)*asum(il, i)*bsum(il, i)
+                j>=(icb(il) - 1) .AND. j<=inb(il)) THEN
+          ment(il, i, j) = ment(il, i, j) * asum(il, i) * bsum(il, i)
         END IF
       END DO
@@ -2643 +2621 @@
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
-            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
+                j>=(icb(il) - 1) .AND. j<=inb(il)) THEN
           csum(il, i) = csum(il, i) + ment(il, i, j)
         END IF
@@ -2651 +2629 @@
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
-          csum(il,i)<m(il,i)) THEN
+              csum(il, i)<m(il, i)) THEN
         nent(il, i) = 0
         ment(il, i, i) = m(il, i)
-        qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
+        qent(il, i, i) = qnk(il) - ep(il, i) * clw(il, i)
         uent(il, i, i) = unk(il)
         vent(il, i, i) = vnk(il)
         elij(il, i, i) = clw(il, i)
-! MAF        sij(il,i,i)=1.0
+        ! MAF        sij(il,i,i)=1.0
         sij(il, i, i) = 0.0
       END IF
     END DO ! il
 
-!AC!      do j=1,ntra
-!AC!       do il=1,ncum
-!AC!        if ( i.ge.icb(il) .AND. i.le.inb(il) .AND. lwork(il)
-!AC!     :     .AND. csum(il,i).lt.m(il,i) ) THEN
-!AC!         traent(il,i,i,j)=tra(il,nk(il),j)
-!AC!        endif
-!AC!       enddo
-!AC!      enddo
-789 END DO
-
-! MAF: renormalisation de MENT
-  CALL zilch(zm, nloc*na)
+    !AC!      do j=1,ntra
+    !AC!       do il=1,ncum
+    !AC!        if ( i.ge.icb(il) .AND. i.le.inb(il) .AND. lwork(il)
+    !AC!     :     .AND. csum(il,i).lt.m(il,i) ) THEN
+    !AC!         traent(il,i,i,j)=tra(il,nk(il),j)
+    !AC!        endif
+    !AC!       enddo
+    !AC!      enddo
+  789 END DO
+
+  ! MAF: renormalisation de MENT
+  CALL zilch(zm, nloc * na)
   DO jm = 1, nl
     DO im = 1, nl
       DO il = 1, ncum
-        zm(il, im) = zm(il, im) + (1.-sij(il,im,jm))*ment(il, im, jm)
+        zm(il, im) = zm(il, im) + (1. - sij(il, im, jm)) * ment(il, im, jm)
       END DO
     END DO
@@ -2686 +2664 @@
     DO im = 1, nl
       DO il = 1, ncum
-        IF (zm(il,im)/=0.) THEN
-          ment(il, im, jm) = ment(il, im, jm)*m(il, im)/zm(il, im)
+        IF (zm(il, im)/=0.) THEN
+          ment(il, im, jm) = ment(il, im, jm) * m(il, im) / zm(il, im)
         END IF
       END DO
@@ -2702 +2680 @@
   END DO
 
-
 END SUBROUTINE cv3_mixing
 
 SUBROUTINE cv3_unsat(nloc, ncum, nd, na, ntra, icb, inb, iflag, &
-                     t, rr, rs, gz, u, v, tra, p, ph, &
-                     th, tv, lv, lf, cpn, ep, sigp, clw, frac_s, qpreca, frac_a, qta , &                       !!jygprl
-                     m, ment, elij, delt, plcl, coef_clos, &
-                     mp, rp, up, vp, trap, wt, water, evap, fondue, ice, &
-                     faci, b, sigd, &
-                     wdtrainA, wdtrainS, wdtrainM)                                      ! RomP
+        t, rr, rs, gz, u, v, tra, p, ph, &
+        th, tv, lv, lf, cpn, ep, sigp, clw, frac_s, qpreca, frac_a, qta, &                       !!jygprl
+        m, ment, elij, delt, plcl, coef_clos, &
+        mp, rp, up, vp, trap, wt, water, evap, fondue, ice, &
+        faci, b, sigd, &
+        wdtrainA, wdtrainS, wdtrainM)                                      ! RomP
   USE lmdz_print_control, ONLY: prt_level, lunout
   USE lmdz_nuage_params
   USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-
-  include "cvthermo.h"
-  include "cv3param.h"
-
-!inputs:
-  INTEGER, INTENT (IN)                               :: ncum, nd, na, ntra, nloc
-  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb
-  REAL, INTENT(IN)                                   :: delt
-  REAL, DIMENSION (nloc), INTENT (IN)                :: plcl
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, rr, rs
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: gz
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: u, v
-  REAL, DIMENSION (nloc, nd, ntra), INTENT(IN)       :: tra
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
-  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: ep, sigp, clw   !adiab ascent shedding
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: frac_s          !ice fraction in adiab ascent shedding !!jygprl
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: qpreca          !adiab ascent precip                   !!jygprl
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: frac_a          !ice fraction in adiab ascent precip   !!jygprl
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: qta             !adiab ascent specific total water     !!jygprl
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: th, tv, lv, cpn
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lf
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: m
-  REAL, DIMENSION (nloc, na, na), INTENT (IN)        :: ment, elij
-  REAL, DIMENSION (nloc), INTENT (IN)                :: coef_clos
-
-!input/output
-  INTEGER, DIMENSION (nloc), INTENT (INOUT)          :: iflag(nloc)
-
-!outputs:
-  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: mp, rp, up, vp
-  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: water, evap, wt
-  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: ice, fondue
-  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: faci            ! ice fraction in precipitation
-  REAL, DIMENSION (nloc, na, ntra), INTENT (OUT)     :: trap
-  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: b
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: sigd
-! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
-! de l ascendance adiabatique et des flux melanges Pa et Pm.
-! Distinction des wdtrain
-! Pa = wdtrainA     Pm = wdtrainM
-  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: wdtrainA, wdtrainS, wdtrainM
-
-!local variables
+  !inputs:
+  INTEGER, INTENT (IN) :: ncum, nd, na, ntra, nloc
+  INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb
+  REAL, INTENT(IN) :: delt
+  REAL, DIMENSION (nloc), INTENT (IN) :: plcl
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, rr, rs
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: gz
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: u, v
+  REAL, DIMENSION (nloc, nd, ntra), INTENT(IN) :: tra
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: p
+  REAL, DIMENSION (nloc, nd + 1), INTENT (IN) :: ph
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: ep, sigp, clw   !adiab ascent shedding
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: frac_s          !ice fraction in adiab ascent shedding !!jygprl
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: qpreca          !adiab ascent precip                   !!jygprl
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: frac_a          !ice fraction in adiab ascent precip   !!jygprl
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: qta             !adiab ascent specific total water     !!jygprl
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: th, tv, lv, cpn
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: lf
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: m
+  REAL, DIMENSION (nloc, na, na), INTENT (IN) :: ment, elij
+  REAL, DIMENSION (nloc), INTENT (IN) :: coef_clos
+
+  !input/output
+  INTEGER, DIMENSION (nloc), INTENT (INOUT) :: iflag(nloc)
+
+  !outputs:
+  REAL, DIMENSION (nloc, na), INTENT (OUT) :: mp, rp, up, vp
+  REAL, DIMENSION (nloc, na), INTENT (OUT) :: water, evap, wt
+  REAL, DIMENSION (nloc, na), INTENT (OUT) :: ice, fondue
+  REAL, DIMENSION (nloc, na), INTENT (OUT) :: faci            ! ice fraction in precipitation
+  REAL, DIMENSION (nloc, na, ntra), INTENT (OUT) :: trap
+  REAL, DIMENSION (nloc, na), INTENT (OUT) :: b
+  REAL, DIMENSION (nloc), INTENT (OUT) :: sigd
+  ! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
+  ! de l ascendance adiabatique et des flux melanges Pa et Pm.
+  ! Distinction des wdtrain
+  ! Pa = wdtrainA     Pm = wdtrainM
+  REAL, DIMENSION (nloc, na), INTENT (OUT) :: wdtrainA, wdtrainS, wdtrainM
+
+  !local variables
   INTEGER i, j, k, il, num1, ndp1
   REAL smallestreal
@@ -2770 +2745 @@
   REAL ampmax, thaw
   REAL tevap(nloc)
-  REAL, DIMENSION (nloc, na)      :: lvcp, lfcp
-  REAL, DIMENSION (nloc, na)      :: h, hm
-  REAL, DIMENSION (nloc, na)      :: ma
-  REAL, DIMENSION (nloc, na)      :: frac          ! ice fraction in precipitation source
-  REAL, DIMENSION (nloc, na)      :: fraci         ! provisionnal ice fraction in precipitation
-  REAL, DIMENSION (nloc, na)      :: prec
+  REAL, DIMENSION (nloc, na) :: lvcp, lfcp
+  REAL, DIMENSION (nloc, na) :: h, hm
+  REAL, DIMENSION (nloc, na) :: ma
+  REAL, DIMENSION (nloc, na) :: frac          ! ice fraction in precipitation source
+  REAL, DIMENSION (nloc, na) :: fraci         ! provisionnal ice fraction in precipitation
+  REAL, DIMENSION (nloc, na) :: prec
   REAL wdtrain(nloc)
   LOGICAL lwork(nloc), mplus(nloc)
 
 
-! ------------------------------------------------------
-IF (prt_level >= 10) print *,' ->cv3_unsat, iflag(1) ', iflag(1)
-
-smallestreal=tiny(smallestreal)
-
-! =============================
-! --- INITIALIZE OUTPUT ARRAYS 
-! =============================
-!  (loops up to nl+1)
-mp(:,:) = 0.
-rp(:,:) = 0.
-up(:,:) = 0.
-vp(:,:) = 0.
-water(:,:) = 0.
-evap(:,:) = 0.
-wt(:,:) = 0.
-ice(:,:) = 0.
-fondue(:,:) = 0.
-faci(:,:) = 0.
-b(:,:) = 0.
-sigd(:) = 0.
-!! RomP >>>
-wdtrainA(:,:) = 0.
-wdtrainS(:,:) = 0.
-wdtrainM(:,:) = 0.
-!! RomP <<<
+  ! ------------------------------------------------------
+  IF (prt_level >= 10) print *, ' ->cv3_unsat, iflag(1) ', iflag(1)
+
+  smallestreal = tiny(smallestreal)
+
+  ! =============================
+  ! --- INITIALIZE OUTPUT ARRAYS
+  ! =============================
+  !  (loops up to nl+1)
+  mp(:, :) = 0.
+  rp(:, :) = 0.
+  up(:, :) = 0.
+  vp(:, :) = 0.
+  water(:, :) = 0.
+  evap(:, :) = 0.
+  wt(:, :) = 0.
+  ice(:, :) = 0.
+  fondue(:, :) = 0.
+  faci(:, :) = 0.
+  b(:, :) = 0.
+  sigd(:) = 0.
+  !! RomP >>>
+  wdtrainA(:, :) = 0.
+  wdtrainS(:, :) = 0.
+  wdtrainM(:, :) = 0.
+  !! RomP <<<
 
   DO i = 1, nlp
@@ -2816 +2791 @@
   END DO
 
-! ***  Set the fractionnal area sigd of precipitating downdraughts
+  ! ***  Set the fractionnal area sigd of precipitating downdraughts
   DO il = 1, ncum
-    sigd(il) = sigdz*coef_clos(il)
-  END DO
-
-! =====================================================================
-! --- INITIALIZE VARIOUS ARRAYS AND PARAMETERS USED IN THE COMPUTATIONS
-! =====================================================================
-!  (loops up to nl+1)
-
-  delti = 1./delt
-  tinv = 1./3.
+    sigd(il) = sigdz * coef_clos(il)
+  END DO
+
+  ! =====================================================================
+  ! --- INITIALIZE VARIOUS ARRAYS AND PARAMETERS USED IN THE COMPUTATIONS
+  ! =====================================================================
+  !  (loops up to nl+1)
+
+  delti = 1. / delt
+  tinv = 1. / 3.
 
   DO i = 1, nlp
@@ -2834 +2809 @@
       fraci(il, i) = 0.0
       prec(il, i) = 0.0
-      lvcp(il, i) = lv(il, i)/cpn(il, i)
-      lfcp(il, i) = lf(il, i)/cpn(il, i)
-    END DO
-  END DO
-
-!AC!        do k=1,ntra
-!AC!         do i=1,nd
-!AC!          do il=1,ncum
-!AC!           trap(il,i,k)=tra(il,i,k)
-!AC!          enddo
-!AC!         enddo
-!AC!        enddo
-
-! ***  check whether ep(inb)=0, if so, skip precipitating    ***
-! ***             downdraft calculation                      ***
-
+      lvcp(il, i) = lv(il, i) / cpn(il, i)
+      lfcp(il, i) = lf(il, i) / cpn(il, i)
+    END DO
+  END DO
+
+  !AC!        do k=1,ntra
+  !AC!         do i=1,nd
+  !AC!          do il=1,ncum
+  !AC!           trap(il,i,k)=tra(il,i,k)
+  !AC!          enddo
+  !AC!         enddo
+  !AC!        enddo
+
+  ! ***  check whether ep(inb)=0, if so, skip precipitating    ***
+  ! ***             downdraft calculation                      ***
 
   DO il = 1, ncum
-!!          lwork(il)=.TRUE.
-!!          IF(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
-!jyg<
-!!    lwork(il) = ep(il, inb(il)) >= 0.0001
+    !!          lwork(il)=.TRUE.
+    !!          IF(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
+    !jyg<
+    !!    lwork(il) = ep(il, inb(il)) >= 0.0001
     lwork(il) = ep(il, inb(il)) >= 0.0001 .AND. iflag(il) <= 2
   END DO
 
-! Get adiabatic ascent mass flux 
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  ! Get adiabatic ascent mass flux
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! Warning : this option leads to water conservation violation
-!!!           Expert only
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !!! Warning : this option leads to water conservation violation
+    !!!           Expert only
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     DO il = 1, ncum
       ma(il, nlp) = 0.
-      ma(il, 1)   = 0.
-    END DO
-
-  DO i = nl, 2, -1
+      ma(il, 1) = 0.
+    END DO
+
+    DO i = nl, 2, -1
       DO il = 1, ncum
-        ma(il, i) = ma(il, i+1)*(1.-qta(il,i))/(1.-qta(il,i-1)) + m(il, i)
+        ma(il, i) = ma(il, i + 1) * (1. - qta(il, i)) / (1. - qta(il, i - 1)) + m(il, i)
       END DO
-  END DO
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    END DO
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     DO il = 1, ncum
       ma(il, nlp) = 0.
-      ma(il, 1)   = 0.
-    END DO
-
-  DO i = nl, 2, -1
+      ma(il, 1) = 0.
+    END DO
+
+    DO i = nl, 2, -1
       DO il = 1, ncum
-        ma(il, i) = ma(il, i+1) + m(il, i)
+        ma(il, i) = ma(il, i + 1) + m(il, i)
       END DO
-  END DO
+    END DO
 
   ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-! ***                    begin downdraft loop                    ***
-
-! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+  ! ***                    begin downdraft loop                    ***
+
+  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
   DO i = nl + 1, 1, -1
@@ -2911 +2885 @@
 
 
-! ***  integrate liquid water equation to find condensed water   ***
-! ***                and condensed water flux                    ***
-
-
-! ***              calculate detrained precipitation             ***
-
-
-    DO il = 1, ncum                                                   
-      IF (i<=inb(il) .AND. lwork(il)) THEN                            
-        wdtrain(il) = grav*ep(il, i)*m(il, i)*clw(il, i)            
-        wdtrainS(il, i) = wdtrain(il)/grav                                            !   Ps   jyg
-!!        wdtrainA(il, i) = wdtrain(il)/grav                                          !   Ps   RomP
-      END IF                                                          
-    END DO                                                            
+    ! ***  integrate liquid water equation to find condensed water   ***
+    ! ***                and condensed water flux                    ***
+
+
+    ! ***              calculate detrained precipitation             ***
+
+    DO il = 1, ncum
+      IF (i<=inb(il) .AND. lwork(il)) THEN
+        wdtrain(il) = grav * ep(il, i) * m(il, i) * clw(il, i)
+        wdtrainS(il, i) = wdtrain(il) / grav                                            !   Ps   jyg
+        !!        wdtrainA(il, i) = wdtrain(il)/grav                                          !   Ps   RomP
+      END IF
+    END DO
 
     IF (i>1) THEN
@@ -2930 +2903 @@
         DO il = 1, ncum
           IF (i<=inb(il) .AND. lwork(il)) THEN
-            awat = elij(il, j, i) - (1.-ep(il,i))*clw(il, i)
+            awat = elij(il, j, i) - (1. - ep(il, i)) * clw(il, i)
             awat = max(awat, 0.0)
-            wdtrain(il) = wdtrain(il) + grav*awat*ment(il, j, i)
-            wdtrainM(il, i) = wdtrain(il)/grav - wdtrainS(il, i)    !   Pm  jyg
-!!            wdtrainM(il, i) = wdtrain(il)/grav - wdtrainA(il, i)  !   Pm  RomP
+            wdtrain(il) = wdtrain(il) + grav * awat * ment(il, j, i)
+            wdtrainM(il, i) = wdtrain(il) / grav - wdtrainS(il, i)    !   Pm  jyg
+            !!            wdtrainM(il, i) = wdtrain(il)/grav - wdtrainA(il, i)  !   Pm  RomP
           END IF
         END DO
@@ -2941 +2914 @@
 
     IF (cvflag_prec_eject) THEN
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! Warning : this option leads to water conservation violation
-!!!           Expert only
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-          IF ( i > 1) THEN
-            DO il = 1, ncum
-              IF (i<=inb(il) .AND. lwork(il)) THEN
-                wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))/(1. - qta(il, i-1))    !   Pa   jygprl
-                wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
-              END IF
-            END DO
-          ENDIF  ! ( i > 1)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        !!! Warning : this option leads to water conservation violation
+        !!!           Expert only
+        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        IF (i > 1) THEN
+          DO il = 1, ncum
+            IF (i<=inb(il) .AND. lwork(il)) THEN
+              wdtrainA(il, i) = ma(il, i + 1) * (qta(il, i - 1) - qta(il, i)) / (1. - qta(il, i - 1))    !   Pa   jygprl
+              wdtrain(il) = wdtrain(il) + grav * wdtrainA(il, i)
+            END IF
+          END DO
+        ENDIF  ! ( i > 1)
+        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-          IF ( i > 1) THEN
-            DO il = 1, ncum
-              IF (i<=inb(il) .AND. lwork(il)) THEN
-                wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))                        !   Pa   jygprl
-                wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
-              END IF
-            END DO
-          ENDIF  ! ( i > 1)
+        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        IF (i > 1) THEN
+          DO il = 1, ncum
+            IF (i<=inb(il) .AND. lwork(il)) THEN
+              wdtrainA(il, i) = ma(il, i + 1) * (qta(il, i - 1) - qta(il, i))                        !   Pa   jygprl
+              wdtrain(il) = wdtrain(il) + grav * wdtrainA(il, i)
+            END IF
+          END DO
+        ENDIF  ! ( i > 1)
 
       ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     ENDIF  ! (cvflag_prec_eject)
 
 
-! ***    find rain water and evaporation using provisional   ***
-! ***              estimates of rp(i)and rp(i-1)             ***
-
+    ! ***    find rain water and evaporation using provisional   ***
+    ! ***              estimates of rp(i)and rp(i-1)             ***
 
     IF (cvflag_ice) THEN                                                                                !!jygprl
@@ -2980 +2952 @@
         DO il = 1, ncum                                                                                   !!jygprl
           IF (i<=inb(il) .AND. lwork(il)) THEN                                                            !!jygprl
-            frac(il, i) = (frac_a(il,i)*wdtrainA(il,i)+frac_s(il,i)*(wdtrainS(il,i)+wdtrainM(il,i))) / &  !!jygprl
-                          max(wdtrainA(il,i)+wdtrainS(il,i)+wdtrainM(il,i),smallestreal)                  !!jygprl
+            frac(il, i) = (frac_a(il, i) * wdtrainA(il, i) + frac_s(il, i) * (wdtrainS(il, i) + wdtrainM(il, i))) / &  !!jygprl
+                    max(wdtrainA(il, i) + wdtrainS(il, i) + wdtrainM(il, i), smallestreal)                  !!jygprl
             fraci(il, i) = frac(il, i)                                                                    !!jygprl
           END IF                                                                                          !!jygprl
@@ -2988 +2960 @@
         DO il = 1, ncum                                                                                   !!jygprl
           IF (i<=inb(il) .AND. lwork(il)) THEN                                                            !!jygprl
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
             IF (keepbug_ice_frac) THEN
               frac(il, i) = frac_s(il, i)
-!       Ice fraction computed again here as a function of the temperature seen by unsaturated downdraughts
-!       (i.e. the cold pool temperature) for compatibility with earlier versions.
-              fraci(il, i) = 1. - (t(il,i)-243.15)/(263.15-243.15)
-              fraci(il, i) = min(max(fraci(il,i),0.0), 1.0)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+              !       Ice fraction computed again here as a function of the temperature seen by unsaturated downdraughts
+              !       (i.e. the cold pool temperature) for compatibility with earlier versions.
+              fraci(il, i) = 1. - (t(il, i) - 243.15) / (263.15 - 243.15)
+              fraci(il, i) = min(max(fraci(il, i), 0.0), 1.0)
+              !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
             ELSE  ! (keepbug_ice_frac)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+              !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
               frac(il, i) = frac_s(il, i)
               fraci(il, i) = frac(il, i)                                                                    !!jygprl
             ENDIF  ! (keepbug_ice_frac)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
           END IF                                                                                          !!jygprl
         END DO                                                                                            !!jygprl
@@ -3007 +2979 @@
     END IF                                                                                              !!jygprl
 
-
     DO il = 1, ncum
       IF (i<=inb(il) .AND. lwork(il)) THEN
@@ -3014 +2985 @@
 
         IF (i<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))
+          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))
         END IF
-        rp(il, i) = max(rp(il,i), 0.0)
-        rp(il, i) = amin1(rp(il,i), rs(il,i))
+        rp(il, i) = max(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==1) THEN
-          afac = p(il, 1)*(rs(il,1)-rp(il,1))/(1.0E4+2000.0*p(il,1)*rs(il,1))
+          afac = p(il, 1) * (rs(il, 1) - rp(il, 1)) / (1.0E4 + 2000.0 * p(il, 1) * rs(il, 1))
           IF (cvflag_ice) THEN
-            afac1 = p(il, i)*(rs(il,1)-rp(il,1))/(1.0E4+2000.0*p(il,1)*rs(il,1))
+            afac1 = p(il, i) * (rs(il, 1) - rp(il, 1)) / (1.0E4 + 2000.0 * p(il, 1) * rs(il, 1))
           END IF
         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) = max(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)
+          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) = max(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)
         END IF
         IF (i==inb(il)) afac = 0.0
         afac = max(afac, 0.0)
-        bfac = 1./(sigd(il)*wt(il,i))
-
-    IF (prt_level >= 20) THEN
-      Print*, 'cv3_unsat after provisional rp estimate: rp, afac, bfac ', &
-          i, rp(1, i), afac,bfac
-    ENDIF
-
-!JYG1
-! cc        sigt=1.0
-! cc        IF(i.ge.icb)sigt=sigp(i)
-! prise en compte de la variation progressive de sigt dans
-! les couches icb et icb-1:
-! pour plcl<ph(i+1), pr1=0 & pr2=1
-! pour plcl>ph(i),   pr1=1 & pr2=0
-! pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
-! sur le nuage, et pr2 est la proportion sous la base du
-! 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
-!JYG2
-
-!JYG----
-!    b6 = bfac*100.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
-!    c6 = water(il,i+1) + wdtrain(il)*bfac
-!    c6 = prec(il,i+1) + wdtrain(il)*bfac
-!    revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
-!    evap(il,i)=sigt*afac*revap
-!    water(il,i)=revap*revap
-!    prec(il,i)=revap*revap
-!!        print *,' i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il) ', &
-!!                 i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il)
-!!---end jyg---
-
-! --------retour à la formulation originale d'Emanuel.
+        bfac = 1. / (sigd(il) * wt(il, i))
+
+        IF (prt_level >= 20) THEN
+          Print*, 'cv3_unsat after provisional rp estimate: rp, afac, bfac ', &
+                  i, rp(1, i), afac, bfac
+        ENDIF
+
+        !JYG1
+        ! cc        sigt=1.0
+        ! cc        IF(i.ge.icb)sigt=sigp(i)
+        ! prise en compte de la variation progressive de sigt dans
+        ! les couches icb et icb-1:
+        ! pour plcl<ph(i+1), pr1=0 & pr2=1
+        ! pour plcl>ph(i),   pr1=1 & pr2=0
+        ! pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
+        ! sur le nuage, et pr2 est la proportion sous la base du
+        ! 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
+        !JYG2
+
+        !JYG----
+        !    b6 = bfac*100.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
+        !    c6 = water(il,i+1) + wdtrain(il)*bfac
+        !    c6 = prec(il,i+1) + wdtrain(il)*bfac
+        !    revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
+        !    evap(il,i)=sigt*afac*revap
+        !    water(il,i)=revap*revap
+        !    prec(il,i)=revap*revap
+        !!        print *,' i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il) ', &
+        !!                 i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il)
+        !!---end jyg---
+
+        ! --------retour à la formulation originale d'Emanuel.
         IF (cvflag_ice) THEN
 
-!   b6=bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
-!   c6=prec(il,i+1)+bfac*wdtrain(il) &
-!       -50.*sigd(il)*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))
-
-!JAM  Attention: evap=sigt*E
-!    Modification: evap devient l'évaporation en milieu de couche
-!    car nécessaire dans cv3_yield
-!    Du coup, il faut modifier pas mal d'équations...
-!    et l'expression de afac qui devient afac1
-!    revap=sqrt((prec(i+1)+prec(i))/2)
-
-          b6 = bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac1
-          c6 = prec(il, i+1) + 0.5*bfac*wdtrain(il)
-! print *,'bfac,sigd(il),sigt,afac1 ',bfac,sigd(il),sigt,afac1
-! print *,'prec(il,i+1),wdtrain(il) ',prec(il,i+1),wdtrain(il)
-! print *,'b6,c6,b6*b6+4.*c6 ',b6,c6,b6*b6+4.*c6
-          IF (c6>b6*b6+1.E-20) THEN
-            revap = 2.*c6/(b6+sqrt(b6*b6+4.*c6))
+          !   b6=bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
+          !   c6=prec(il,i+1)+bfac*wdtrain(il) &
+          !       -50.*sigd(il)*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))
+
+          !JAM  Attention: evap=sigt*E
+          !    Modification: evap devient l'évaporation en milieu de couche
+          !    car nécessaire dans cv3_yield
+          !    Du coup, il faut modifier pas mal d'équations...
+          !    et l'expression de afac qui devient afac1
+          !    revap=sqrt((prec(i+1)+prec(i))/2)
+
+          b6 = bfac * 50. * sigd(il) * (ph(il, i) - ph(il, i + 1)) * sigt * afac1
+          c6 = prec(il, i + 1) + 0.5 * bfac * wdtrain(il)
+          ! print *,'bfac,sigd(il),sigt,afac1 ',bfac,sigd(il),sigt,afac1
+          ! print *,'prec(il,i+1),wdtrain(il) ',prec(il,i+1),wdtrain(il)
+          ! print *,'b6,c6,b6*b6+4.*c6 ',b6,c6,b6*b6+4.*c6
+          IF (c6>b6 * b6 + 1.E-20) THEN
+            revap = 2. * c6 / (b6 + sqrt(b6 * b6 + 4. * c6))
           ELSE
-            revap = (-b6+sqrt(b6*b6+4.*c6))/2.
+            revap = (-b6 + sqrt(b6 * b6 + 4. * c6)) / 2.
           END IF
-          prec(il, i) = max(0., 2.*revap*revap-prec(il,i+1))
-! PRINT*,prec(il,i),'neige'
-
-!JYG    Dans sa formulation originale, Emanuel calcule l'evaporation par:
-! c             evap(il,i)=sigt*afac*revap
-! ce qui n'est pas correct. Dans cv_routines, la formulation a été modifiee.
-! Ici,l'evaporation evap est simplement calculee par l'equation de
-! conservation.
-! prec(il,i)=revap*revap
-! else
-!JYG----   Correction : si c6 <= 0, water(il,i)=0.
-! prec(il,i)=0.
-! END IF
-
-!JYG---   Dans tous les cas, evaporation = [tt ce qui entre dans la couche i]
-! moins [tt ce qui sort de la couche i]
-! print *, 'evap avec ice'
-          evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(prec(il,i+1)-prec(il,i))) / &
-                        (sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
-
-    IF (prt_level >= 20) THEN
-      Print*, 'cv3_unsat after evap computation: wdtrain, sigd, wt, prec(i+1),prec(i) ', &
-          i, wdtrain(1), sigd(1), wt(1,i), prec(1,i+1),prec(1,i)
-    ENDIF
-
-!jyg<
-          d6 = prec(il,i)-prec(il,i+1)
-
-!!          d6 = bfac*wdtrain(il) - 100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
-!!          e6 = bfac*wdtrain(il)
-!!          f6 = -100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
-!>jyg
-!CR:tmax_fonte_cv: T for which ice is totally melted (used to be 275.15)
-          thaw = (t(il,i)-273.15)/(tmax_fonte_cv-273.15)
-          thaw = min(max(thaw,0.0), 1.0)
-!jyg<
-          water(il, i) = water(il, i+1) + (1-fraci(il,i))*d6
-          ice(il, i)   = ice(il, i+1)   + fraci(il, i)*d6
-          water(il, i) = min(prec(il,i), max(water(il,i), 0.))
-          ice(il, i)   = min(prec(il,i), max(ice(il,i),   0.))
-
-!!          water(il, i) = water(il, i+1) + (1-fraci(il,i))*d6
-!!          water(il, i) = max(water(il,i), 0.)
-!!          ice(il, i) = ice(il, i+1) + fraci(il, i)*d6
-!!          ice(il, i) = max(ice(il,i), 0.)
-!>jyg
-          fondue(il, i) = ice(il, i)*thaw
+          prec(il, i) = max(0., 2. * revap * revap - prec(il, i + 1))
+          ! PRINT*,prec(il,i),'neige'
+
+          !JYG    Dans sa formulation originale, Emanuel calcule l'evaporation par:
+          ! c             evap(il,i)=sigt*afac*revap
+          ! ce qui n'est pas correct. Dans cv_routines, la formulation a été modifiee.
+          ! Ici,l'evaporation evap est simplement calculee par l'equation de
+          ! conservation.
+          ! prec(il,i)=revap*revap
+          ! else
+          !JYG----   Correction : si c6 <= 0, water(il,i)=0.
+          ! prec(il,i)=0.
+          ! END IF
+
+          !JYG---   Dans tous les cas, evaporation = [tt ce qui entre dans la couche i]
+          ! moins [tt ce qui sort de la couche i]
+          ! print *, 'evap avec ice'
+          evap(il, i) = (wdtrain(il) + sigd(il) * wt(il, i) * (prec(il, i + 1) - prec(il, i))) / &
+                  (sigd(il) * (ph(il, i) - ph(il, i + 1)) * 100.)
+
+          IF (prt_level >= 20) THEN
+            Print*, 'cv3_unsat after evap computation: wdtrain, sigd, wt, prec(i+1),prec(i) ', &
+                    i, wdtrain(1), sigd(1), wt(1, i), prec(1, i + 1), prec(1, i)
+          ENDIF
+
+          !jyg<
+          d6 = prec(il, i) - prec(il, i + 1)
+
+          !!          d6 = bfac*wdtrain(il) - 100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
+          !!          e6 = bfac*wdtrain(il)
+          !!          f6 = -100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
+          !>jyg
+          !CR:tmax_fonte_cv: T for which ice is totally melted (used to be 275.15)
+          thaw = (t(il, i) - 273.15) / (tmax_fonte_cv - 273.15)
+          thaw = min(max(thaw, 0.0), 1.0)
+          !jyg<
+          water(il, i) = water(il, i + 1) + (1 - fraci(il, i)) * d6
+          ice(il, i) = ice(il, i + 1) + fraci(il, i) * d6
+          water(il, i) = min(prec(il, i), max(water(il, i), 0.))
+          ice(il, i) = min(prec(il, i), max(ice(il, i), 0.))
+
+          !!          water(il, i) = water(il, i+1) + (1-fraci(il,i))*d6
+          !!          water(il, i) = max(water(il,i), 0.)
+          !!          ice(il, i) = ice(il, i+1) + fraci(il, i)*d6
+          !!          ice(il, i) = max(ice(il,i), 0.)
+          !>jyg
+          fondue(il, i) = ice(il, i) * thaw
           water(il, i) = water(il, i) + fondue(il, i)
           ice(il, i) = ice(il, i) - fondue(il, i)
 
-          IF (water(il,i)+ice(il,i)<1.E-30) THEN
+          IF (water(il, i) + ice(il, i)<1.E-30) THEN
             faci(il, i) = 0.
           ELSE
-            faci(il, i) = ice(il, i)/(water(il,i)+ice(il,i))
+            faci(il, i) = ice(il, i) / (water(il, i) + ice(il, i))
           END IF
 
-!           water(il,i)=water(il,i+1)+(1.-fraci(il,i))*e6+(1.-faci(il,i))*f6
-!           water(il,i)=max(water(il,i),0.)
-!           ice(il,i)=ice(il,i+1)+fraci(il,i)*e6+faci(il,i)*f6
-!           ice(il,i)=max(ice(il,i),0.)
-!           fondue(il,i)=ice(il,i)*thaw
-!           water(il,i)=water(il,i)+fondue(il,i)
-!           ice(il,i)=ice(il,i)-fondue(il,i)
-            
-!           if((water(il,i)+ice(il,i)).lt.1.e-30)THEN
-!             faci(il,i)=0.
-!           else
-!             faci(il,i)=ice(il,i)/(water(il,i)+ice(il,i))
-!           endif
+          !           water(il,i)=water(il,i+1)+(1.-fraci(il,i))*e6+(1.-faci(il,i))*f6
+          !           water(il,i)=max(water(il,i),0.)
+          !           ice(il,i)=ice(il,i+1)+fraci(il,i)*e6+faci(il,i)*f6
+          !           ice(il,i)=max(ice(il,i),0.)
+          !           fondue(il,i)=ice(il,i)*thaw
+          !           water(il,i)=water(il,i)+fondue(il,i)
+          !           ice(il,i)=ice(il,i)-fondue(il,i)
+
+          !           if((water(il,i)+ice(il,i)).lt.1.e-30)THEN
+          !             faci(il,i)=0.
+          !           else
+          !             faci(il,i)=ice(il,i)/(water(il,i)+ice(il,i))
+          !           endif
 
         ELSE
-          b6 = bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
-          c6 = water(il, i+1) + bfac*wdtrain(il) - &
-               50.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i+1)
+          b6 = bfac * 50. * sigd(il) * (ph(il, i) - ph(il, i + 1)) * sigt * afac
+          c6 = water(il, i + 1) + bfac * wdtrain(il) - &
+                  50. * sigd(il) * bfac * (ph(il, i) - ph(il, i + 1)) * evap(il, i + 1)
           IF (c6>0.0) THEN
-            revap = 0.5*(-b6+sqrt(b6*b6+4.*c6))
-            water(il, i) = revap*revap
+            revap = 0.5 * (-b6 + sqrt(b6 * b6 + 4. * c6))
+            water(il, i) = revap * revap
           ELSE
             water(il, i) = 0.
           END IF
-! print *, 'evap sans ice'
-          evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(water(il,i+1)-water(il,i)))/ &
-                        (sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
+          ! print *, 'evap sans ice'
+          evap(il, i) = (wdtrain(il) + sigd(il) * wt(il, i) * (water(il, i + 1) - water(il, i))) / &
+                  (sigd(il) * (ph(il, i) - ph(il, i + 1)) * 100.)
 
         END IF
       END IF !(i.le.inb(il) .AND. lwork(il))
     END DO
-! ----------------------------------------------------------------
-
-! cc
-! ***  calculate precipitating downdraft mass flux under     ***
-! ***              hydrostatic approximation                 ***
+    ! ----------------------------------------------------------------
+
+    ! cc
+    ! ***  calculate precipitating downdraft mass flux under     ***
+    ! ***              hydrostatic approximation                 ***
 
     DO il = 1, ncum
       IF (i<=inb(il) .AND. lwork(il) .AND. i/=1) THEN
 
-        tevap(il) = max(0.0, evap(il,i))
-        delth = max(0.001, (th(il,i)-th(il,i-1)))
+        tevap(il) = max(0.0, evap(il, i))
+        delth = max(0.001, (th(il, i) - th(il, i - 1)))
         IF (cvflag_ice) THEN
           IF (cvflag_grav) THEN
-            mp(il, i) = 100.*ginv*(lvcp(il,i)*sigd(il)*tevap(il)* &
-                                               (p(il,i-1)-p(il,i))/delth + &
-                                   lfcp(il,i)*sigd(il)*faci(il,i)*tevap(il)* &
-                                               (p(il,i-1)-p(il,i))/delth + &
-                                   lfcp(il,i)*sigd(il)*wt(il,i)/100.*fondue(il,i)* &
-                                               (p(il,i-1)-p(il,i))/delth/(ph(il,i)-ph(il,i+1)))
+            mp(il, i) = 100. * ginv * (lvcp(il, i) * sigd(il) * tevap(il) * &
+                    (p(il, i - 1) - p(il, i)) / delth + &
+                    lfcp(il, i) * sigd(il) * faci(il, i) * tevap(il) * &
+                            (p(il, i - 1) - p(il, i)) / delth + &
+                    lfcp(il, i) * sigd(il) * wt(il, i) / 100. * fondue(il, i) * &
+                            (p(il, i - 1) - p(il, i)) / delth / (ph(il, i) - ph(il, i + 1)))
           ELSE
-            mp(il, i) = 10.*(lvcp(il,i)*sigd(il)*tevap(il)* &
-                                                (p(il,i-1)-p(il,i))/delth + &
-                             lfcp(il,i)*sigd(il)*faci(il,i)*tevap(il)* &
-                                                (p(il,i-1)-p(il,i))/delth + &
-                             lfcp(il,i)*sigd(il)*wt(il,i)/100.*fondue(il,i)* &
-                                                (p(il,i-1)-p(il,i))/delth/(ph(il,i)-ph(il,i+1)))
+            mp(il, i) = 10. * (lvcp(il, i) * sigd(il) * tevap(il) * &
+                    (p(il, i - 1) - p(il, i)) / delth + &
+                    lfcp(il, i) * sigd(il) * faci(il, i) * tevap(il) * &
+                            (p(il, i - 1) - p(il, i)) / delth + &
+                    lfcp(il, i) * sigd(il) * wt(il, i) / 100. * fondue(il, i) * &
+                            (p(il, i - 1) - p(il, i)) / delth / (ph(il, i) - ph(il, i + 1)))
 
           END IF
         ELSE
           IF (cvflag_grav) THEN
-            mp(il, i) = 100.*ginv*lvcp(il, i)*sigd(il)*tevap(il)* &
-                                                (p(il,i-1)-p(il,i))/delth
+            mp(il, i) = 100. * ginv * lvcp(il, i) * sigd(il) * tevap(il) * &
+                    (p(il, i - 1) - p(il, i)) / delth
           ELSE
-            mp(il, i) = 10.*lvcp(il, i)*sigd(il)*tevap(il)* &
-                                                (p(il,i-1)-p(il,i))/delth
+            mp(il, i) = 10. * lvcp(il, i) * sigd(il) * tevap(il) * &
+                    (p(il, i - 1) - p(il, i)) / delth
           END IF
 
@@ -3228 +3199 @@
       END IF !(i.le.inb(il) .AND. lwork(il) .AND. i.NE.1)
       IF (prt_level >= 20) THEN
-        PRINT *,'cv3_unsat, mp hydrostatic ', i, mp(il,i)
+        PRINT *, 'cv3_unsat, mp hydrostatic ', i, mp(il, i)
       ENDIF
     END DO
-! ----------------------------------------------------------------
-
-! ***           if hydrostatic assumption fails,             ***
-! ***   solve cubic difference equation for downdraft theta  ***
-! ***  and mass flux from two simultaneous differential eqns ***
+    ! ----------------------------------------------------------------
+
+    ! ***           if hydrostatic assumption fails,             ***
+    ! ***   solve cubic difference equation for downdraft theta  ***
+    ! ***  and mass flux from two simultaneous differential eqns ***
 
     DO il = 1, ncum
       IF (i<=inb(il) .AND. lwork(il) .AND. i/=1) THEN
 
-        amfac = sigd(il)*sigd(il)*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>(0.1*amfac)) THEN
-          xf = 100.0*sigd(il)*sigd(il)*sigd(il)*(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(il)*th(il,i))
-          af = xf*tf + mp(il, i+1)*mp(il, i+1)*tinv
+        amfac = sigd(il) * sigd(il) * 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>(0.1 * amfac)) THEN
+          xf = 100.0 * sigd(il) * sigd(il) * sigd(il) * (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(il) * th(il, i))
+          af = xf * tf + mp(il, i + 1) * mp(il, i + 1) * tinv
 
           IF (cvflag_ice) THEN
-            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(il)*(1.+(lf(il,i)/lv(il,i))*faci(il,i)) + &
-                (lf(il,i)/lv(il,i))*wt(il,i)/100.*fondue(il,i)/(ph(il,i)-ph(il,i+1)))
+            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(il) * (1. + (lf(il, i) / lv(il, i)) * faci(il, i)) + &
+                            (lf(il, i) / lv(il, i)) * wt(il, i) / 100. * fondue(il, i) / (ph(il, i) - ph(il, i + 1)))
           ELSE
 
-            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(il)
+            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(il)
           END IF
 
@@ -3263 +3234 @@
           IF (bf<0.0) fac2 = -1.0
           bf = abs(bf)
-          ur = 0.25*bf*bf - af*af*af*tinv*tinv*tinv
+          ur = 0.25 * bf * bf - af * af * af * tinv * tinv * tinv
           IF (ur>=0.0) THEN
             sru = sqrt(ur)
             fac = 1.0
-            IF ((0.5*bf-sru)<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
+            IF ((0.5 * bf - sru)<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))
+            d = atan(2. * sqrt(-ur) / (bf + 1.0E-28))
             IF (fac2<0.0) d = 3.14159 - d
-            mp(il, i) = mp(il, i+1)*tinv + 2.*sqrt(af*tinv)*cos(d*tinv)
+            mp(il, i) = mp(il, i + 1) * tinv + 2. * sqrt(af * tinv) * cos(d * tinv)
           END IF
-          mp(il, i) = max(0.0, mp(il,i))
+          mp(il, i) = max(0.0, mp(il, i))
           IF (prt_level >= 20) THEN
-            PRINT *,'cv3_unsat, mp cubic ', i, mp(il,i)
+            PRINT *, 'cv3_unsat, mp cubic ', i, mp(il, i)
           ENDIF
 
           IF (cvflag_ice) THEN
             IF (cvflag_grav) THEN
-!JYG : il y a vraisemblablement une erreur dans la ligne 2 suivante:
-! il faut diviser par (mp(il,i)*sigd(il)*grav) et non par (mp(il,i)+sigd(il)*0.1).
-! 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(il)*(1.+(lf(il,i)/lv(il,i))*faci(il,i)) + &
-                           (lf(il,i)/lv(il,i))*wt(il,i)/100.*fondue(il,i) / &
-                           (ph(il,i)-ph(il,i+1))) / &
-                           (mp(il,i)+sigd(il)*0.1) - &
-                           10.0*(th(il,i)-th(il,i-1))*t(il, i) / &
-                           (lvcp(il,i)*sigd(il)*th(il,i))
+              !JYG : il y a vraisemblablement une erreur dans la ligne 2 suivante:
+              ! il faut diviser par (mp(il,i)*sigd(il)*grav) et non par (mp(il,i)+sigd(il)*0.1).
+              ! 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(il) * (1. + (lf(il, i) / lv(il, i)) * faci(il, i)) + &
+                              (lf(il, i) / lv(il, i)) * wt(il, i) / 100. * fondue(il, i) / &
+                                      (ph(il, i) - ph(il, i + 1))) / &
+                      (mp(il, i) + sigd(il) * 0.1) - &
+                      10.0 * (th(il, i) - th(il, i - 1)) * t(il, i) / &
+                              (lvcp(il, i) * sigd(il) * th(il, i))
             ELSE
-              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*&
-                           (tevap(il)*(1.+(lf(il,i)/lv(il,i))*faci(il,i)) + &
-                           (lf(il,i)/lv(il,i))*wt(il,i)/100.*fondue(il,i) / &
-                           (ph(il,i)-ph(il,i+1))) / &
-                           (mp(il,i)+sigd(il)*0.1) - &
-                           10.0*(th(il,i)-th(il,i-1))*t(il, i) / &
-                           (lvcp(il,i)*sigd(il)*th(il,i))
+              b(il, i - 1) = b(il, i) + 100.0 * (p(il, i - 1) - p(il, i)) * &
+                      (tevap(il) * (1. + (lf(il, i) / lv(il, i)) * faci(il, i)) + &
+                              (lf(il, i) / lv(il, i)) * wt(il, i) / 100. * fondue(il, i) / &
+                                      (ph(il, i) - ph(il, i + 1))) / &
+                      (mp(il, i) + sigd(il) * 0.1) - &
+                      10.0 * (th(il, i) - th(il, i - 1)) * t(il, i) / &
+                              (lvcp(il, i) * sigd(il) * th(il, i))
             END IF
           ELSE
             IF (cvflag_grav) THEN
-              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*tevap(il) / &
-                           (mp(il,i)+sigd(il)*0.1) - &
-                           10.0*(th(il,i)-th(il,i-1))*t(il, i) / &
-                           (lvcp(il,i)*sigd(il)*th(il,i))
+              b(il, i - 1) = b(il, i) + 100.0 * (p(il, i - 1) - p(il, i)) * tevap(il) / &
+                      (mp(il, i) + sigd(il) * 0.1) - &
+                      10.0 * (th(il, i) - th(il, i - 1)) * t(il, i) / &
+                              (lvcp(il, i) * sigd(il) * th(il, i))
             ELSE
-              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*tevap(il) / &
-                           (mp(il,i)+sigd(il)*0.1) - &
-                           10.0*(th(il,i)-th(il,i-1))*t(il, i) / &
-                           (lvcp(il,i)*sigd(il)*th(il,i))
+              b(il, i - 1) = b(il, i) + 100.0 * (p(il, i - 1) - p(il, i)) * tevap(il) / &
+                      (mp(il, i) + sigd(il) * 0.1) - &
+                      10.0 * (th(il, i) - th(il, i - 1)) * t(il, i) / &
+                              (lvcp(il, i) * sigd(il) * th(il, i))
             END IF
           END IF
-          b(il, i-1) = max(b(il,i-1), 0.0)
+          b(il, i - 1) = max(b(il, i - 1), 0.0)
 
         END IF !(amp2.gt.(0.1*amfac))
 
-!jyg<    This part shifted 10 lines farther
-!!! ***         limit magnitude of mp(i) to meet cfl condition      ***
-!!
-!!        ampmax = 2.0*(ph(il,i)-ph(il,i+1))*delti
-!!        amp2 = 2.0*(ph(il,i-1)-ph(il,i))*delti
-!!        ampmax = min(ampmax, amp2)
-!!        mp(il, i) = min(mp(il,i), ampmax)
-!>jyg
-
-! ***      force mp to decrease linearly to zero                 ***
-! ***       between cloud base and the surface                   ***
-
-
-! c      IF(p(il,i).gt.p(il,icb(il)))THEN
-! c       mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
-! c      endif
-        IF (ph(il,i)>0.9*plcl(il)) THEN
-          mp(il, i) = mp(il, i)*(ph(il,1)-ph(il,i))/(ph(il,1)-0.9*plcl(il))
+        !jyg<    This part shifted 10 lines farther
+        !!! ***         limit magnitude of mp(i) to meet cfl condition      ***
+        !!
+        !!        ampmax = 2.0*(ph(il,i)-ph(il,i+1))*delti
+        !!        amp2 = 2.0*(ph(il,i-1)-ph(il,i))*delti
+        !!        ampmax = min(ampmax, amp2)
+        !!        mp(il, i) = min(mp(il,i), ampmax)
+        !>jyg
+
+        ! ***      force mp to decrease linearly to zero                 ***
+        ! ***       between cloud base and the surface                   ***
+
+
+        ! c      IF(p(il,i).gt.p(il,icb(il)))THEN
+        ! c       mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
+        ! c      endif
+        IF (ph(il, i)>0.9 * plcl(il)) THEN
+          mp(il, i) = mp(il, i) * (ph(il, 1) - ph(il, i)) / (ph(il, 1) - 0.9 * plcl(il))
         END IF
 
-!jyg<    Shifted part
-! ***         limit magnitude of mp(i) to meet cfl condition      ***
-
-        ampmax = 2.0*(ph(il,i)-ph(il,i+1))*delti
-        amp2 = 2.0*(ph(il,i-1)-ph(il,i))*delti
+        !jyg<    Shifted part
+        ! ***         limit magnitude of mp(i) to meet cfl condition      ***
+
+        ampmax = 2.0 * (ph(il, i) - ph(il, i + 1)) * delti
+        amp2 = 2.0 * (ph(il, i - 1) - ph(il, i)) * delti
         ampmax = min(ampmax, amp2)
-        mp(il, i) = min(mp(il,i), ampmax)
-!>jyg
+        mp(il, i) = min(mp(il, i), ampmax)
+        !>jyg
 
       END IF ! (i.le.inb(il) .AND. lwork(il) .AND. i.NE.1)
     END DO
-! ----------------------------------------------------------------
+    ! ----------------------------------------------------------------
 
     IF (prt_level >= 20) THEN
       Print*, 'cv3_unsat after mp computation: mp, b(i), b(i-1) ', &
-          i, mp(1, i), b(1,i), b(1,max(i-1,1))
+              i, mp(1, i), b(1, i), b(1, max(i - 1, 1))
     ENDIF
 
-! ***       find mixing ratio of precipitating downdraft     ***
+    ! ***       find mixing ratio of precipitating downdraft     ***
 
     DO il = 1, ncum
       IF (i<inb(il) .AND. lwork(il)) THEN
-        mplus(il) = mp(il, i) > mp(il, i+1)
+        mplus(il) = mp(il, i) > mp(il, i + 1)
       END IF ! (i.lt.inb(il) .AND. lwork(il))
     END DO
@@ -3372 +3343 @@
 
           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(il)*(ph(il,i)-ph(il,i+1))*(evap(il,i+1)+evap(il,i))
+            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(il) * (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(il)*(ph(il,i)-ph(il,i+1))*(evap(il,i+1)+evap(il,i))
+            rp(il, i) = rp(il, i + 1) * mp(il, i + 1) + rr(il, i) * (mp(il, i) - mp(il, i + 1)) + &
+                    5. * sigd(il) * (ph(il, i) - ph(il, i + 1)) * (evap(il, i + 1) + evap(il, i))
           END IF
-          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)
+          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)
 
         ELSE ! if (mplus(il))
 
-          IF (mp(il,i+1)>1.0E-16) THEN
+          IF (mp(il, i + 1)>1.0E-16) THEN
             IF (cvflag_grav) THEN
-              rp(il, i) = rp(il,i+1) + 100.*ginv*0.5*sigd(il)*(ph(il,i)-ph(il,i+1)) * &
-                                       (evap(il,i+1)+evap(il,i))/mp(il,i+1)
+              rp(il, i) = rp(il, i + 1) + 100. * ginv * 0.5 * sigd(il) * (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(il)*(ph(il,i)-ph(il,i+1)) * &
-                                       (evap(il,i+1)+evap(il,i))/mp(il, i+1)
+              rp(il, i) = rp(il, i + 1) + 5. * sigd(il) * (ph(il, i) - ph(il, i + 1)) * &
+                      (evap(il, i + 1) + evap(il, i)) / mp(il, i + 1)
             END IF
-            up(il, i) = up(il, i+1)
-            vp(il, i) = vp(il, i+1)
+            up(il, i) = up(il, i + 1)
+            vp(il, i) = vp(il, i + 1)
           END IF ! (mp(il,i+1).gt.1.0e-16)
         END IF ! (mplus(il)) ELSE IF (.NOT.mplus(il))
 
-        rp(il, i) = amin1(rp(il,i), rs(il,i))
-        rp(il, i) = max(rp(il,i), 0.0)
+        rp(il, i) = amin1(rp(il, i), rs(il, i))
+        rp(il, i) = max(rp(il, i), 0.0)
 
       END IF ! (i.lt.inb(il) .AND. lwork(il))
     END DO
-! ----------------------------------------------------------------
-
-! ***       find tracer concentrations in precipitating downdraft     ***
-
-!AC!      do j=1,ntra
-!AC!       do il = 1,ncum
-!AC!       if (i.lt.inb(il) .AND. lwork(il)) THEN
-!AC!c
-!AC!         IF(mplus(il))THEN
-!AC!          trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
-!AC!     :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
-!AC!          trap(il,i,j)=trap(il,i,j)/mp(il,i)
-!AC!         else ! if (mplus(il))
-!AC!          IF(mp(il,i+1).gt.1.0e-16)THEN
-!AC!           trap(il,i,j)=trap(il,i+1,j)
-!AC!          endif
-!AC!         endif ! (mplus(il)) ELSE IF (.NOT.mplus(il))
-!AC!c
-!AC!        endif ! (i.lt.inb(il) .AND. lwork(il))
-!AC!       enddo
-!AC!      END DO
-
-400 END DO
-! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-! ***                    end of downdraft loop                    ***
-
-! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-
+    ! ----------------------------------------------------------------
+
+    ! ***       find tracer concentrations in precipitating downdraft     ***
+
+    !AC!      do j=1,ntra
+    !AC!       do il = 1,ncum
+    !AC!       if (i.lt.inb(il) .AND. lwork(il)) THEN
+    !AC!c
+    !AC!         IF(mplus(il))THEN
+    !AC!          trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
+    !AC!     :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
+    !AC!          trap(il,i,j)=trap(il,i,j)/mp(il,i)
+    !AC!         else ! if (mplus(il))
+    !AC!          IF(mp(il,i+1).gt.1.0e-16)THEN
+    !AC!           trap(il,i,j)=trap(il,i+1,j)
+    !AC!          endif
+    !AC!         endif ! (mplus(il)) ELSE IF (.NOT.mplus(il))
+    !AC!c
+    !AC!        endif ! (i.lt.inb(il) .AND. lwork(il))
+    !AC!       enddo
+    !AC!      END DO
+
+  400 END DO
+  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+  ! ***                    end of downdraft loop                    ***
+
+  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 END SUBROUTINE cv3_unsat
 
 SUBROUTINE cv3_yield(nloc, ncum, nd, na, ntra, ok_conserv_q, &
-                     icb, inb, delt, &
-                     t, rr, t_wake, rr_wake, s_wake, u, v, tra, &
-                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
-                     ep, clw, qpreca, m, tp, mp, rp, up, vp, trap, &
-                     wt, water, ice, evap, fondue, faci, b, sigd, &
-                     ment, qent, hent, iflag_mix, uent, vent, &
-                     nent, elij, traent, sig, &
-                     tv, tvp, wghti, &
-                     iflag, precip, Vprecip, Vprecipi, &     ! jyg: Vprecipi
-                     ft, fr, fr_comp, fu, fv, ftra, &                 ! jyg
-                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
-!!                     tls, tps,                             ! useless . jyg
-                     qcondc, wd, &
-                     ftd, fqd, qta, qtc, sigt, detrain, tau_cld_cv, coefw_cld_cv)
-
-    USE lmdz_print_control, ONLY: lunout, prt_level
-    USE add_phys_tend_mod, ONLY: fl_cor_ebil
-    USE lmdz_conema3
-    USE lmdz_cvflag
+        icb, inb, delt, &
+        t, rr, t_wake, rr_wake, s_wake, u, v, tra, &
+        gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
+        ep, clw, qpreca, m, tp, mp, rp, up, vp, trap, &
+        wt, water, ice, evap, fondue, faci, b, sigd, &
+        ment, qent, hent, iflag_mix, uent, vent, &
+        nent, elij, traent, sig, &
+        tv, tvp, wghti, &
+        iflag, precip, Vprecip, Vprecipi, &     ! jyg: Vprecipi
+        ft, fr, fr_comp, fu, fv, ftra, &                 ! jyg
+        cbmf, upwd, dnwd, dnwd0, ma, mip, &
+        !!                     tls, tps,                             ! useless . jyg
+        qcondc, wd, &
+        ftd, fqd, qta, qtc, sigt, detrain, tau_cld_cv, coefw_cld_cv)
+
+  USE lmdz_print_control, ONLY: lunout, prt_level
+  USE add_phys_tend_mod, ONLY: fl_cor_ebil
+  USE lmdz_conema3
+  USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-  include "cvthermo.h"
-  include "cv3param.h"
-
-!inputs:
-      INTEGER, INTENT (IN)                               :: iflag_mix
-      INTEGER, INTENT (IN)                               :: ncum, nd, na, ntra, nloc
-      LOGICAL, INTENT (IN)                               :: ok_conserv_q
-      INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb
-      REAL, INTENT (IN)                                  :: delt
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, rr, u, v
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t_wake, rr_wake
-      REAL, DIMENSION (nloc), INTENT (IN)                :: s_wake
-      REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: tra
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
-      REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: gz, h, hp
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: th, tp
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: lv, cpn, ep, clw
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: lf
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: rp, up
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: vp
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: wt
-      REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: trap
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: water, evap, b
-      REAL, DIMENSION (nloc, na), INTENT (IN)            :: fondue, faci, ice
-      REAL, DIMENSION (nloc, na, na), INTENT (IN)        :: qent, uent
-      REAL, DIMENSION (nloc, na, na), INTENT (IN)        :: hent
-      REAL, DIMENSION (nloc, na, na), INTENT (IN)        :: vent, elij
-      INTEGER, DIMENSION (nloc, nd), INTENT (IN)         :: nent
-      REAL, DIMENSION (nloc, na, na, ntra), INTENT (IN)  :: traent
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: tv, tvp, wghti
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qta
-      REAL, DIMENSION (nloc, na),INTENT(IN)              :: qpreca
-      REAL, INTENT(IN)                                   :: tau_cld_cv, coefw_cld_cv
-
-!input/output:
-      REAL, DIMENSION (nloc, na), INTENT (INOUT)         :: m, mp
-      REAL, DIMENSION (nloc, na, na), INTENT (INOUT)     :: ment
-      INTEGER, DIMENSION (nloc), INTENT (INOUT)          :: iflag
-      REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: sig
-      REAL, DIMENSION (nloc), INTENT (INOUT)             :: sigd
-
-!outputs:
-      REAL, DIMENSION (nloc), INTENT (OUT)               :: precip
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ft, fr, fu, fv , fr_comp
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ftd, fqd
-      REAL, DIMENSION (nloc, nd, ntra), INTENT (OUT)     :: ftra
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: upwd, dnwd, ma
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: dnwd0, mip
-      REAL, DIMENSION (nloc, nd+1), INTENT (OUT)         :: Vprecip
-      REAL, DIMENSION (nloc, nd+1), INTENT (OUT)         :: Vprecipi
-!!      REAL tls(nloc, nd), tps(nloc, nd)                    ! useless . jyg
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qcondc                      ! cld
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qtc, sigt                   ! cld
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: detrain                     ! Louis : pour le calcul de Klein du terme de variance qui détraine dans lenvironnement
-      REAL, DIMENSION (nloc), INTENT (OUT)               :: wd                          ! gust
-      REAL, DIMENSION (nloc), INTENT (OUT)               :: cbmf
-
-!local variables:
-      INTEGER                                            :: i, k, il, n, j, num1
-      REAL                                               :: rat, delti
-      REAL                                               :: ax, bx, cx, dx, ex
-      REAL                                               :: cpinv, rdcp, dpinv
-      REAL                                               :: sigaq
-      REAL, DIMENSION (nloc)                             ::  awat
-      REAL, DIMENSION (nloc, nd)                         :: lvcp, lfcp              ! , mke ! unused . jyg
-      REAL, DIMENSION (nloc)                             :: am, work, ad, amp1
-!!      real up1(nloc), dn1(nloc)
-      REAL, DIMENSION (nloc, nd, nd)                     :: up1, dn1
-!jyg<
-      REAL, DIMENSION (nloc, nd)                         :: up_to, up_from
-      REAL, DIMENSION (nloc, nd)                         :: dn_to, dn_from
-!>jyg
-      REAL, DIMENSION (nloc)                             :: asum, bsum, csum, dsum
-      REAL, DIMENSION (nloc)                             :: esum, fsum, gsum, hsum
-      REAL, DIMENSION (nloc, nd)                         :: th_wake
-      REAL, DIMENSION (nloc)                             :: alpha_qpos, alpha_qpos1
-      REAL, DIMENSION (nloc, nd)                         :: qcond, nqcond, wa           ! cld
-      REAL, DIMENSION (nloc, nd)                         :: siga, sax, mac              ! cld
-      REAL, DIMENSION (nloc)                             :: sument
-      REAL, DIMENSION (nloc, nd)                         :: sigment, qtment             ! cld
-      REAL, DIMENSION (nloc, nd, nd)                     :: qdet
-      REAL sumdq !jyg
-
-! -------------------------------------------------------------
-
-! initialization:
-
-  delti = 1.0/delt
-! PRINT*,'cv3_yield initialisation delt', delt
+  !inputs:
+  INTEGER, INTENT (IN) :: iflag_mix
+  INTEGER, INTENT (IN) :: ncum, nd, na, ntra, nloc
+  LOGICAL, INTENT (IN) :: ok_conserv_q
+  INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb
+  REAL, INTENT (IN) :: delt
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, rr, u, v
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: t_wake, rr_wake
+  REAL, DIMENSION (nloc), INTENT (IN) :: s_wake
+  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: tra
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: p
+  REAL, DIMENSION (nloc, nd + 1), INTENT (IN) :: ph
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: gz, h, hp
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: th, tp
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: lv, cpn, ep, clw
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: lf
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: rp, up
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: vp
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: wt
+  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: trap
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: water, evap, b
+  REAL, DIMENSION (nloc, na), INTENT (IN) :: fondue, faci, ice
+  REAL, DIMENSION (nloc, na, na), INTENT (IN) :: qent, uent
+  REAL, DIMENSION (nloc, na, na), INTENT (IN) :: hent
+  REAL, DIMENSION (nloc, na, na), INTENT (IN) :: vent, elij
+  INTEGER, DIMENSION (nloc, nd), INTENT (IN) :: nent
+  REAL, DIMENSION (nloc, na, na, ntra), INTENT (IN) :: traent
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: tv, tvp, wghti
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: qta
+  REAL, DIMENSION (nloc, na), INTENT(IN) :: qpreca
+  REAL, INTENT(IN) :: tau_cld_cv, coefw_cld_cv
+
+  !input/output:
+  REAL, DIMENSION (nloc, na), INTENT (INOUT) :: m, mp
+  REAL, DIMENSION (nloc, na, na), INTENT (INOUT) :: ment
+  INTEGER, DIMENSION (nloc), INTENT (INOUT) :: iflag
+  REAL, DIMENSION (nloc, nd), INTENT (INOUT) :: sig
+  REAL, DIMENSION (nloc), INTENT (INOUT) :: sigd
+
+  !outputs:
+  REAL, DIMENSION (nloc), INTENT (OUT) :: precip
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: ft, fr, fu, fv, fr_comp
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: ftd, fqd
+  REAL, DIMENSION (nloc, nd, ntra), INTENT (OUT) :: ftra
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: upwd, dnwd, ma
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: dnwd0, mip
+  REAL, DIMENSION (nloc, nd + 1), INTENT (OUT) :: Vprecip
+  REAL, DIMENSION (nloc, nd + 1), INTENT (OUT) :: Vprecipi
+  !!      REAL tls(nloc, nd), tps(nloc, nd)                    ! useless . jyg
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: qcondc                      ! cld
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: qtc, sigt                   ! cld
+  REAL, DIMENSION (nloc, nd), INTENT (OUT) :: detrain                     ! Louis : pour le calcul de Klein du terme de variance qui détraine dans lenvironnement
+  REAL, DIMENSION (nloc), INTENT (OUT) :: wd                          ! gust
+  REAL, DIMENSION (nloc), INTENT (OUT) :: cbmf
+
+  !local variables:
+  INTEGER :: i, k, il, n, j, num1
+  REAL :: rat, delti
+  REAL :: ax, bx, cx, dx, ex
+  REAL :: cpinv, rdcp, dpinv
+  REAL :: sigaq
+  REAL, DIMENSION (nloc) :: awat
+  REAL, DIMENSION (nloc, nd) :: lvcp, lfcp              ! , mke ! unused . jyg
+  REAL, DIMENSION (nloc) :: am, work, ad, amp1
+  !!      real up1(nloc), dn1(nloc)
+  REAL, DIMENSION (nloc, nd, nd) :: up1, dn1
+  !jyg<
+  REAL, DIMENSION (nloc, nd) :: up_to, up_from
+  REAL, DIMENSION (nloc, nd) :: dn_to, dn_from
+  !>jyg
+  REAL, DIMENSION (nloc) :: asum, bsum, csum, dsum
+  REAL, DIMENSION (nloc) :: esum, fsum, gsum, hsum
+  REAL, DIMENSION (nloc, nd) :: th_wake
+  REAL, DIMENSION (nloc) :: alpha_qpos, alpha_qpos1
+  REAL, DIMENSION (nloc, nd) :: qcond, nqcond, wa           ! cld
+  REAL, DIMENSION (nloc, nd) :: siga, sax, mac              ! cld
+  REAL, DIMENSION (nloc) :: sument
+  REAL, DIMENSION (nloc, nd) :: sigment, qtment             ! cld
+  REAL, DIMENSION (nloc, nd, nd) :: qdet
+  REAL sumdq !jyg
+
+  ! -------------------------------------------------------------
+
+  ! initialization:
+
+  delti = 1.0 / delt
+  ! PRINT*,'cv3_yield initialisation delt', delt
 
   DO il = 1, ncum
@@ -3557 +3524 @@
   END DO
 
-!   Fluxes are on a staggered grid : loops extend up to nl+1
+  !   Fluxes are on a staggered grid : loops extend up to nl+1
   DO i = 1, nlp
     DO il = 1, ncum
@@ -3572 +3539 @@
       ft(il, i) = 0.0
       fr(il, i) = 0.0
-      fr_comp(il,i) = 0.0
+      fr_comp(il, i) = 0.0
       fu(il, i) = 0.0
       fv(il, i) = 0.0
@@ -3583 +3550 @@
       sigment(il, i) = 0.0 ! cld
       sigt(il, i) = 0.0 ! cld
-      qdet(il,i,:) = 0.0 ! cld
+      qdet(il, i, :) = 0.0 ! cld
       detrain(il, i) = 0.0 ! cld
       nqcond(il, i) = 0.0 ! cld
     END DO
   END DO
-! PRINT*,'cv3_yield initialisation 2'
-!AC!      do j=1,ntra
-!AC!       do i=1,nd
-!AC!        do il=1,ncum
-!AC!          ftra(il,i,j)=0.0
-!AC!        enddo
-!AC!       enddo
-!AC!      enddo
-! PRINT*,'cv3_yield initialisation 3'
+  ! PRINT*,'cv3_yield initialisation 2'
+  !AC!      do j=1,ntra
+  !AC!       do i=1,nd
+  !AC!        do il=1,ncum
+  !AC!          ftra(il,i,j)=0.0
+  !AC!        enddo
+  !AC!       enddo
+  !AC!      enddo
+  ! PRINT*,'cv3_yield initialisation 3'
   DO i = 1, nl
     DO il = 1, ncum
-      lvcp(il, i) = lv(il, i)/cpn(il, i)
-      lfcp(il, i) = lf(il, i)/cpn(il, i)
-    END DO
-  END DO
-
-
-
-! ***  calculate surface precipitation in mm/day     ***
+      lvcp(il, i) = lv(il, i) / cpn(il, i)
+      lfcp(il, i) = lf(il, i) / cpn(il, i)
+    END DO
+  END DO
+
+
+
+  ! ***  calculate surface precipitation in mm/day     ***
 
   DO il = 1, ncum
-    IF (ep(il,inb(il))>=0.0001 .AND. iflag(il)<=1) THEN
+    IF (ep(il, inb(il))>=0.0001 .AND. iflag(il)<=1) THEN
       IF (cvflag_ice) THEN
-        precip(il) = wt(il, 1)*sigd(il)*(water(il,1)+ice(il,1)) &
-                              *86400.*1000./(rowl*grav)
+        precip(il) = wt(il, 1) * sigd(il) * (water(il, 1) + ice(il, 1)) &
+                * 86400. * 1000. / (rowl * grav)
       ELSE
-        precip(il) = wt(il, 1)*sigd(il)*water(il, 1) &
-                              *86400.*1000./(rowl*grav)
+        precip(il) = wt(il, 1) * sigd(il) * water(il, 1) &
+                * 86400. * 1000. / (rowl * grav)
       END IF
     END IF
   END DO
-! PRINT*,'cv3_yield apres calcul precip'
-
-
-! ===  calculate vertical profile of  precipitation in kg/m2/s  ===
+  ! PRINT*,'cv3_yield apres calcul precip'
+
+
+  ! ===  calculate vertical profile of  precipitation in kg/m2/s  ===
 
   DO i = 1, nl
     DO il = 1, ncum
-      IF (ep(il,inb(il))>=0.0001 .AND. i<=inb(il) .AND. iflag(il)<=1) THEN
+      IF (ep(il, inb(il))>=0.0001 .AND. i<=inb(il) .AND. iflag(il)<=1) THEN
         IF (cvflag_ice) THEN
-          Vprecip(il, i) = wt(il, i)*sigd(il)*(water(il,i)+ice(il,i))/grav
-          Vprecipi(il, i) = wt(il, i)*sigd(il)*ice(il,i)/grav                   ! jyg
+          Vprecip(il, i) = wt(il, i) * sigd(il) * (water(il, i) + ice(il, i)) / grav
+          Vprecipi(il, i) = wt(il, i) * sigd(il) * ice(il, i) / grav                   ! jyg
         ELSE
-          Vprecip(il, i) = wt(il, i)*sigd(il)*water(il, i)/grav
+          Vprecip(il, i) = wt(il, i) * sigd(il) * water(il, i) / grav
           Vprecipi(il, i) = 0.                                                  ! jyg
         END IF
@@ -3639 +3606 @@
 
 
-! ***  Calculate downdraft velocity scale    ***
-! ***  NE PAS UTILISER POUR L'INSTANT ***
-
-!!      do il=1,ncum
-!!        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il)) &
-!!                                       /(sigd(il)*p(il,icb(il)))
-!!      enddo
-
-
-! ***  calculate tendencies of lowest level potential temperature  ***
-! ***                      and mixing ratio                        ***
+  ! ***  Calculate downdraft velocity scale    ***
+  ! ***  NE PAS UTILISER POUR L'INSTANT ***
+
+  !!      do il=1,ncum
+  !!        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il)) &
+  !!                                       /(sigd(il)*p(il,icb(il)))
+  !!      enddo
+
+
+  ! ***  calculate tendencies of lowest level potential temperature  ***
+  ! ***                      and mixing ratio                        ***
 
   DO il = 1, ncum
-    work(il) = 1.0/(ph(il,1)-ph(il,2))
+    work(il) = 1.0 / (ph(il, 1) - ph(il, 2))
     cbmf(il) = 0.0
   END DO
 
-! - Adiabatic ascent mass flux "ma" and cloud base mass flux "cbmf"
-!-----------------------------------------------------------------
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  ! - Adiabatic ascent mass flux "ma" and cloud base mass flux "cbmf"
+  !-----------------------------------------------------------------
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! Warning : this option leads to water conservation violation
-!!!           Expert only
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !!! Warning : this option leads to water conservation violation
+    !!!           Expert only
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    DO il = 1, ncum
+      ma(il, nlp) = 0.
+      ma(il, 1) = 0.
+    END DO
+    DO k = nl, 2, -1
+      DO il = 1, ncum
+        ma(il, k) = ma(il, k + 1) * (1. - qta(il, k)) / (1. - qta(il, k - 1)) + m(il, k)
+        cbmf(il) = max(cbmf(il), ma(il, k))
+      END DO
+    END DO
+    DO k = 2, nl
+      DO il = 1, ncum
+        IF (k <icb(il)) THEN
+          ma(il, k) = ma(il, k - 1) + wghti(il, k - 1) * cbmf(il)
+        ENDIF
+      END DO
+    END DO
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !! Line kept for compatibility with earlier versions
+    DO k = 2, nl
+      DO il = 1, ncum
+        IF (k>=icb(il)) THEN
+          cbmf(il) = cbmf(il) + m(il, k)
+        END IF
+      END DO
+    END DO
+
+    DO il = 1, ncum
+      ma(il, nlp) = 0.
+      ma(il, 1) = 0.
+    END DO
+    DO k = nl, 2, -1
+      DO il = 1, ncum
+        ma(il, k) = ma(il, k + 1) + m(il, k)
+      END DO
+    END DO
+    DO k = 2, nl
+      DO il = 1, ncum
+        IF (k <icb(il)) THEN
+          ma(il, k) = ma(il, k - 1) + wghti(il, k - 1) * cbmf(il)
+        ENDIF
+      END DO
+    END DO
+
+  ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !    PRINT*,'cv3_yield avant ft'
+  ! am is the part of cbmf taken from the first level
   DO il = 1, ncum
-    ma(il, nlp) = 0.
-    ma(il, 1)   = 0.
-  END DO
-  DO k = nl, 2, -1
-    DO il = 1, ncum
-      ma(il, k) = ma(il, k+1)*(1.-qta(il, k))/(1.-qta(il, k-1)) + m(il, k)
-      cbmf(il) = max(cbmf(il), ma(il,k))
-    END DO
-  END DO
-  DO k = 2,nl
-    DO il = 1, ncum
-      IF (k <icb(il)) THEN
-        ma(il, k) = ma(il, k-1) + wghti(il,k-1)*cbmf(il)
-      ENDIF
-    END DO
-  END DO
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Line kept for compatibility with earlier versions
-  DO k = 2, nl
-    DO il = 1, ncum
-      IF (k>=icb(il)) THEN
-        cbmf(il) = cbmf(il) + m(il, k)
-      END IF
-    END DO
-  END DO
-
-  DO il = 1, ncum
-    ma(il, nlp) = 0.
-    ma(il, 1)   = 0.
-  END DO
-  DO k = nl, 2, -1
-    DO il = 1, ncum
-      ma(il, k) = ma(il, k+1) + m(il, k)
-    END DO
-  END DO
-  DO k = 2,nl
-    DO il = 1, ncum
-      IF (k <icb(il)) THEN
-        ma(il, k) = ma(il, k-1) + wghti(il,k-1)*cbmf(il)
-      ENDIF
-    END DO
-  END DO
-
-  ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!    PRINT*,'cv3_yield avant ft'
-! am is the part of cbmf taken from the first level
-  DO il = 1, ncum
-    am(il) = cbmf(il)*wghti(il, 1)
+    am(il) = cbmf(il) * wghti(il, 1)
   END DO
 
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
-! convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
-!JYG  Correction pour conserver l'eau
-! cc       ft(il,1)=-0.5*lvcp(il,1)*sigd(il)*(evap(il,1)+evap(il,2))          !precip
+      ! convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
+      !JYG  Correction pour conserver l'eau
+      ! cc       ft(il,1)=-0.5*lvcp(il,1)*sigd(il)*(evap(il,1)+evap(il,2))          !precip
       IF (cvflag_ice) THEN
-        ft(il, 1) = -lvcp(il, 1)*sigd(il)*evap(il, 1) - &
-                     lfcp(il, 1)*sigd(il)*evap(il, 1)*faci(il, 1) - &
-                     lfcp(il, 1)*sigd(il)*(fondue(il,1)*wt(il,1)) / &
-                       (100.*(ph(il,1)-ph(il,2)))                             !precip
+        ft(il, 1) = -lvcp(il, 1) * sigd(il) * evap(il, 1) - &
+                lfcp(il, 1) * sigd(il) * evap(il, 1) * faci(il, 1) - &
+                lfcp(il, 1) * sigd(il) * (fondue(il, 1) * wt(il, 1)) / &
+                        (100. * (ph(il, 1) - ph(il, 2)))                             !precip
       ELSE
-        ft(il, 1) = -lvcp(il, 1)*sigd(il)*evap(il, 1)
+        ft(il, 1) = -lvcp(il, 1) * sigd(il) * evap(il, 1)
       END IF
 
-      ft(il, 1) = ft(il, 1) - 0.009*grav*sigd(il)*mp(il, 2)*t_wake(il, 1)*b(il, 1)*work(il)
+      ft(il, 1) = ft(il, 1) - 0.009 * grav * sigd(il) * mp(il, 2) * t_wake(il, 1) * b(il, 1) * work(il)
 
       IF (cvflag_ice) THEN
-        ft(il, 1) = ft(il, 1) + 0.01*sigd(il)*wt(il, 1)*(cl-cpd)*water(il, 2) * &
-                                     (t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1) + &
-                                0.01*sigd(il)*wt(il, 1)*(ci-cpd)*ice(il, 2) * &
-                                     (t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1)
+        ft(il, 1) = ft(il, 1) + 0.01 * sigd(il) * wt(il, 1) * (cl - cpd) * water(il, 2) * &
+                (t_wake(il, 2) - t_wake(il, 1)) * work(il) / cpn(il, 1) + &
+                0.01 * sigd(il) * wt(il, 1) * (ci - cpd) * ice(il, 2) * &
+                        (t_wake(il, 2) - t_wake(il, 1)) * work(il) / cpn(il, 1)
       ELSE
-        ft(il, 1) = ft(il, 1) + 0.01*sigd(il)*wt(il, 1)*(cl-cpd)*water(il, 2) * &
-                                     (t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1)
+        ft(il, 1) = ft(il, 1) + 0.01 * sigd(il) * wt(il, 1) * (cl - cpd) * water(il, 2) * &
+                (t_wake(il, 2) - t_wake(il, 1)) * work(il) / cpn(il, 1)
       END IF
 
       ftd(il, 1) = ft(il, 1)                                                  ! fin precip
 
-      IF ((0.01*grav*work(il)*am(il))>=delti) iflag(il) = 1 !consist vect
-!jyg<
-        IF (fl_cor_ebil >= 2) THEN
-          ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*am(il) * &
-                    ((t(il,2)-t(il,1))*cpn(il,2)+gz(il,2)-gz(il,1))/cpn(il,1)
-        ELSE
-          ft(il, 1) = 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))
-        ENDIF
-!>jyg
+      IF ((0.01 * grav * work(il) * am(il))>=delti) iflag(il) = 1 !consist vect
+      !jyg<
+      IF (fl_cor_ebil >= 2) THEN
+        ft(il, 1) = ft(il, 1) + 0.01 * grav * work(il) * am(il) * &
+                ((t(il, 2) - t(il, 1)) * cpn(il, 2) + gz(il, 2) - gz(il, 1)) / cpn(il, 1)
+      ELSE
+        ft(il, 1) = 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))
+      ENDIF
+      !>jyg
     END IF ! iflag
   END DO
-
 
   DO j = 2, nl
     IF (iflag_mix>0) THEN
       DO il = 1, ncum
-! FH WARNING a modifier :
+        ! FH WARNING a modifier :
         cpinv = 0.
-! cpinv=1.0/cpn(il,1)
+        ! cpinv=1.0/cpn(il,1)
         IF (j<=inb(il) .AND. iflag(il)<=1) THEN
-          ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*ment(il, j, 1) * &
-                     (hent(il,j,1)-h(il,1)+t(il,1)*(cpv-cpd)*(rr(il,1)-qent(il,j,1)))*cpinv
+          ft(il, 1) = ft(il, 1) + 0.01 * grav * work(il) * ment(il, j, 1) * &
+                  (hent(il, j, 1) - h(il, 1) + t(il, 1) * (cpv - cpd) * (rr(il, 1) - qent(il, j, 1))) * cpinv
         END IF ! j
       END DO
     END IF
   END DO
-! fin sature
-
+  ! fin sature
 
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
-!JYG1  Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
-      fr(il, 1) = 0.01*grav*mp(il, 2)*(rp(il,2)-rr_wake(il,1))*work(il) + &
-                  sigd(il)*evap(il, 1)
-!!!                  sigd(il)*0.5*(evap(il,1)+evap(il,2))
+      !JYG1  Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
+      fr(il, 1) = 0.01 * grav * mp(il, 2) * (rp(il, 2) - rr_wake(il, 1)) * work(il) + &
+              sigd(il) * evap(il, 1)
+      !!!                  sigd(il)*0.5*(evap(il,1)+evap(il,2))
 
       fqd(il, 1) = fr(il, 1) !precip
 
-      fr(il, 1) = fr(il, 1) + 0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)        !sature
-
-      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)))
+      fr(il, 1) = fr(il, 1) + 0.01 * grav * am(il) * (rr(il, 2) - rr(il, 1)) * work(il)        !sature
+
+      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)))
     END IF ! iflag
   END DO ! il
 
 
-!AC!     do j=1,ntra
-!AC!      do il=1,ncum
-!AC!       if (iflag(il) .le. 1) THEN
-!AC!       if (cvflag_grav) THEN
-!AC!        ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
-!AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
-!AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
-!AC!       else
-!AC!        ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
-!AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
-!AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
-!AC!       endif
-!AC!       endif  ! iflag
-!AC!      enddo
-!AC!     enddo
+  !AC!     do j=1,ntra
+  !AC!      do il=1,ncum
+  !AC!       if (iflag(il) .le. 1) THEN
+  !AC!       if (cvflag_grav) THEN
+  !AC!        ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
+  !AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
+  !AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
+  !AC!       else
+  !AC!        ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
+  !AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
+  !AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
+  !AC!       endif
+  !AC!       endif  ! iflag
+  !AC!      enddo
+  !AC!     enddo
 
   DO j = 2, nl
     DO il = 1, ncum
       IF (j<=inb(il) .AND. iflag(il)<=1) THEN
-        fr(il, 1) = fr(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
-        fr_comp(il,1) = fr_comp(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))
+        fr(il, 1) = fr(il, 1) + 0.01 * grav * work(il) * ment(il, j, 1) * (qent(il, j, 1) - rr(il, 1))
+        fr_comp(il, 1) = fr_comp(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))
       END IF ! j
     END DO
   END DO
 
-!AC!      do k=1,ntra
-!AC!       do j=2,nl
-!AC!        do il=1,ncum
-!AC!         if (j.le.inb(il) .AND. iflag(il) .le. 1) THEN
-!AC!
-!AC!          if (cvflag_grav) THEN
-!AC!           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
-!AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
-!AC!          else
-!AC!           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
-!AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
-!AC!          endif
-!AC!
-!AC!         endif
-!AC!        enddo
-!AC!       enddo
-!AC!      enddo
-! PRINT*,'cv3_yield apres ft'
-
-!jyg<
-!-----------------------------------------------------------
-           IF (ok_optim_yield) THEN                       !|
-!-----------------------------------------------------------
-
-!***                                                      ***
-!***    Compute convective mass fluxes upwd and dnwd      ***
-
-! =================================================
-!              upward fluxes                      |
-! ------------------------------------------------
-
-upwd(:,:) = 0.
-up_to(:,:) = 0.
-up_from(:,:) = 0.
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! The decrease of the adiabatic ascent mass flux due to ejection of precipitation 
-!! is taken into account. 
-!! WARNING : in the present version, taking into account the mass-flux decrease due to 
-!! precipitation ejection leads to water conservation violation.
-
-! - Upward mass flux of mixed draughts
-!---------------------------------------
-DO i = 2, nl
-  DO j = 1, i-1
-    DO il = 1, ncum
-      IF (i<=inb(il)) THEN
-        up_to(il,i) = up_to(il,i) + ment(il,j,i)
-      ENDIF
+  !AC!      do k=1,ntra
+  !AC!       do j=2,nl
+  !AC!        do il=1,ncum
+  !AC!         if (j.le.inb(il) .AND. iflag(il) .le. 1) THEN
+  !AC!
+  !AC!          if (cvflag_grav) THEN
+  !AC!           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
+  !AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
+  !AC!          else
+  !AC!           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
+  !AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
+  !AC!          endif
+  !AC!
+  !AC!         endif
+  !AC!        enddo
+  !AC!       enddo
+  !AC!      enddo
+  ! PRINT*,'cv3_yield apres ft'
+
+  !jyg<
+  !-----------------------------------------------------------
+  IF (ok_optim_yield) THEN                       !|
+    !-----------------------------------------------------------
+
+    !***                                                      ***
+    !***    Compute convective mass fluxes upwd and dnwd      ***
+
+    ! =================================================
+    !              upward fluxes                      |
+    ! ------------------------------------------------
+
+    upwd(:, :) = 0.
+    up_to(:, :) = 0.
+    up_from(:, :) = 0.
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! The decrease of the adiabatic ascent mass flux due to ejection of precipitation
+      !! is taken into account.
+      !! WARNING : in the present version, taking into account the mass-flux decrease due to
+      !! precipitation ejection leads to water conservation violation.
+
+      ! - Upward mass flux of mixed draughts
+      !---------------------------------------
+      DO i = 2, nl
+        DO j = 1, i - 1
+          DO il = 1, ncum
+            IF (i<=inb(il)) THEN
+              up_to(il, i) = up_to(il, i) + ment(il, j, i)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+
+      DO j = 3, nl
+        DO i = 2, j - 1
+          DO il = 1, ncum
+            IF (j<=inb(il)) THEN
+              up_from(il, i) = up_from(il, i) + ment(il, i, j)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+
+      ! The difference between upwd(il,i) and upwd(il,i-1) is due to updrafts ending in layer
+      !(i-1) (theses drafts cross interface (i-1) but not interface(i)) and to updrafts starting
+      !from layer (i-1) (theses drafts cross interface (i) but not interface(i-1)):
+
+      DO i = 2, nlp
+        DO il = 1, ncum
+          IF (i<=inb(il) + 1) THEN
+            upwd(il, i) = max(0., upwd(il, i - 1) - up_to(il, i - 1) + up_from(il, i - 1))
+          ENDIF
+        ENDDO
+      ENDDO
+
+      ! - Total upward mass flux
+      !---------------------------
+      DO i = 2, nlp
+        DO il = 1, ncum
+          IF (i<=inb(il) + 1) THEN
+            upwd(il, i) = upwd(il, i) + ma(il, i)
+          ENDIF
+        ENDDO
+      ENDDO
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! The decrease of the adiabatic ascent mass flux due to ejection of precipitation
+      !! is not taken into account.
+
+      ! - Upward mass flux
+      !-------------------
+      DO i = 2, nl
+        DO il = 1, ncum
+          IF (i<=inb(il)) THEN
+            up_to(il, i) = m(il, i)
+          ENDIF
+        ENDDO
+        DO j = 1, i - 1
+          DO il = 1, ncum
+            IF (i<=inb(il)) THEN
+              up_to(il, i) = up_to(il, i) + ment(il, j, i)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+
+      DO i = 1, nl
+        DO il = 1, ncum
+          IF (i<=inb(il)) THEN
+            up_from(il, i) = cbmf(il) * wghti(il, i)
+          ENDIF
+        ENDDO
+      ENDDO
+
+      DO j = 3, nl
+        DO i = 2, j - 1
+          DO il = 1, ncum
+            IF (j<=inb(il)) THEN
+              up_from(il, i) = up_from(il, i) + ment(il, i, j)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+
+      ! The difference between upwd(il,i) and upwd(il,i-1) is due to updrafts ending in layer
+      !(i-1) (theses drafts cross interface (i-1) but not interface(i)) and to updrafts starting
+      !from layer (i-1) (theses drafts cross interface (i) but not interface(i-1)):
+
+      DO i = 2, nlp
+        DO il = 1, ncum
+          IF (i<=inb(il) + 1) THEN
+            upwd(il, i) = max(0., upwd(il, i - 1) - up_to(il, i - 1) + up_from(il, i - 1))
+          ENDIF
+        ENDDO
+      ENDDO
+
+    ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    ! =================================================
+    !              downward fluxes                    |
+    ! ------------------------------------------------
+    dnwd(:, :) = 0.
+    dn_to(:, :) = 0.
+    dn_from(:, :) = 0.
+    DO i = 1, nl
+      DO j = i + 1, nl
+        DO il = 1, ncum
+          IF (j<=inb(il)) THEN
+            !!        dn_to(il,i) = dn_to(il,i) + ment(il,j,i)       !jyg,20220202
+            dn_to(il, i) = dn_to(il, i) - ment(il, j, i)
+          ENDIF
+        ENDDO
+      ENDDO
     ENDDO
-  ENDDO
-ENDDO
-
-DO j = 3, nl
-  DO i = 2, j-1
-    DO il = 1, ncum
-      IF (j<=inb(il)) THEN
-        up_from(il,i) = up_from(il,i) + ment(il,i,j)
-      ENDIF
+
+    DO j = 1, nl
+      DO i = j + 1, nl
+        DO il = 1, ncum
+          IF (i<=inb(il)) THEN
+            !!        dn_from(il,i) = dn_from(il,i) + ment(il,i,j)   !jyg,20220202
+            dn_from(il, i) = dn_from(il, i) - ment(il, i, j)
+          ENDIF
+        ENDDO
+      ENDDO
     ENDDO
-  ENDDO
-ENDDO
-
-! The difference between upwd(il,i) and upwd(il,i-1) is due to updrafts ending in layer 
-!(i-1) (theses drafts cross interface (i-1) but not interface(i)) and to updrafts starting 
-!from layer (i-1) (theses drafts cross interface (i) but not interface(i-1)): 
-
-DO i = 2, nlp
-  DO il = 1, ncum
-    IF (i<=inb(il)+1) THEN
-      upwd(il,i) = max(0., upwd(il,i-1) - up_to(il,i-1) + up_from(il,i-1))
-    ENDIF
-  ENDDO
-ENDDO
-
-! - Total upward mass flux
-!---------------------------
-DO i = 2, nlp
-  DO il = 1, ncum
-    IF (i<=inb(il)+1) THEN
-      upwd(il,i) = upwd(il,i) + ma(il,i)
-    ENDIF
-  ENDDO
-ENDDO
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! The decrease of the adiabatic ascent mass flux due to ejection of precipitation 
-!! is not taken into account. 
-
-! - Upward mass flux
-!-------------------
-DO i = 2, nl
-  DO il = 1, ncum
-    IF (i<=inb(il)) THEN
-      up_to(il,i) = m(il,i)
-    ENDIF
-  ENDDO
-  DO j = 1, i-1
-    DO il = 1, ncum
-      IF (i<=inb(il)) THEN
-        up_to(il,i) = up_to(il,i) + ment(il,j,i)
-      ENDIF
+
+    ! The difference between dnwd(il,i) and dnwd(il,i+1) is due to downdrafts ending in layer
+    !(i) (theses drafts cross interface (i+1) but not interface(i)) and to downdrafts
+    !starting from layer (i) (theses drafts cross interface (i) but not interface(i+1)):
+
+    DO i = nl - 1, 1, -1
+      DO il = 1, ncum
+        !!    dnwd(il,i) = max(0., dnwd(il,i+1) - dn_to(il,i) + dn_from(il,i)) !jyg,20220202
+        dnwd(il, i) = min(0., dnwd(il, i + 1) - dn_to(il, i) + dn_from(il, i))
+      ENDDO
     ENDDO
-  ENDDO
-ENDDO
-
-DO i = 1, nl
-  DO il = 1, ncum
-    IF (i<=inb(il)) THEN
-      up_from(il,i) = cbmf(il)*wghti(il,i)
-    ENDIF
-  ENDDO
-ENDDO
-
-DO j = 3, nl
-  DO i = 2, j-1
-    DO il = 1, ncum
-      IF (j<=inb(il)) THEN
-        up_from(il,i) = up_from(il,i) + ment(il,i,j)
-      ENDIF
-    ENDDO
-  ENDDO
-ENDDO
-
-! The difference between upwd(il,i) and upwd(il,i-1) is due to updrafts ending in layer 
-!(i-1) (theses drafts cross interface (i-1) but not interface(i)) and to updrafts starting 
-!from layer (i-1) (theses drafts cross interface (i) but not interface(i-1)): 
-
-DO i = 2, nlp
-  DO il = 1, ncum
-    IF (i<=inb(il)+1) THEN
-      upwd(il,i) = max(0., upwd(il,i-1) - up_to(il,i-1) + up_from(il,i-1))
-    ENDIF
-  ENDDO
-ENDDO
-
-
-  ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! =================================================
-!              downward fluxes                    |
-! ------------------------------------------------
-dnwd(:,:) = 0.
-dn_to(:,:) = 0.
-dn_from(:,:) = 0.
-DO i = 1, nl
-  DO j = i+1, nl
-    DO il = 1, ncum
-      IF (j<=inb(il)) THEN
-!!        dn_to(il,i) = dn_to(il,i) + ment(il,j,i)       !jyg,20220202
-        dn_to(il,i) = dn_to(il,i) - ment(il,j,i)
-      ENDIF
-    ENDDO
-  ENDDO
-ENDDO
-
-DO j = 1, nl
-  DO i = j+1, nl
-    DO il = 1, ncum
-      IF (i<=inb(il)) THEN
-!!        dn_from(il,i) = dn_from(il,i) + ment(il,i,j)   !jyg,20220202
-        dn_from(il,i) = dn_from(il,i) - ment(il,i,j)
-      ENDIF
-    ENDDO
-  ENDDO
-ENDDO
-
-! The difference between dnwd(il,i) and dnwd(il,i+1) is due to downdrafts ending in layer 
-!(i) (theses drafts cross interface (i+1) but not interface(i)) and to downdrafts 
-!starting from layer (i) (theses drafts cross interface (i) but not interface(i+1)): 
-
-DO i = nl-1, 1, -1
-  DO il = 1, ncum
-!!    dnwd(il,i) = max(0., dnwd(il,i+1) - dn_to(il,i) + dn_from(il,i)) !jyg,20220202
-    dnwd(il,i) = min(0., dnwd(il,i+1) - dn_to(il,i) + dn_from(il,i))
-  ENDDO
-ENDDO
-! =================================================
-
-!-----------------------------------------------------------
-        ENDIF !(ok_optim_yield)                           !|
-!-----------------------------------------------------------
-!>jyg
-
-! ***  calculate tendencies of potential temperature and mixing ratio  ***
-! ***               at levels above the lowest level                   ***
-
-! ***  first find the net saturated updraft and downdraft mass fluxes  ***
-! ***                      through each level                          ***
-
-
-!jyg<
-!!  DO i = 2, nl + 1 ! newvecto: mettre nl au lieu nl+1?
+    ! =================================================
+
+    !-----------------------------------------------------------
+  ENDIF !(ok_optim_yield)                           !|
+  !-----------------------------------------------------------
+  !>jyg
+
+  ! ***  calculate tendencies of potential temperature and mixing ratio  ***
+  ! ***               at levels above the lowest level                   ***
+
+  ! ***  first find the net saturated updraft and downdraft mass fluxes  ***
+  ! ***                      through each level                          ***
+
+
+  !jyg<
+  !!  DO i = 2, nl + 1 ! newvecto: mettre nl au lieu nl+1?
   DO i = 2, nl
-!>jyg 
+    !>jyg
 
     num1 = 0
@@ -4029 +3993 @@
     IF (num1<=0) GO TO 500
 
-!jyg<
-!-----------------------------------------------------------
-           IF (ok_optim_yield) THEN                       !|
-!-----------------------------------------------------------
-DO il = 1, ncum
-   amp1(il) = upwd(il,i+1)
-   ad(il) = dnwd(il,i)
-ENDDO
-!-----------------------------------------------------------
-        ELSE !(ok_optim_yield)                            !|
-!-----------------------------------------------------------
-!>jyg
-    DO il = 1,ncum
-      amp1(il) = 0.
-      ad(il) = 0.
-    ENDDO
-
-    DO k = 1, nl + 1
+    !jyg<
+    !-----------------------------------------------------------
+    IF (ok_optim_yield) THEN                       !|
+      !-----------------------------------------------------------
       DO il = 1, ncum
-        IF (i>=icb(il)) THEN
-          IF (k>=i+1 .AND. k<=(inb(il)+1)) THEN
-            amp1(il) = amp1(il) + m(il, k)
-          END IF
-        ELSE
-! AMP1 is the part of cbmf taken from layers I and lower
-          IF (k<=i) THEN
-            amp1(il) = amp1(il) + cbmf(il)*wghti(il, k)
-          END IF
-        END IF
-      END DO
-    END DO
-
-    DO j = i + 1, nl + 1         
-       DO k = 1, i
-          !yor! reverted j and k loops 
-          DO il = 1, ncum
-!yor!        IF (i<=inb(il) .AND. j<=(inb(il)+1)) THEN ! the second condition implies the first !
-             IF (j<=(inb(il)+1)) THEN  
-                amp1(il) = amp1(il) + ment(il, k, j)
-             END IF
-          END DO
-       END DO
-    END DO
-
-    DO k = 1, i - 1
-!jyg<
-!!      DO j = i, nl + 1 ! newvecto: nl au lieu nl+1?
-      DO j = i, nl
-!>jyg
+        amp1(il) = upwd(il, i + 1)
+        ad(il) = dnwd(il, i)
+      ENDDO
+      !-----------------------------------------------------------
+    ELSE !(ok_optim_yield)                            !|
+      !-----------------------------------------------------------
+      !>jyg
+      DO il = 1, ncum
+        amp1(il) = 0.
+        ad(il) = 0.
+      ENDDO
+
+      DO k = 1, nl + 1
         DO il = 1, ncum
-!yor!        IF (i<=inb(il) .AND. j<=inb(il)) THEN ! the second condition implies the 1st !
-             IF (j<=inb(il)) THEN   
-            ad(il) = ad(il) + ment(il, j, k)
+          IF (i>=icb(il)) THEN
+            IF (k>=i + 1 .AND. k<=(inb(il) + 1)) THEN
+              amp1(il) = amp1(il) + m(il, k)
+            END IF
+          ELSE
+            ! AMP1 is the part of cbmf taken from layers I and lower
+            IF (k<=i) THEN
+              amp1(il) = amp1(il) + cbmf(il) * wghti(il, k)
+            END IF
           END IF
         END DO
       END DO
-    END DO
-
-!-----------------------------------------------------------
-        ENDIF !(ok_optim_yield)                           !|
-!-----------------------------------------------------------
-
-!!   print *,'yield, i, amp1, ad', i, amp1(1), ad(1)
+
+      DO j = i + 1, nl + 1
+        DO k = 1, i
+          !yor! reverted j and k loops
+          DO il = 1, ncum
+            !yor!        IF (i<=inb(il) .AND. j<=(inb(il)+1)) THEN ! the second condition implies the first !
+            IF (j<=(inb(il) + 1)) THEN
+              amp1(il) = amp1(il) + ment(il, k, j)
+            END IF
+          END DO
+        END DO
+      END DO
+
+      DO k = 1, i - 1
+        !jyg<
+        !!      DO j = i, nl + 1 ! newvecto: nl au lieu nl+1?
+        DO j = i, nl
+          !>jyg
+          DO il = 1, ncum
+            !yor!        IF (i<=inb(il) .AND. j<=inb(il)) THEN ! the second condition implies the 1st !
+            IF (j<=inb(il)) THEN
+              ad(il) = ad(il) + ment(il, j, k)
+            END IF
+          END DO
+        END DO
+      END DO
+
+      !-----------------------------------------------------------
+    ENDIF !(ok_optim_yield)                           !|
+    !-----------------------------------------------------------
+
+    !!   print *,'yield, i, amp1, ad', i, amp1(1), ad(1)
 
     DO il = 1, ncum
       IF (i<=inb(il) .AND. iflag(il)<=1) THEN
-        dpinv = 1.0/(ph(il,i)-ph(il,i+1))
-        cpinv = 1.0/cpn(il, i)
-
-! convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
-        IF ((0.01*grav*dpinv*amp1(il))>=delti) iflag(il) = 1 ! vecto
-
-! precip
-! cc       ft(il,i)= -0.5*sigd(il)*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
+        dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
+        cpinv = 1.0 / cpn(il, i)
+
+        ! convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
+        IF ((0.01 * grav * dpinv * amp1(il))>=delti) iflag(il) = 1 ! vecto
+
+        ! precip
+        ! cc       ft(il,i)= -0.5*sigd(il)*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
         IF (cvflag_ice) THEN
-          ft(il, i) = -sigd(il)*lvcp(il, i)*evap(il, i) - &
-                       sigd(il)*lfcp(il, i)*evap(il, i)*faci(il, i) - &
-                       sigd(il)*lfcp(il, i)*fondue(il, i)*wt(il, i)/(100.*(p(il,i-1)-p(il,i)))
+          ft(il, i) = -sigd(il) * lvcp(il, i) * evap(il, i) - &
+                  sigd(il) * lfcp(il, i) * evap(il, i) * faci(il, i) - &
+                  sigd(il) * lfcp(il, i) * fondue(il, i) * wt(il, i) / (100. * (p(il, i - 1) - p(il, i)))
         ELSE
-          ft(il, i) = -sigd(il)*lvcp(il, i)*evap(il, i)
+          ft(il, i) = -sigd(il) * lvcp(il, i) * evap(il, i)
         END IF
 
-        rat = cpn(il, i-1)*cpinv
-
-        ft(il, i) = ft(il, i) - 0.009*grav*sigd(il) * &
-                     (mp(il,i+1)*t_wake(il,i)*b(il,i)-mp(il,i)*t_wake(il,i-1)*rat*b(il,i-1))*dpinv
+        rat = cpn(il, i - 1) * cpinv
+
+        ft(il, i) = ft(il, i) - 0.009 * grav * sigd(il) * &
+                (mp(il, i + 1) * t_wake(il, i) * b(il, i) - mp(il, i) * t_wake(il, i - 1) * rat * b(il, i - 1)) * dpinv
         IF (cvflag_ice) THEN
-          ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il, i+1) * &
-                                       (t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv + &
-                                  0.01*sigd(il)*wt(il, i)*(ci-cpd)*ice(il, i+1) * &
-                                       (t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv
+          ft(il, i) = ft(il, i) + 0.01 * sigd(il) * wt(il, i) * (cl - cpd) * water(il, i + 1) * &
+                  (t_wake(il, i + 1) - t_wake(il, i)) * dpinv * cpinv + &
+                  0.01 * sigd(il) * wt(il, i) * (ci - cpd) * ice(il, i + 1) * &
+                          (t_wake(il, i + 1) - t_wake(il, i)) * dpinv * cpinv
         ELSE
-          ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il, i+1) * &
-                                       (t_wake(il,i+1)-t_wake(il,i))*dpinv* &
-            cpinv
+          ft(il, i) = ft(il, i) + 0.01 * sigd(il) * wt(il, i) * (cl - cpd) * water(il, i + 1) * &
+                  (t_wake(il, i + 1) - t_wake(il, i)) * dpinv * &
+                  cpinv
         END IF
 
         ftd(il, i) = ft(il, i)
-! fin precip
-
-! sature
-!jyg<
+        ! fin precip
+
+        ! sature
+        !jyg<
         IF (fl_cor_ebil >= 2) THEN
-          ft(il, i) = ft(il, i) + 0.01*grav*dpinv * &
-              ( amp1(il)*( (t(il,i+1)-t(il,i))*cpn(il,i+1) + gz(il,i+1)-gz(il,i))*cpinv - &
-                ad(il)*( (t(il,i)-t(il,i-1))*cpn(il,i-1) + gz(il,i)-gz(il,i-1))*cpinv)
+          ft(il, i) = ft(il, i) + 0.01 * grav * dpinv * &
+                  (amp1(il) * ((t(il, i + 1) - t(il, i)) * cpn(il, i + 1) + gz(il, i + 1) - gz(il, i)) * cpinv - &
+                          ad(il) * ((t(il, i) - t(il, i - 1)) * cpn(il, i - 1) + gz(il, i) - gz(il, i - 1)) * cpinv)
         ELSE
-          ft(il, i) = 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))
+          ft(il, i) = 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))
         ENDIF
-!>jyg
-
+        !>jyg
 
         IF (iflag_mix==0) THEN
-          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
+          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
         END IF
 
-! sb: on ne fait pas encore la correction permettant de mieux
-! conserver l'eau:
-!JYG: correction permettant de mieux conserver l'eau:
-! cc         fr(il,i)=0.5*sigd(il)*(evap(il,i)+evap(il,i+1))
-        fr(il, i) = sigd(il)*evap(il, i) + 0.01*grav*(mp(il,i+1)*(rp(il,i+1)-rr_wake(il,i)) - &
-                                                      mp(il,i)*(rp(il,i)-rr_wake(il,i-1)))*dpinv
+        ! sb: on ne fait pas encore la correction permettant de mieux
+        ! conserver l'eau:
+        !JYG: correction permettant de mieux conserver l'eau:
+        ! cc         fr(il,i)=0.5*sigd(il)*(evap(il,i)+evap(il,i+1))
+        fr(il, i) = sigd(il) * evap(il, i) + 0.01 * grav * (mp(il, i + 1) * (rp(il, i + 1) - rr_wake(il, i)) - &
+                mp(il, i) * (rp(il, i) - rr_wake(il, i - 1))) * dpinv
         fqd(il, i) = fr(il, i)                                                                     ! precip
 
-        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) = 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
-
-
-        fr(il, i) = 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)))
+        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) = 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
+
+        fr(il, i) = 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)))
 
       END IF ! i
     END DO
 
-!AC!      do k=1,ntra
-!AC!       do il=1,ncum
-!AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
-!AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
-!AC!         cpinv=1.0/cpn(il,i)
-!AC!         if (cvflag_grav) THEN
-!AC!           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
-!AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
-!AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
-!AC!         else
-!AC!           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
-!AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
-!AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
-!AC!         endif
-!AC!        endif
-!AC!       enddo
-!AC!      enddo
+    !AC!      do k=1,ntra
+    !AC!       do il=1,ncum
+    !AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
+    !AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+    !AC!         cpinv=1.0/cpn(il,i)
+    !AC!         if (cvflag_grav) THEN
+    !AC!           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
+    !AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
+    !AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
+    !AC!         else
+    !AC!           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
+    !AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
+    !AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
+    !AC!         endif
+    !AC!        endif
+    !AC!       enddo
+    !AC!      enddo
 
     DO k = 1, i - 1
 
       DO il = 1, ncum
-        awat(il) = elij(il, k, i) - (1.-ep(il,i))*clw(il, i)
+        awat(il) = elij(il, k, i) - (1. - ep(il, i)) * clw(il, i)
         awat(il) = max(awat(il), 0.0)
       END DO
@@ -4200 +4162 @@
         DO il = 1, ncum
           IF (i<=inb(il) .AND. iflag(il)<=1) THEN
-            dpinv = 1.0/(ph(il,i)-ph(il,i+1))
-            cpinv = 1.0/cpn(il, i)
-            ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
-                 (hent(il,k,i)-h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)+awat(il)-qent(il,k,i)))*cpinv
-
+            dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
+            cpinv = 1.0 / cpn(il, i)
+            ft(il, i) = ft(il, i) + 0.01 * grav * dpinv * ment(il, k, i) * &
+                    (hent(il, k, i) - h(il, i) + t(il, i) * (cpv - cpd) * (rr(il, i) + awat(il) - qent(il, k, i))) * cpinv
 
           END IF ! i
@@ -4212 +4173 @@
       DO il = 1, ncum
         IF (i<=inb(il) .AND. iflag(il)<=1) THEN
-          dpinv = 1.0/(ph(il,i)-ph(il,i+1))
-          cpinv = 1.0/cpn(il, i)
-          fr(il, i) = fr(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
-                                                       (qent(il,k,i)-awat(il)-rr(il,i))
-          fr_comp(il,i) = fr_comp(il,i) + 0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat(il)-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))
-
-! (saturated updrafts resulting from mixing)                                   ! cld
-          qcond(il, i) = qcond(il, i) + (elij(il,k,i)-awat(il))                ! cld
-          qdet(il,k,i) = (qent(il,k,i)-awat(il))                               ! cld Louis : specific humidity in detraining water
-          qtment(il, i) = qtment(il, i) + qent(il,k,i)                         ! cld
+          dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
+          cpinv = 1.0 / cpn(il, i)
+          fr(il, i) = fr(il, i) + 0.01 * grav * dpinv * ment(il, k, i) * &
+                  (qent(il, k, i) - awat(il) - rr(il, i))
+          fr_comp(il, i) = fr_comp(il, i) + 0.01 * grav * dpinv * ment(il, k, i) * (qent(il, k, i) - awat(il) - 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))
+
+          ! (saturated updrafts resulting from mixing)                                   ! cld
+          qcond(il, i) = qcond(il, i) + (elij(il, k, i) - awat(il))                ! cld
+          qdet(il, k, i) = (qent(il, k, i) - awat(il))                               ! cld Louis : specific humidity in detraining water
+          qtment(il, i) = qtment(il, i) + qent(il, k, i)                         ! cld
           nqcond(il, i) = nqcond(il, i) + 1.                                   ! cld
         END IF ! i
@@ -4229 +4190 @@
     END DO
 
-!AC!      do j=1,ntra
-!AC!       do k=1,i-1
-!AC!        do il=1,ncum
-!AC!         if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
-!AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
-!AC!          cpinv=1.0/cpn(il,i)
-!AC!          if (cvflag_grav) THEN
-!AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
-!AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
-!AC!          else
-!AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
-!AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
-!AC!          endif
-!AC!         endif
-!AC!        enddo
-!AC!       enddo
-!AC!      enddo
-
-!jyg<
-!!    DO k = i, nl + 1
+    !AC!      do j=1,ntra
+    !AC!       do k=1,i-1
+    !AC!        do il=1,ncum
+    !AC!         if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
+    !AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
+    !AC!          cpinv=1.0/cpn(il,i)
+    !AC!          if (cvflag_grav) THEN
+    !AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
+    !AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
+    !AC!          else
+    !AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
+    !AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
+    !AC!          endif
+    !AC!         endif
+    !AC!        enddo
+    !AC!       enddo
+    !AC!      enddo
+
+    !jyg<
+    !!    DO k = i, nl + 1
     DO k = i, nl
-!>jyg
+      !>jyg
 
       IF (iflag_mix/=0) THEN
         DO il = 1, ncum
           IF (i<=inb(il) .AND. k<=inb(il) .AND. iflag(il)<=1) THEN
-            dpinv = 1.0/(ph(il,i)-ph(il,i+1))
-            cpinv = 1.0/cpn(il, i)
-            ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
-                  (hent(il,k,i)-h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,k,i)))*cpinv
-
+            dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
+            cpinv = 1.0 / cpn(il, i)
+            ft(il, i) = ft(il, i) + 0.01 * grav * dpinv * ment(il, k, i) * &
+                    (hent(il, k, i) - h(il, i) + t(il, i) * (cpv - cpd) * (rr(il, i) - qent(il, k, i))) * cpinv
 
           END IF ! i
@@ -4267 +4227 @@
       DO il = 1, ncum
         IF (i<=inb(il) .AND. k<=inb(il) .AND. iflag(il)<=1) THEN
-          dpinv = 1.0/(ph(il,i)-ph(il,i+1))
-          cpinv = 1.0/cpn(il, i)
-
-          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))
+          dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
+          cpinv = 1.0 / cpn(il, i)
+
+          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))
         END IF ! i and k
       END DO
     END DO
 
-!AC!      do j=1,ntra
-!AC!       do k=i,nl+1
-!AC!        do il=1,ncum
-!AC!         if (i.le.inb(il) .AND. k.le.inb(il)
-!AC!     $                .AND. iflag(il) .le. 1) THEN
-!AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
-!AC!          cpinv=1.0/cpn(il,i)
-!AC!          if (cvflag_grav) THEN
-!AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
-!AC!     :         *(traent(il,k,i,j)-tra(il,i,j))
-!AC!          else
-!AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
-!AC!     :             *(traent(il,k,i,j)-tra(il,i,j))
-!AC!          endif
-!AC!         endif ! i and k
-!AC!        enddo
-!AC!       enddo
-!AC!      enddo
-
-! sb: interface with the cloud parameterization:                               ! cld
+    !AC!      do j=1,ntra
+    !AC!       do k=i,nl+1
+    !AC!        do il=1,ncum
+    !AC!         if (i.le.inb(il) .AND. k.le.inb(il)
+    !AC!     $                .AND. iflag(il) .le. 1) THEN
+    !AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
+    !AC!          cpinv=1.0/cpn(il,i)
+    !AC!          if (cvflag_grav) THEN
+    !AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
+    !AC!     :         *(traent(il,k,i,j)-tra(il,i,j))
+    !AC!          else
+    !AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
+    !AC!     :             *(traent(il,k,i,j)-tra(il,i,j))
+    !AC!          endif
+    !AC!         endif ! i and k
+    !AC!        enddo
+    !AC!       enddo
+    !AC!      enddo
+
+    ! sb: interface with the cloud parameterization:                               ! cld
 
     DO k = i + 1, nl
       DO il = 1, ncum
         IF (k<=inb(il) .AND. i<=inb(il) .AND. iflag(il)<=1) THEN               ! cld
-! (saturated downdrafts resulting from mixing)                                 ! cld
+          ! (saturated downdrafts resulting from mixing)                                 ! cld
           qcond(il, i) = qcond(il, i) + elij(il, k, i)                         ! cld
-          qdet(il,k,i) = qent(il,k,i)                                          ! cld Louis : specific humidity in detraining water
-          qtment(il, i) = qent(il,k,i) + qtment(il,i)                          ! cld
+          qdet(il, k, i) = qent(il, k, i)                                          ! cld Louis : specific humidity in detraining water
+          qtment(il, i) = qent(il, k, i) + qtment(il, i)                          ! cld
           nqcond(il, i) = nqcond(il, i) + 1.                                   ! cld
         END IF ! cld
@@ -4310 +4270 @@
     END DO ! cld
 
-!ym BIG Warning : it seems that the k loop is missing !!!
-!ym Strong advice to check this
-!ym add a k loop temporary 
-
-! (particular case: no detraining level is found)                              ! cld
-! Verif merge Dynamico<<<<<<< .working
+    !ym BIG Warning : it seems that the k loop is missing !!!
+    !ym Strong advice to check this
+    !ym add a k loop temporary
+
+    ! (particular case: no detraining level is found)                              ! cld
+    ! Verif merge Dynamico<<<<<<< .working
     DO il = 1, ncum                                                            ! cld
-      IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN              ! cld
-        qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i)                 ! cld
-!jyg<   Bug correction 20180620
-!      PROBLEM: Should not qent(il,i,i) be taken into account even if nent(il,i)/=0?
-!!        qtment(il, i) = qent(il,k,i) + qtment(il,i)                            ! cld
-        qdet(il,i,i) = qent(il,i,i)                                            ! cld Louis : specific humidity in detraining water
-        qtment(il, i) = qent(il,i,i) + qtment(il,i)                            ! cld
-!>jyg
+      IF (i<=inb(il) .AND. nent(il, i)==0 .AND. iflag(il)<=1) THEN              ! cld
+        qcond(il, i) = qcond(il, i) + (1. - ep(il, i)) * clw(il, i)                 ! cld
+        !jyg<   Bug correction 20180620
+        !      PROBLEM: Should not qent(il,i,i) be taken into account even if nent(il,i)/=0?
+        !!        qtment(il, i) = qent(il,k,i) + qtment(il,i)                            ! cld
+        qdet(il, i, i) = qent(il, i, i)                                            ! cld Louis : specific humidity in detraining water
+        qtment(il, i) = qent(il, i, i) + qtment(il, i)                            ! cld
+        !>jyg
         nqcond(il, i) = nqcond(il, i) + 1.                                     ! cld
       END IF                                                                   ! cld
     END DO                                                                     ! cld
-! Verif merge Dynamico =======
-! Verif merge Dynamico     DO k = i + 1, nl
-! Verif merge Dynamico       DO il = 1, ncum        !ym k loop added                                    ! cld
-! Verif merge Dynamico         IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN              ! cld
-! Verif merge Dynamico           qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i)                 ! cld
-! Verif merge Dynamico           qtment(il, i) = qent(il,k,i) + qtment(il,i)                          ! cld
-! Verif merge Dynamico           nqcond(il, i) = nqcond(il, i) + 1.                                     ! cld
-! Verif merge Dynamico         END IF                                                                   ! cld
-! Verif merge Dynamico       END DO
-! Verif merge Dynamico     ENDDO                                                                     ! cld
-! Verif merge Dynamico >>>>>>> .merge-right.r3413
+    ! Verif merge Dynamico =======
+    ! Verif merge Dynamico     DO k = i + 1, nl
+    ! Verif merge Dynamico       DO il = 1, ncum        !ym k loop added                                    ! cld
+    ! Verif merge Dynamico         IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN              ! cld
+    ! Verif merge Dynamico           qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i)                 ! cld
+    ! Verif merge Dynamico           qtment(il, i) = qent(il,k,i) + qtment(il,i)                          ! cld
+    ! Verif merge Dynamico           nqcond(il, i) = nqcond(il, i) + 1.                                     ! cld
+    ! Verif merge Dynamico         END IF                                                                   ! cld
+    ! Verif merge Dynamico       END DO
+    ! Verif merge Dynamico     ENDDO                                                                     ! cld
+    ! Verif merge Dynamico >>>>>>> .merge-right.r3413
 
     DO il = 1, ncum                                                            ! cld
-      IF (i<=inb(il) .AND. nqcond(il,i)/=0 .AND. iflag(il)<=1) THEN            ! cld
-        qcond(il, i) = qcond(il, i)/nqcond(il, i)                              ! cld
-        qtment(il, i) = qtment(il,i)/nqcond(il, i)                             ! cld
+      IF (i<=inb(il) .AND. nqcond(il, i)/=0 .AND. iflag(il)<=1) THEN            ! cld
+        qcond(il, i) = qcond(il, i) / nqcond(il, i)                              ! cld
+        qtment(il, i) = qtment(il, i) / nqcond(il, i)                             ! cld
       END IF                                                                   ! cld
     END DO
 
-!AC!      do j=1,ntra
-!AC!       do il=1,ncum
-!AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
-!AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
-!AC!         cpinv=1.0/cpn(il,i)
-!AC!
-!AC!         if (cvflag_grav) THEN
-!AC!          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
-!AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
-!AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
-!AC!         else
-!AC!          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
-!AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
-!AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
-!AC!         endif
-!AC!        endif ! i
-!AC!       enddo
-!AC!      enddo
-
-
-500 END DO
-
-!JYG<
-!Conservation de l'eau
-!   sumdq = 0.
-!   DO k = 1, nl
-!     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
-!   END DO
-!   PRINT *, 'cv3_yield, apres 500, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
-!JYG>
-! ***   move the detrainment at level inb down to level inb-1   ***
-! ***        in such a way as to preserve the vertically        ***
-! ***          integrated enthalpy and water tendencies         ***
-
-! Correction bug le 18-03-09
+    !AC!      do j=1,ntra
+    !AC!       do il=1,ncum
+    !AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
+    !AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+    !AC!         cpinv=1.0/cpn(il,i)
+    !AC!
+    !AC!         if (cvflag_grav) THEN
+    !AC!          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
+    !AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
+    !AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
+    !AC!         else
+    !AC!          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
+    !AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
+    !AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
+    !AC!         endif
+    !AC!        endif ! i
+    !AC!       enddo
+    !AC!      enddo
+
+  500 END DO
+
+  !JYG<
+  !Conservation de l'eau
+  !   sumdq = 0.
+  !   DO k = 1, nl
+  !     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
+  !   END DO
+  !   PRINT *, 'cv3_yield, apres 500, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
+  !JYG>
+  ! ***   move the detrainment at level inb down to level inb-1   ***
+  ! ***        in such a way as to preserve the vertically        ***
+  ! ***          integrated enthalpy and water tendencies         ***
+
+  ! Correction bug le 18-03-09
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
-      ax = 0.01*grav*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)))
+      ax = 0.01 * grav * 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.01*grav*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))
+      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.01 * grav * 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.01*grav*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))
+      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.01 * grav * 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.01*grav*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))
+      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.01 * grav * 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)))
+      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)))
     END IF !iflag
   END DO
 
-!JYG<
-!Conservation de l'eau
-!   sumdq = 0.
-!   DO k = 1, nl
-!     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
-!   END DO
-!   PRINT *, 'cv3_yield, apres 503, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
-!JYG>
-
-!AC!      do j=1,ntra
-!AC!       do il=1,ncum
-!AC!        IF (iflag(il) .le. 1) THEN
-!AC!    IF (cvflag_grav) THEN
-!AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
-!AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
-!AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
-!AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
-!AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
-!AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
-!AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
-!AC!    else
-!AC!        ex=0.1*ment(il,inb(il),inb(il))
-!AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
-!AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
-!AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
-!AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
-!AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
-!AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
-!AC!        ENDIF   !cvflag grav
-!AC!        ENDIF    !iflag
-!AC!       enddo
-!AC!      enddo
-
-
-! ***    homogenize tendencies below cloud base    ***
-
+  !JYG<
+  !Conservation de l'eau
+  !   sumdq = 0.
+  !   DO k = 1, nl
+  !     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
+  !   END DO
+  !   PRINT *, 'cv3_yield, apres 503, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
+  !JYG>
+
+  !AC!      do j=1,ntra
+  !AC!       do il=1,ncum
+  !AC!        IF (iflag(il) .le. 1) THEN
+  !AC!  IF (cvflag_grav) THEN
+  !AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
+  !AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+  !AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+  !AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+  !AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+  !AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+  !AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+  !AC!  else
+  !AC!        ex=0.1*ment(il,inb(il),inb(il))
+  !AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+  !AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+  !AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+  !AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+  !AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+  !AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+  !AC!        ENDIF   !cvflag grav
+  !AC!        ENDIF    !iflag
+  !AC!       enddo
+  !AC!      enddo
+
+
+  ! ***    homogenize tendencies below cloud base    ***
 
   DO il = 1, ncum
@@ -4459 +4417 @@
   END DO
 
-!do i=1,nl
-!do il=1,ncum
-!th_wake(il,i)=t_wake(il,i)*(1000.0/p(il,i))**rdcp
-!enddo
-!enddo
+  !do i=1,nl
+  !do il=1,ncum
+  !th_wake(il,i)=t_wake(il,i)*(1000.0/p(il,i))**rdcp
+  !enddo
+  !enddo
 
   DO i = 1, nl
     DO il = 1, ncum
-      IF (i<=(icb(il)-1) .AND. iflag(il)<=1) THEN
-!jyg  Saturated part : use T profile
-        asum(il) = asum(il) + (ft(il,i)-ftd(il,i))*(ph(il,i)-ph(il,i+1))
-!jyg<20140311
-!Correction pour conserver l eau
+      IF (i<=(icb(il) - 1) .AND. iflag(il)<=1) THEN
+        !jyg  Saturated part : use T profile
+        asum(il) = asum(il) + (ft(il, i) - ftd(il, i)) * (ph(il, i) - ph(il, i + 1))
+        !jyg<20140311
+        !Correction pour conserver l eau
         IF (ok_conserv_q) THEN
-          bsum(il) = bsum(il) + (fr(il,i)-fqd(il,i))*(ph(il,i)-ph(il,i+1))
-          csum(il) = csum(il) + (ph(il,i)-ph(il,i+1))
+          bsum(il) = bsum(il) + (fr(il, i) - fqd(il, i)) * (ph(il, i) - ph(il, i + 1))
+          csum(il) = csum(il) + (ph(il, i) - ph(il, i + 1))
 
         ELSE
-          bsum(il)=bsum(il)+(fr(il,i)-fqd(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))
+          bsum(il) = bsum(il) + (fr(il, i) - fqd(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))
         ENDIF ! (ok_conserv_q)
-!jyg>
-        dsum(il) = dsum(il) + t(il, i)*(ph(il,i)-ph(il,i+1))/th(il, i)
-!jyg  Unsaturated part : use T_wake profile
-        esum(il) = esum(il) + ftd(il, i)*(ph(il,i)-ph(il,i+1))
-!jyg<20140311
-!Correction pour conserver l eau
+        !jyg>
+        dsum(il) = dsum(il) + t(il, i) * (ph(il, i) - ph(il, i + 1)) / th(il, i)
+        !jyg  Unsaturated part : use T_wake profile
+        esum(il) = esum(il) + ftd(il, i) * (ph(il, i) - ph(il, i + 1))
+        !jyg<20140311
+        !Correction pour conserver l eau
         IF (ok_conserv_q) THEN
-          fsum(il) = fsum(il) + fqd(il, i)*(ph(il,i)-ph(il,i+1))
-          gsum(il) = gsum(il) + (ph(il,i)-ph(il,i+1))
+          fsum(il) = fsum(il) + fqd(il, i) * (ph(il, i) - ph(il, i + 1))
+          gsum(il) = gsum(il) + (ph(il, i) - ph(il, i + 1))
         ELSE
-          fsum(il)=fsum(il)+fqd(il,i)*(lv(il,i)+(cl-cpd)*(t_wake(il,i)-t_wake(il,1)))* &
-                            (ph(il,i)-ph(il,i+1))
-          gsum(il)=gsum(il)+(lv(il,i)+(cl-cpd)*(t_wake(il,i)-t_wake(il,1)))* &
-                            (ph(il,i)-ph(il,i+1))
+          fsum(il) = fsum(il) + fqd(il, i) * (lv(il, i) + (cl - cpd) * (t_wake(il, i) - t_wake(il, 1))) * &
+                  (ph(il, i) - ph(il, i + 1))
+          gsum(il) = gsum(il) + (lv(il, i) + (cl - cpd) * (t_wake(il, i) - t_wake(il, 1))) * &
+                  (ph(il, i) - ph(il, i + 1))
         ENDIF ! (ok_conserv_q)
-!jyg>
-        hsum(il) = hsum(il) + t_wake(il, i)*(ph(il,i)-ph(il,i+1))/th_wake(il, i)
+        !jyg>
+        hsum(il) = hsum(il) + t_wake(il, i) * (ph(il, i) - ph(il, i + 1)) / th_wake(il, i)
       END IF
     END DO
   END DO
 
-!!!!      do 700 i=1,icb(il)-1
+  !!!!      do 700 i=1,icb(il)-1
   IF (ok_homo_tend) THEN
     DO i = 1, nl
       DO il = 1, ncum
-        IF (i<=(icb(il)-1) .AND. iflag(il)<=1) THEN
-          ftd(il, i) = esum(il)*t_wake(il, i)/(th_wake(il,i)*hsum(il))
-          fqd(il, i) = fsum(il)/gsum(il)
-          ft(il, i) = ftd(il, i) + asum(il)*t(il, i)/(th(il,i)*dsum(il))
-          fr(il, i) = fqd(il, i) + bsum(il)/csum(il)
+        IF (i<=(icb(il) - 1) .AND. iflag(il)<=1) THEN
+          ftd(il, i) = esum(il) * t_wake(il, i) / (th_wake(il, i) * hsum(il))
+          fqd(il, i) = fsum(il) / gsum(il)
+          ft(il, i) = ftd(il, i) + asum(il) * t(il, i) / (th(il, i) * dsum(il))
+          fr(il, i) = fqd(il, i) + bsum(il) / csum(il)
         END IF
       END DO
@@ -4517 +4475 @@
   ENDIF
 
-!jyg<
-!Conservation de l'eau
-!!  sumdq = 0.
-!!  DO k = 1, nl
-!!    sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
-!!  END DO
-!!  PRINT *, 'cv3_yield, apres hom, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
-!jyg>
-
-
-! ***   Check that moisture stays positive. If not, scale tendencies
-! in order to ensure moisture positivity
+  !jyg<
+  !Conservation de l'eau
+  !!  sumdq = 0.
+  !!  DO k = 1, nl
+  !!    sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
+  !!  END DO
+  !!  PRINT *, 'cv3_yield, apres hom, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
+  !jyg>
+
+
+  ! ***   Check that moisture stays positive. If not, scale tendencies
+  ! in order to ensure moisture positivity
   DO il = 1, ncum
     alpha_qpos(il) = 1.
     IF (iflag(il)<=1) THEN
-      IF (fr(il,1)<=0.) THEN
-        alpha_qpos(il) = max(alpha_qpos(il), (-delt*fr(il,1))/(s_wake(il)*rr_wake(il,1)+(1.-s_wake(il))*rr(il,1)))
+      IF (fr(il, 1)<=0.) THEN
+        alpha_qpos(il) = max(alpha_qpos(il), (-delt * fr(il, 1)) / (s_wake(il) * rr_wake(il, 1) + (1. - s_wake(il)) * rr(il, 1)))
       END IF
     END IF
@@ -4540 +4498 @@
     DO il = 1, ncum
       IF (iflag(il)<=1) THEN
-        IF (fr(il,i)<=0.) THEN
-          alpha_qpos1(il) = max(1., (-delt*fr(il,i))/(s_wake(il)*rr_wake(il,i)+(1.-s_wake(il))*rr(il,i)))
+        IF (fr(il, i)<=0.) THEN
+          alpha_qpos1(il) = max(1., (-delt * fr(il, i)) / (s_wake(il) * rr_wake(il, i) + (1. - s_wake(il)) * rr(il, i)))
           IF (alpha_qpos1(il)>=alpha_qpos(il)) alpha_qpos(il) = alpha_qpos1(il)
         END IF
@@ -4549 +4507 @@
   DO il = 1, ncum
     IF (iflag(il)<=1 .AND. alpha_qpos(il)>1.001) THEN
-      alpha_qpos(il) = alpha_qpos(il)*1.1
+      alpha_qpos(il) = alpha_qpos(il) * 1.1
     END IF
   END DO
 
-    IF (prt_level >= 5) THEN
-      print *,' CV3_YIELD : alpha_qpos ',alpha_qpos(1)
-    ENDIF
+  IF (prt_level >= 5) THEN
+    print *, ' CV3_YIELD : alpha_qpos ', alpha_qpos(1)
+  ENDIF
 
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
-      sigd(il) = sigd(il)/alpha_qpos(il)
-      precip(il) = precip(il)/alpha_qpos(il)
-      cbmf(il) = cbmf(il)/alpha_qpos(il)
+      sigd(il) = sigd(il) / alpha_qpos(il)
+      precip(il) = precip(il) / alpha_qpos(il)
+      cbmf(il) = cbmf(il) / alpha_qpos(il)
     END IF
   END DO
@@ -4567 +4525 @@
     DO il = 1, ncum
       IF (iflag(il)<=1) THEN
-        fr(il, i) = fr(il, i)/alpha_qpos(il)
-        ft(il, i) = ft(il, i)/alpha_qpos(il)
-        fqd(il, i) = fqd(il, i)/alpha_qpos(il)
-        ftd(il, i) = ftd(il, i)/alpha_qpos(il)
-        fu(il, i) = fu(il, i)/alpha_qpos(il)
-        fv(il, i) = fv(il, i)/alpha_qpos(il)
-        m(il, i) = m(il, i)/alpha_qpos(il)
-        mp(il, i) = mp(il, i)/alpha_qpos(il)
-        Vprecip(il, i) = Vprecip(il, i)/alpha_qpos(il)
-        Vprecipi(il, i) = Vprecipi(il, i)/alpha_qpos(il)                     ! jyg
+        fr(il, i) = fr(il, i) / alpha_qpos(il)
+        ft(il, i) = ft(il, i) / alpha_qpos(il)
+        fqd(il, i) = fqd(il, i) / alpha_qpos(il)
+        ftd(il, i) = ftd(il, i) / alpha_qpos(il)
+        fu(il, i) = fu(il, i) / alpha_qpos(il)
+        fv(il, i) = fv(il, i) / alpha_qpos(il)
+        m(il, i) = m(il, i) / alpha_qpos(il)
+        mp(il, i) = mp(il, i) / alpha_qpos(il)
+        Vprecip(il, i) = Vprecip(il, i) / alpha_qpos(il)
+        Vprecipi(il, i) = Vprecipi(il, i) / alpha_qpos(il)                     ! jyg
       END IF
     END DO
   END DO
-!jyg<
-!-----------------------------------------------------------
-           IF (ok_optim_yield) THEN                       !|
-!-----------------------------------------------------------
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (iflag(il)<=1) THEN
-        upwd(il, i) = upwd(il, i)/alpha_qpos(il)
-        dnwd(il, i) = dnwd(il, i)/alpha_qpos(il)
-      END IF
-    END DO
-  END DO
-!-----------------------------------------------------------
-        ENDIF !(ok_optim_yield)                           !|
-!-----------------------------------------------------------
-!>jyg
-  DO j = 1, nl !yor! inverted i and j loops
-     DO i = 1, nl
+  !jyg<
+  !-----------------------------------------------------------
+  IF (ok_optim_yield) THEN                       !|
+    !-----------------------------------------------------------
+    DO i = 1, nl
       DO il = 1, ncum
         IF (iflag(il)<=1) THEN
-          ment(il, i, j) = ment(il, i, j)/alpha_qpos(il)
+          upwd(il, i) = upwd(il, i) / alpha_qpos(il)
+          dnwd(il, i) = dnwd(il, i) / alpha_qpos(il)
         END IF
       END DO
     END DO
-  END DO
-
-!AC!      DO j = 1,ntra
-!AC!      DO i = 1,nl
-!AC!       DO il = 1,ncum
-!AC!        IF (iflag(il) .le. 1) THEN
-!AC!         ftra(il,i,j) = ftra(il,i,j)/alpha_qpos(il)
-!AC!        ENDIF
-!AC!       ENDDO
-!AC!      ENDDO
-!AC!      ENDDO
-
-
-! ***           reset counter and return           ***
-
-! Reset counter only for points actually convective (jyg)
-! In order take into account the possibility of changing the compression,
-! reset m, sig and w0 to zero for non-convecting points.
+    !-----------------------------------------------------------
+  ENDIF !(ok_optim_yield)                           !|
+  !-----------------------------------------------------------
+  !>jyg
+  DO j = 1, nl !yor! inverted i and j loops
+    DO i = 1, nl
+      DO il = 1, ncum
+        IF (iflag(il)<=1) THEN
+          ment(il, i, j) = ment(il, i, j) / alpha_qpos(il)
+        END IF
+      END DO
+    END DO
+  END DO
+
+  !AC!      DO j = 1,ntra
+  !AC!      DO i = 1,nl
+  !AC!       DO il = 1,ncum
+  !AC!        IF (iflag(il) .le. 1) THEN
+  !AC!         ftra(il,i,j) = ftra(il,i,j)/alpha_qpos(il)
+  !AC!        ENDIF
+  !AC!       ENDDO
+  !AC!      ENDDO
+  !AC!      ENDDO
+
+
+  ! ***           reset counter and return           ***
+
+  ! Reset counter only for points actually convective (jyg)
+  ! In order take into account the possibility of changing the compression,
+  ! reset m, sig and w0 to zero for non-convecting points.
   DO il = 1, ncum
     IF (iflag(il) < 3) THEN
@@ -4628 +4586 @@
   END DO
 
-
   DO i = 1, nl
     DO il = 1, ncum
@@ -4634 +4591 @@
     END DO
   END DO
-!jyg<  (loops stop at nl)
-!!  DO i = nl + 1, nd
-!!    DO il = 1, ncum
-!!      dnwd0(il, i) = 0.
-!!    END DO
-!!  END DO
-!>jyg
-
-
-!jyg<
-!-----------------------------------------------------------
-           IF (.NOT.ok_optim_yield) THEN                  !|
-!-----------------------------------------------------------
-  DO i = 1, nl
-    DO il = 1, ncum
-      upwd(il, i) = 0.0
-      dnwd(il, i) = 0.0
-    END DO
-  END DO
-
-!!  DO i = 1, nl                                           ! useless; jyg
-!!    DO il = 1, ncum                                      ! useless; jyg
-!!      IF (i>=icb(il) .AND. i<=inb(il)) THEN              ! useless; jyg
-!!        upwd(il, i) = 0.0                                ! useless; jyg
-!!        dnwd(il, i) = 0.0                                ! useless; jyg
-!!      END IF                                             ! useless; jyg
-!!    END DO                                               ! useless; jyg
-!!  END DO                                                 ! useless; jyg
-
-  DO i = 1, nl
-    DO k = 1, nl
+  !jyg<  (loops stop at nl)
+  !!  DO i = nl + 1, nd
+  !!    DO il = 1, ncum
+  !!      dnwd0(il, i) = 0.
+  !!    END DO
+  !!  END DO
+  !>jyg
+
+
+  !jyg<
+  !-----------------------------------------------------------
+  IF (.NOT.ok_optim_yield) THEN                  !|
+    !-----------------------------------------------------------
+    DO i = 1, nl
       DO il = 1, ncum
-        up1(il, k, i) = 0.0
-        dn1(il, k, i) = 0.0
+        upwd(il, i) = 0.0
+        dnwd(il, i) = 0.0
       END DO
     END DO
-  END DO
-
-!yor! commented original
-!  DO i = 1, nl
-!    DO k = i, nl
-!      DO n = 1, i - 1
-!        DO il = 1, ncum
-!          IF (i>=icb(il) .AND. i<=inb(il) .AND. k<=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)
-!          END IF
-!        END DO
-!      END DO
-!    END DO
-!  END DO
-!yor! replaced with
-  DO i = 1, nl
-    DO k = i, nl
-      DO n = 1, i - 1
+
+    !!  DO i = 1, nl                                           ! useless; jyg
+    !!    DO il = 1, ncum                                      ! useless; jyg
+    !!      IF (i>=icb(il) .AND. i<=inb(il)) THEN              ! useless; jyg
+    !!        upwd(il, i) = 0.0                                ! useless; jyg
+    !!        dnwd(il, i) = 0.0                                ! useless; jyg
+    !!      END IF                                             ! useless; jyg
+    !!    END DO                                               ! useless; jyg
+    !!  END DO                                                 ! useless; jyg
+
+    DO i = 1, nl
+      DO k = 1, nl
         DO il = 1, ncum
-          IF (i>=icb(il) .AND. k<=inb(il)) THEN ! yor ! as i always <= k
-             up1(il, k, i) = up1(il, k, i) + ment(il, n, k)
-          END IF
+          up1(il, k, i) = 0.0
+          dn1(il, k, i) = 0.0
         END DO
       END DO
     END DO
-  END DO
-  DO i = 1, nl
-    DO n = 1, i - 1
+
+    !yor! commented original
+    !  DO i = 1, nl
+    !    DO k = i, nl
+    !      DO n = 1, i - 1
+    !        DO il = 1, ncum
+    !          IF (i>=icb(il) .AND. i<=inb(il) .AND. k<=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)
+    !          END IF
+    !        END DO
+    !      END DO
+    !    END DO
+    !  END DO
+    !yor! replaced with
+    DO i = 1, nl
+      DO k = i, nl
+        DO n = 1, i - 1
+          DO il = 1, ncum
+            IF (i>=icb(il) .AND. k<=inb(il)) THEN ! yor ! as i always <= k
+              up1(il, k, i) = up1(il, k, i) + ment(il, n, k)
+            END IF
+          END DO
+        END DO
+      END DO
+    END DO
+    DO i = 1, nl
+      DO n = 1, i - 1
+        DO k = i, nl
+          DO il = 1, ncum
+            IF (i>=icb(il) .AND. k<=inb(il)) THEN ! yor !  i always <= k
+              dn1(il, k, i) = dn1(il, k, i) - ment(il, k, n)
+            END IF
+          END DO
+        END DO
+      END DO
+    END DO
+    !yor! end replace
+
+    DO i = 1, nl
+      DO k = 1, nl
+        DO il = 1, ncum
+          IF (i>=icb(il)) THEN
+            IF (k>=i .AND. k<=(inb(il))) THEN
+              upwd(il, i) = upwd(il, i) + m(il, k)
+            END IF
+          ELSE
+            IF (k<i) THEN
+              upwd(il, i) = upwd(il, i) + cbmf(il) * wghti(il, k)
+            END IF
+          END IF
+          ! c        print *,'cbmf',il,i,k,cbmf(il),wghti(il,k)
+        END DO
+      END DO
+    END DO
+
+    DO i = 2, nl
       DO k = i, nl
         DO il = 1, ncum
-          IF (i>=icb(il) .AND. k<=inb(il)) THEN ! yor !  i always <= k
-             dn1(il, k, i) = dn1(il, k, i) - ment(il, k, n)
+          ! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il)) THEN
+          IF (i<=inb(il) .AND. k<=inb(il)) THEN
+            upwd(il, i) = upwd(il, i) + up1(il, k, i)
+            dnwd(il, i) = dnwd(il, i) + dn1(il, k, i)
           END IF
+          ! c         print *,'upwd',il,i,k,inb(il),upwd(il,i),m(il,k),up1(il,k,i)
         END DO
       END DO
     END DO
-  END DO
-!yor! end replace 
-
-  DO i = 1, nl
-    DO k = 1, nl
-      DO il = 1, ncum
-        IF (i>=icb(il)) THEN
-          IF (k>=i .AND. k<=(inb(il))) THEN
-            upwd(il, i) = upwd(il, i) + m(il, k)
-          END IF
-        ELSE
-          IF (k<i) THEN
-            upwd(il, i) = upwd(il, i) + cbmf(il)*wghti(il, k)
-          END IF
-        END IF
-! c        print *,'cbmf',il,i,k,cbmf(il),wghti(il,k)
-      END DO
-    END DO
-  END DO
-
-  DO i = 2, nl
-    DO k = i, nl
-      DO il = 1, ncum
-! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il)) THEN
-        IF (i<=inb(il) .AND. k<=inb(il)) THEN
-          upwd(il, i) = upwd(il, i) + up1(il, k, i)
-          dnwd(il, i) = dnwd(il, i) + dn1(il, k, i)
-        END IF
-! c         print *,'upwd',il,i,k,inb(il),upwd(il,i),m(il,k),up1(il,k,i)
-      END DO
-    END DO
-  END DO
-
-
-!!!!      DO il=1,ncum
-!!!!      do i=icb(il),inb(il)
-!!!!
-!!!!      upwd(il,i)=0.0
-!!!!      dnwd(il,i)=0.0
-!!!!      do k=i,inb(il)
-!!!!      up1=0.0
-!!!!      dn1=0.0
-!!!!      do n=1,i-1
-!!!!      up1=up1+ment(il,n,k)
-!!!!      dn1=dn1-ment(il,k,n)
-!!!!      enddo
-!!!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
-!!!!      dnwd(il,i)=dnwd(il,i)+dn1
-!!!!      enddo
-!!!!      enddo
-!!!!
-!!!!      ENDDO
-
-!!  DO i = 1, nlp
-!!    DO il = 1, ncum
-!!      ma(il, i) = 0
-!!    END DO
-!!  END DO
-!!
-!!  DO i = 1, nl
-!!    DO j = i, nl
-!!      DO il = 1, ncum
-!!        ma(il, i) = ma(il, i) + m(il, j)
-!!      END DO
-!!    END DO
-!!  END DO
-
-!jyg<  (loops stop at nl)
-!!  DO i = nl + 1, nd
-!!    DO il = 1, ncum
-!!      ma(il, i) = 0.
-!!    END DO
-!!  END DO
-!>jyg
-
-!!  DO i = 1, nl
-!!    DO il = 1, ncum
-!!      IF (i<=(icb(il)-1)) THEN
-!!        ma(il, i) = 0
-!!      END IF
-!!    END DO
-!!  END DO
-
-!-----------------------------------------------------------
-        ENDIF !(.NOT.ok_optim_yield)                      !|
-!-----------------------------------------------------------
-!>jyg
-
-! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-! determination de la variation de flux ascendant entre
-! deux niveau non dilue mip
-! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+    !!!!      DO il=1,ncum
+    !!!!      do i=icb(il),inb(il)
+    !!!!
+    !!!!      upwd(il,i)=0.0
+    !!!!      dnwd(il,i)=0.0
+    !!!!      do k=i,inb(il)
+    !!!!      up1=0.0
+    !!!!      dn1=0.0
+    !!!!      do n=1,i-1
+    !!!!      up1=up1+ment(il,n,k)
+    !!!!      dn1=dn1-ment(il,k,n)
+    !!!!      enddo
+    !!!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
+    !!!!      dnwd(il,i)=dnwd(il,i)+dn1
+    !!!!      enddo
+    !!!!      enddo
+    !!!!
+    !!!!      ENDDO
+
+    !!  DO i = 1, nlp
+    !!    DO il = 1, ncum
+    !!      ma(il, i) = 0
+    !!    END DO
+    !!  END DO
+    !!
+    !!  DO i = 1, nl
+    !!    DO j = i, nl
+    !!      DO il = 1, ncum
+    !!        ma(il, i) = ma(il, i) + m(il, j)
+    !!      END DO
+    !!    END DO
+    !!  END DO
+
+    !jyg<  (loops stop at nl)
+    !!  DO i = nl + 1, nd
+    !!    DO il = 1, ncum
+    !!      ma(il, i) = 0.
+    !!    END DO
+    !!  END DO
+    !>jyg
+
+    !!  DO i = 1, nl
+    !!    DO il = 1, ncum
+    !!      IF (i<=(icb(il)-1)) THEN
+    !!        ma(il, i) = 0
+    !!      END IF
+    !!    END DO
+    !!  END DO
+
+    !-----------------------------------------------------------
+  ENDIF !(.NOT.ok_optim_yield)                      !|
+  !-----------------------------------------------------------
+  !>jyg
+
+  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+  ! determination de la variation de flux ascendant entre
+  ! deux niveau non dilue mip
+  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
   DO i = 1, nl
@@ -4806 +4763 @@
   END DO
 
-!jyg<  (loops stop at nl)
-!!  DO i = nl + 1, nd
-!!    DO il = 1, ncum
-!!      mip(il, i) = 0.
-!!    END DO
-!!  END DO
-!>jyg
-
-
-! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-! icb represente de niveau ou se trouve la
-! base du nuage , et inb le top du nuage
-! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-!!  DO i = 1, nd                                  ! unused . jyg
-!!    DO il = 1, ncum                             ! unused . jyg
-!!      mke(il, i) = upwd(il, i) + dnwd(il, i)    ! unused . jyg
-!!    END DO                                      ! unused . jyg
-!!  END DO                                        ! unused . jyg
-
-!!  DO i = 1, nd                                                                 ! unused . jyg
-!!    DO il = 1, ncum                                                            ! unused . jyg
-!!      rdcp = (rrd*(1.-rr(il,i))-rr(il,i)*rrv)/(cpd*(1.-rr(il,i))+rr(il,i)*cpv) ! unused . jyg
-!!      tls(il, i) = t(il, i)*(1000.0/p(il,i))**rdcp                             ! unused . jyg
-!!      tps(il, i) = tp(il, i)                                                   ! unused . jyg
-!!    END DO                                                                     ! unused . jyg
-!!  END DO                                                                       ! unused . jyg
-
-
-! *** diagnose the in-cloud mixing ratio   ***                       ! cld
-! ***           of condensed water         ***                       ! cld
-!! cld                                                               
-                                                                     
-  DO i = 1, nl+1                                                     ! cld
+  !jyg<  (loops stop at nl)
+  !!  DO i = nl + 1, nd
+  !!    DO il = 1, ncum
+  !!      mip(il, i) = 0.
+  !!    END DO
+  !!  END DO
+  !>jyg
+
+
+  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+  ! icb represente de niveau ou se trouve la
+  ! base du nuage , et inb le top du nuage
+  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+  !!  DO i = 1, nd                                  ! unused . jyg
+  !!    DO il = 1, ncum                             ! unused . jyg
+  !!      mke(il, i) = upwd(il, i) + dnwd(il, i)    ! unused . jyg
+  !!    END DO                                      ! unused . jyg
+  !!  END DO                                        ! unused . jyg
+
+  !!  DO i = 1, nd                                                                 ! unused . jyg
+  !!    DO il = 1, ncum                                                            ! unused . jyg
+  !!      rdcp = (rrd*(1.-rr(il,i))-rr(il,i)*rrv)/(cpd*(1.-rr(il,i))+rr(il,i)*cpv) ! unused . jyg
+  !!      tls(il, i) = t(il, i)*(1000.0/p(il,i))**rdcp                             ! unused . jyg
+  !!      tps(il, i) = tp(il, i)                                                   ! unused . jyg
+  !!    END DO                                                                     ! unused . jyg
+  !!  END DO                                                                       ! unused . jyg
+
+
+  ! *** diagnose the in-cloud mixing ratio   ***                       ! cld
+  ! ***           of condensed water         ***                       ! cld
+  !! cld
+
+  DO i = 1, nl + 1                                                     ! cld
     DO il = 1, ncum                                                  ! cld
       mac(il, i) = 0.0                                               ! cld
@@ -4847 +4804 @@
     END DO                                                           ! cld
   END DO                                                             ! cld
-                                                                     
+
   DO i = minorig, nl                                                 ! cld
     DO k = i + 1, nl + 1                                             ! cld
       DO il = 1, ncum                                                ! cld
-        IF (i<=inb(il) .AND. k<=(inb(il)+1) .AND. iflag(il)<=1) THEN ! cld
+        IF (i<=inb(il) .AND. k<=(inb(il) + 1) .AND. iflag(il)<=1) THEN ! cld
           mac(il, i) = mac(il, i) + m(il, k)                         ! cld
         END IF                                                       ! cld
@@ -4861 +4818 @@
     DO j = 1, i                                                      ! cld
       DO il = 1, ncum                                                ! cld
-        IF (i>=icb(il) .AND. i<=(inb(il)-1) &                        ! cld
-            .AND. j>=icb(il) .AND. iflag(il)<=1) 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
+        IF (i>=icb(il) .AND. i<=(inb(il) - 1) &                        ! cld
+                .AND. j>=icb(il) .AND. iflag(il)<=1) 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
         END IF                                                       ! cld
       END DO                                                         ! cld
@@ -4872 +4829 @@
   DO i = 1, nl                                                       ! cld
     DO il = 1, ncum                                                  ! cld
-      IF (i>=icb(il) .AND. i<=(inb(il)-1) &                          ! cld
-          .AND. sax(il,i)>0.0 .AND. iflag(il)<=1) THEN               ! cld
-        wa(il, i) = sqrt(2.*sax(il,i))                               ! cld
+      IF (i>=icb(il) .AND. i<=(inb(il) - 1) &                          ! cld
+              .AND. sax(il, i)>0.0 .AND. iflag(il)<=1) THEN               ! cld
+        wa(il, i) = sqrt(2. * sax(il, i))                               ! cld
       END IF                                                         ! cld
     END DO                                                           ! cld
-  END DO  
-                                                           ! cld
-  DO i = 1, nl  
-
-! 14/01/15 AJ je remets les parties manquantes cf JYG
-! Initialize sument to 0
-
-    DO il = 1,ncum
-     sument(il) = 0.
+  END DO
+  ! cld
+  DO i = 1, nl
+
+    ! 14/01/15 AJ je remets les parties manquantes cf JYG
+    ! Initialize sument to 0
+
+    DO il = 1, ncum
+      sument(il) = 0.
     ENDDO
 
-! Sum mixed mass fluxes in sument
-
-    DO k = 1,nl
-      DO il = 1,ncum
+    ! Sum mixed mass fluxes in sument
+
+    DO k = 1, nl
+      DO il = 1, ncum
         IF  (k<=inb(il) .AND. i<=inb(il) .AND. iflag(il)<=1) THEN   ! cld
-          sument(il) =sument(il) + abs(ment(il,k,i))
-          detrain(il,i) = detrain(il,i) + abs(ment(il,k,i))*(qdet(il,k,i) - rr(il,i))*(qdet(il,k,i) - rr(il,i)) ! Louis terme de détrainement dans le bilan de variance
+          sument(il) = sument(il) + abs(ment(il, k, i))
+          detrain(il, i) = detrain(il, i) + abs(ment(il, k, i)) * (qdet(il, k, i) - rr(il, i)) * (qdet(il, k, i) - rr(il, i)) ! Louis terme de détrainement dans le bilan de variance
         ENDIF
       ENDDO     ! il
     ENDDO       ! k
 
-! 14/01/15 AJ delta n'a rien à faire là...
+    ! 14/01/15 AJ delta n'a rien à faire là...
     DO il = 1, ncum                                                  ! cld
-!!      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) &                         ! cld
-!!        siga(il, i) = mac(il, i)/(coefw_cld_cv*wa(il, i)) &          ! cld
-!!        *rrd*tvp(il, i)/p(il, i)/100.                                ! cld
-!!
-!!      siga(il, i) = min(siga(il,i), 1.0)                             ! cld
+      !!      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) &                         ! cld
+      !!        siga(il, i) = mac(il, i)/(coefw_cld_cv*wa(il, i)) &          ! cld
+      !!        *rrd*tvp(il, i)/p(il, i)/100.                                ! cld
+      !!
+      !!      siga(il, i) = min(siga(il,i), 1.0)                             ! cld
       sigaq = 0.
-      IF (wa(il,i)>0.0 .AND. iflag(il)<=1)  THEN                     ! cld
-        siga(il, i) = mac(il, i)/(coefw_cld_cv*wa(il, i)) &          ! cld
-                     *rrd*tvp(il, i)/p(il, i)/100.                   ! cld
-        siga(il, i) = min(siga(il,i), 1.0)                           ! cld
-        sigaq = siga(il,i)*qta(il,i-1)                               ! cld
+      IF (wa(il, i)>0.0 .AND. iflag(il)<=1)  THEN                     ! cld
+        siga(il, i) = mac(il, i) / (coefw_cld_cv * wa(il, i)) &          ! cld
+                * rrd * tvp(il, i) / p(il, i) / 100.                   ! cld
+        siga(il, i) = min(siga(il, i), 1.0)                           ! cld
+        sigaq = siga(il, i) * qta(il, i - 1)                               ! cld
       ENDIF
 
-! IM cf. FH 
-! 14/01/15 AJ ne correspond pas à ce qui a été codé par JYG et SB
-                                                         
+      ! IM cf. FH
+      ! 14/01/15 AJ ne correspond pas à ce qui a été codé par JYG et SB
+
       IF (iflag_clw==0) THEN                                         ! cld
-        qcondc(il, i) = siga(il, i)*clw(il, i)*(1.-ep(il,i)) &       ! cld
-          +(1.-siga(il,i))*qcond(il, i)                              ! cld
-
-
-        sigment(il,i)=sument(il)*tau_cld_cv/(ph(il,i)-ph(il,i+1))    ! cld
-        sigment(il, i) = min(1.e-4+sigment(il,i), 1.0 - siga(il,i))  ! cld
-!!        qtc(il, i) = (siga(il,i)*qta(il,i-1)+sigment(il,i)*qtment(il,i)) & ! cld
-        qtc(il, i) = (sigaq+sigment(il,i)*qtment(il,i)) & ! cld
-                     /(siga(il,i)+sigment(il,i))                     ! cld
-        sigt(il,i) = sigment(il, i) + siga(il, i)
-
-!        qtc(il, i) = siga(il,i)*qta(il,i-1)+(1.-siga(il,i))*qtment(il,i) ! cld
-!     PRINT*,'BIGAUSSIAN CONV',siga(il,i),sigment(il,i),qtc(il,i)
-                
+        qcondc(il, i) = siga(il, i) * clw(il, i) * (1. - ep(il, i)) &       ! cld
+                + (1. - siga(il, i)) * qcond(il, i)                              ! cld
+
+        sigment(il, i) = sument(il) * tau_cld_cv / (ph(il, i) - ph(il, i + 1))    ! cld
+        sigment(il, i) = min(1.e-4 + sigment(il, i), 1.0 - siga(il, i))  ! cld
+        !!        qtc(il, i) = (siga(il,i)*qta(il,i-1)+sigment(il,i)*qtment(il,i)) & ! cld
+        qtc(il, i) = (sigaq + sigment(il, i) * qtment(il, i)) & ! cld
+                / (siga(il, i) + sigment(il, i))                     ! cld
+        sigt(il, i) = sigment(il, i) + siga(il, i)
+
+        !        qtc(il, i) = siga(il,i)*qta(il,i-1)+(1.-siga(il,i))*qtment(il,i) ! cld
+        !     PRINT*,'BIGAUSSIAN CONV',siga(il,i),sigment(il,i),qtc(il,i)
+
       ELSE IF (iflag_clw==1) THEN                                    ! cld
         qcondc(il, i) = qcond(il, i)                                 ! cld
-        qtc(il,i) = qtment(il,i)                                     ! cld
+        qtc(il, i) = qtment(il, i)                                     ! cld
       END IF                                                         ! cld
 
     END DO                                                           ! cld
   END DO
-! PRINT*,'cv3_yield fin'
-
+  ! PRINT*,'cv3_yield fin'
 
 END SUBROUTINE cv3_yield
@@ -4946 +4901 @@
 !AC! et !RomP >>>
 SUBROUTINE cv3_tracer(nloc, len, ncum, nd, na, &
-                      ment, sigij, da, phi, phi2, d1a, dam, &
-                      ep, Vprecip, elij, clw, epmlmMm, eplaMm, &
-                      icb, inb)
+        ment, sigij, da, phi, phi2, d1a, dam, &
+        ep, Vprecip, elij, clw, epmlmMm, eplaMm, &
+        icb, inb)
+
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
-  include "cv3param.h"
-
-!inputs:
-  INTEGER, INTENT (IN)                               :: ncum, nd, na, nloc, len
-  INTEGER, DIMENSION (len), INTENT (IN)              :: icb, inb
-  REAL, DIMENSION (len, na, na), INTENT (IN)         :: ment, sigij, elij
-  REAL, DIMENSION (len, nd), INTENT (IN)             :: clw
-  REAL, DIMENSION (len, na), INTENT (IN)             :: ep
-  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: Vprecip
-!ouputs:
-  REAL, DIMENSION (len, na, na), INTENT (OUT)        :: phi, phi2, epmlmMm
-  REAL, DIMENSION (len, na), INTENT (OUT)            :: da, d1a, dam, eplaMm
-
-! variables pour tracer dans precip de l'AA et des mel
-!local variables:
+
+  !inputs:
+  INTEGER, INTENT (IN) :: ncum, nd, na, nloc, len
+  INTEGER, DIMENSION (len), INTENT (IN) :: icb, inb
+  REAL, DIMENSION (len, na, na), INTENT (IN) :: ment, sigij, elij
+  REAL, DIMENSION (len, nd), INTENT (IN) :: clw
+  REAL, DIMENSION (len, na), INTENT (IN) :: ep
+  REAL, DIMENSION (len, nd + 1), INTENT (IN) :: Vprecip
+  !ouputs:
+  REAL, DIMENSION (len, na, na), INTENT (OUT) :: phi, phi2, epmlmMm
+  REAL, DIMENSION (len, na), INTENT (OUT) :: da, d1a, dam, eplaMm
+
+  ! variables pour tracer dans precip de l'AA et des mel
+  !local variables:
   INTEGER i, j, k
   REAL epm(nloc, na, na)
 
-! variables d'Emanuel : du second indice au troisieme
-! --->    tab(i,k,j) -> de l origine k a l arrivee j
-! ment, sigij, elij
-! variables personnelles : du troisieme au second indice
-! --->    tab(i,j,k) -> de k a j
-! phi, phi2
-
-! initialisations
+  ! variables d'Emanuel : du second indice au troisieme
+  ! --->    tab(i,k,j) -> de l origine k a l arrivee j
+  ! ment, sigij, elij
+  ! variables personnelles : du troisieme au second indice
+  ! --->    tab(i,j,k) -> de k a j
+  ! phi, phi2
+
+  ! initialisations
 
   da(:, :) = 0.
@@ -4987 +4944 @@
   phi2(:, :, :) = 0.
 
-! fraction deau condensee dans les melanges convertie en precip : epm
-! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
+  ! fraction deau condensee dans les melanges convertie en precip : epm
+  ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
   DO j = 1, nl
     DO k = 1, nl
       DO i = 1, ncum
-        IF (k>=icb(i) .AND. k<=inb(i) .AND. & 
-!!jyg              j.ge.k.AND.j.le.inb(i)) THEN
-!!jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
-            j>k .AND. j<=inb(i)) THEN
-          epm(i, j, k) = 1. - (1.-ep(i,j))*clw(i, j)/max(elij(i,k,j), 1.E-16)
-!!
-          epm(i, j, k) = max(epm(i,j,k), 0.0)
+        IF (k>=icb(i) .AND. k<=inb(i) .AND. &
+                !!jyg              j.ge.k.AND.j.le.inb(i)) THEN
+                !!jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
+                j>k .AND. j<=inb(i)) THEN
+          epm(i, j, k) = 1. - (1. - ep(i, j)) * clw(i, j) / max(elij(i, k, j), 1.E-16)
+          !!
+          epm(i, j, k) = max(epm(i, j, k), 0.0)
         END IF
       END DO
     END DO
   END DO
-
 
   DO j = 1, nl
@@ -5010 +4966 @@
         IF (k>=icb(i) .AND. k<=inb(i)) THEN
           eplaMm(i, j) = eplamm(i, j) + &
-                         ep(i, j)*clw(i, j)*ment(i, j, k)*(1.-sigij(i,j,k))
+                  ep(i, j) * clw(i, j) * ment(i, j, k) * (1. - sigij(i, j, k))
         END IF
       END DO
@@ -5020 +4976 @@
       DO i = 1, ncum
         IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
-          epmlmMm(i, j, k) = epm(i, j, k)*elij(i, k, j)*ment(i, k, j)
+          epmlmMm(i, j, k) = epm(i, j, k) * elij(i, k, j) * ment(i, k, j)
         END IF
       END DO
@@ -5026 +4982 @@
   END DO
 
-! matrices pour calculer la tendance des concentrations dans cvltr.F90
+  ! matrices pour calculer la tendance des concentrations dans cvltr.F90
   DO j = 1, nl
     DO k = 1, nl
       DO i = 1, ncum
-        da(i, j) = da(i, j) + (1.-sigij(i,k,j))*ment(i, k, j)
-        phi(i, j, k) = sigij(i, k, j)*ment(i, k, j)
-        d1a(i, j) = d1a(i, j) + ment(i, k, j)*ep(i, k)*(1.-sigij(i,k,j))
+        da(i, j) = da(i, j) + (1. - sigij(i, k, j)) * ment(i, k, j)
+        phi(i, j, k) = sigij(i, k, j) * ment(i, k, j)
+        d1a(i, j) = d1a(i, j) + ment(i, k, j) * ep(i, k) * (1. - sigij(i, k, j))
         IF (k<=j) THEN
-          dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1.-sigij(i,k,j))
-          phi2(i, j, k) = phi(i, j, k)*epm(i, j, k)
+          dam(i, j) = dam(i, j) + ment(i, k, j) * epm(i, k, j) * (1. - ep(i, k)) * (1. - sigij(i, k, j))
+          phi2(i, j, k) = phi(i, j, k) * epm(i, j, k)
         END IF
       END DO
@@ -5041 +4997 @@
   END DO
 
-
 END SUBROUTINE cv3_tracer
 !AC! et !RomP <<<
 
 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, &
-                          epmax_diag, & ! epmax_cape
-                          iflag1, &
-                          precip1, sig1, w01, &
-                          ft1, fq1, fu1, fv1, ftra1, &
-                          Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1, &
-                          epmax_diag1) ! epmax_cape
+        iflag, &
+        precip, sig, w0, &
+        ft, fq, fu, fv, ftra, &
+        Ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
+        epmax_diag, & ! epmax_cape
+        iflag1, &
+        precip1, sig1, w01, &
+        ft1, fq1, fu1, fv1, ftra1, &
+        Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1, &
+        epmax_diag1) ! epmax_cape
+
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
-  include "cv3param.h"
-
-!inputs:
+  !inputs:
   INTEGER len, ncum, nd, ntra, nloc
   INTEGER idcum(nloc)
@@ -5074 +5030 @@
   REAL epmax_diag(nloc)
 
-!outputs:
+  !outputs:
   INTEGER iflag1(len)
   REAL precip1(len)
@@ -5086 +5042 @@
   REAL epmax_diag1(len) ! epmax_cape
 
-!local variables:
+  !local variables:
   INTEGER i, k, j
 
@@ -5094 +5050 @@
     wd1(idcum(i)) = wd(i)
     cape1(idcum(i)) = cape(i)
-    epmax_diag1(idcum(i))=epmax_diag(i) ! epmax_cape
+    epmax_diag1(idcum(i)) = epmax_diag(i) ! epmax_cape
   END DO
 
@@ -5118 +5074 @@
 
 
-!AC!        do 2100 j=1,ntra
-!AC!c oct3         do 2110 k=1,nl
-!AC!         do 2110 k=1,nd ! oct3
-!AC!          do 2120 i=1,ncum
-!AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
-!AC! 2120     continue
-!AC! 2110    continue
-!AC! 2100   continue
-
+  !AC!        do 2100 j=1,ntra
+  !AC!c oct3         do 2110 k=1,nl
+  !AC!         do 2110 k=1,nd ! oct3
+  !AC!          do 2120 i=1,ncum
+  !AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
+  !AC! 2120     continue
+  !AC! 2110    continue
+  !AC! 2100   continue
 
 END SUBROUTINE cv3_uncompress
 
 
-        SUBROUTINE cv3_epmax_fn_cape(nloc,ncum,nd &
-                 , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac &
-                 , pbase, p, ph, tv, buoy, sig, w0,iflag &
-                 , epmax_diag)
-          USE lmdz_conema3
-          USE lmdz_cvflag
-
-        IMPLICIT NONE
-
-        ! On fait varier epmax en fn de la cape
-        ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
-        ! qui en dépend
-        ! Toutes les autres variables fn de ep sont calculées plus bas.
-
-  include "cvthermo.h"
-  include "cv3param.h"  
-
-! inputs:
-      INTEGER, INTENT (IN)                               :: ncum, nd, nloc
-      INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb, nk
-      REAL, DIMENSION (nloc), INTENT (IN)                :: hnk,pbase
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, lv, lf, tv, h
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: clw, buoy,frac
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig,w0
-      INTEGER, DIMENSION (nloc), INTENT (IN)             :: iflag(nloc)
-      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
-      REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
-! inouts:
-      REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: ep,hp  
-! outputs
-      REAL, DIMENSION (nloc), INTENT (OUT)           :: epmax_diag
-
-! local
-      INTEGER i,k
-!      real hp_bak(nloc,nd)
-!      real ep_bak(nloc,nd)
-      REAL m_loc(nloc,nd)
-      REAL sig_loc(nloc,nd)
-      REAL w0_loc(nloc,nd)
-      INTEGER iflag_loc(nloc)
-      REAL cape(nloc)
-        
-        IF (coef_epmax_cape>1e-12) THEN
-        ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne
-        ! connait pas ep, on ne connait pas les mélanges, ddfts etc... qui sont
-        ! necessaires au calcul de la cape dans la nouvelle physique
-        
-!        WRITE(*,*) 'cv3_routines check 4303'
-        do i=1,ncum
-        do k=1,nd
-          sig_loc(i,k)=sig(i,k)
-          w0_loc(i,k)=w0(i,k)
-          iflag_loc(i)=iflag(i)
-!          ep_bak(i,k)=ep(i,k)
-        enddo ! do k=1,nd
-        enddo !do i=1,ncum
-
-!        WRITE(*,*) 'cv3_routines check 4311'
-!        WRITE(*,*) 'nl=',nl
-        CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
-          pbase, p, ph, tv, buoy, &
-          sig_loc, w0_loc, cape, m_loc,iflag_loc)
-
-!        WRITE(*,*) 'cv3_routines check 4316'
-!        WRITE(*,*) 'ep(1,:)=',ep(1,:)
-        do i=1,ncum
-           epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
-           epmax_diag(i)=amax1(epmax_diag(i),0.0)
-!           WRITE(*,*) 'i,icb,inb,cape,epmax_diag=', &
-!                i,icb(i),inb(i),cape(i),epmax_diag(i)
-           do k=1,nl
-                ep(i,k)=ep(i,k)/epmax*epmax_diag(i)
-                ep(i,k)=amax1(ep(i,k),0.0)
-                ep(i,k)=amin1(ep(i,k),epmax_diag(i))
-           enddo
+SUBROUTINE cv3_epmax_fn_cape(nloc, ncum, nd, ep, hp, icb, inb, clw, nk, t, h, hnk, lv, lf, frac &
+        , pbase, p, ph, tv, buoy, sig, w0, iflag, epmax_diag)
+  USE lmdz_conema3
+  USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
+  IMPLICIT NONE
+
+  ! On fait varier epmax en fn de la cape
+  ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
+  ! qui en dépend
+  ! Toutes les autres variables fn de ep sont calculées plus bas.
+
+  ! inputs:
+  INTEGER, INTENT (IN) :: ncum, nd, nloc
+  INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb, nk
+  REAL, DIMENSION (nloc), INTENT (IN) :: hnk, pbase
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, lv, lf, tv, h
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: clw, buoy, frac
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig, w0
+  INTEGER, DIMENSION (nloc), INTENT (IN) :: iflag(nloc)
+  REAL, DIMENSION (nloc, nd), INTENT (IN) :: p
+  REAL, DIMENSION (nloc, nd + 1), INTENT (IN) :: ph
+  ! inouts:
+  REAL, DIMENSION (nloc, nd), INTENT (INOUT) :: ep, hp
+  ! outputs
+  REAL, DIMENSION (nloc), INTENT (OUT) :: epmax_diag
+
+  ! local
+  INTEGER i, k
+  !      real hp_bak(nloc,nd)
+  !      real ep_bak(nloc,nd)
+  REAL m_loc(nloc, nd)
+  REAL sig_loc(nloc, nd)
+  REAL w0_loc(nloc, nd)
+  INTEGER iflag_loc(nloc)
+  REAL cape(nloc)
+
+  IF (coef_epmax_cape>1e-12) THEN
+    ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne
+    ! connait pas ep, on ne connait pas les mélanges, ddfts etc... qui sont
+    ! necessaires au calcul de la cape dans la nouvelle physique
+
+    !        WRITE(*,*) 'cv3_routines check 4303'
+    do i = 1, ncum
+      do k = 1, nd
+        sig_loc(i, k) = sig(i, k)
+        w0_loc(i, k) = w0(i, k)
+        iflag_loc(i) = iflag(i)
+        !          ep_bak(i,k)=ep(i,k)
+      enddo ! do k=1,nd
+    enddo !do i=1,ncum
+
+    !        WRITE(*,*) 'cv3_routines check 4311'
+    !        WRITE(*,*) 'nl=',nl
+    CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
+            pbase, p, ph, tv, buoy, &
+            sig_loc, w0_loc, cape, m_loc, iflag_loc)
+
+    !        WRITE(*,*) 'cv3_routines check 4316'
+    !        WRITE(*,*) 'ep(1,:)=',ep(1,:)
+    do i = 1, ncum
+      epmax_diag(i) = epmax - coef_epmax_cape * sqrt(cape(i))
+      epmax_diag(i) = amax1(epmax_diag(i), 0.0)
+      !           WRITE(*,*) 'i,icb,inb,cape,epmax_diag=', &
+      !                i,icb(i),inb(i),cape(i),epmax_diag(i)
+      do k = 1, nl
+        ep(i, k) = ep(i, k) / epmax * epmax_diag(i)
+        ep(i, k) = amax1(ep(i, k), 0.0)
+        ep(i, k) = amin1(ep(i, k), epmax_diag(i))
+      enddo
+    enddo
+    !       WRITE(*,*) 'ep(1,:)=',ep(1,:)
+
+    !WRITE(*,*) 'cv3_routines check 4326'
+    ! On recalcule hp:
+    !      do k=1,nl
+    !        do i=1,ncum
+    !     hp_bak(i,k)=hp(i,k)
+    !   enddo
+    !      enddo
+    do k = 1, nl
+      do i = 1, ncum
+        hp(i, k) = h(i, k)
+      enddo
+    enddo
+
+    IF (cvflag_ice) THEN
+
+      do k = minorig + 1, nl
+        do i = 1, ncum
+          IF((k>=icb(i)).AND.(k<=inb(i)))THEN
+            hp(i, k) = hnk(i) + (lv(i, k) + (cpd - cpv) * t(i, k) + frac(i, k) * lf(i, k)) * &
+                    ep(i, k) * clw(i, k)
+          endif
         enddo
- !       WRITE(*,*) 'ep(1,:)=',ep(1,:)
-
-      !WRITE(*,*) 'cv3_routines check 4326'
-! On recalcule hp:
-!      do k=1,nl
-!        do i=1,ncum
-!         hp_bak(i,k)=hp(i,k)
-!       enddo
-!      enddo
-      do k=1,nl
-        do i=1,ncum
-          hp(i,k)=h(i,k)
+      enddo !do k=minorig+1,n
+    ELSE !IF (cvflag_ice) THEN
+
+      DO k = minorig + 1, nl
+        DO i = 1, ncum
+          IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
+            hp(i, k) = hnk(i) + (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k)
+          endif
         enddo
-      enddo
-
-  IF (cvflag_ice) THEN
-
-      do k=minorig+1,nl
-       do i=1,ncum
-        IF((k>=icb(i)).AND.(k<=inb(i)))THEN
-          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))* &
-                              ep(i, k)*clw(i, k)
-        endif
-       enddo
       enddo !do k=minorig+1,n
-  ELSE !IF (cvflag_ice) THEN
-
-      DO k = minorig + 1, nl
-       DO i = 1, ncum
-        IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
-          hp(i,k)=hnk(i)+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
-        endif
-       enddo
-      enddo !do k=minorig+1,n
-
-  ENDIF !IF (cvflag_ice) THEN     
-      !WRITE(*,*) 'cv3_routines check 4345'
-!      do i=1,ncum  
-!       do k=1,nl
-!        if ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-1).OR. &
-!            ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-4).AND. &
-!            (ep(i,k)-ep_bak(i,k).lt.1e-4))) THEN
-!           WRITE(*,*) 'i,k=',i,k
-!           WRITE(*,*) 'coef_epmax_cape=',coef_epmax_cape
-!           WRITE(*,*) 'epmax_diag(i)=',epmax_diag(i)
-!           WRITE(*,*) 'ep(i,k)=',ep(i,k)
-!           WRITE(*,*) 'ep_bak(i,k)=',ep_bak(i,k)
-!           WRITE(*,*) 'hp(i,k)=',hp(i,k)
-!           WRITE(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
-!           WRITE(*,*) 'h(i,k)=',h(i,k)
-!           WRITE(*,*) 'nk(i)=',nk(i)
-!           WRITE(*,*) 'h(i,nk(i))=',h(i,nk(i))
-!           WRITE(*,*) 'lv(i,k)=',lv(i,k)
-!           WRITE(*,*) 't(i,k)=',t(i,k)
-!           WRITE(*,*) 'clw(i,k)=',clw(i,k)
-!           WRITE(*,*) 'cpd,cpv=',cpd,cpv
-!           stop
-!        endif
-!       enddo !do k=1,nl
-!      enddo !do i=1,ncum  
-      endif !if (coef_epmax_cape.gt.1e-12) THEN
-      !WRITE(*,*) 'cv3_routines check 4367'
-
-
-      END SUBROUTINE  cv3_epmax_fn_cape
-
-
-
+
+    ENDIF !IF (cvflag_ice) THEN
+    !WRITE(*,*) 'cv3_routines check 4345'
+    !      do i=1,ncum
+    !       do k=1,nl
+    !        if ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-1).OR. &
+    !            ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-4).AND. &
+    !            (ep(i,k)-ep_bak(i,k).lt.1e-4))) THEN
+    !           WRITE(*,*) 'i,k=',i,k
+    !           WRITE(*,*) 'coef_epmax_cape=',coef_epmax_cape
+    !           WRITE(*,*) 'epmax_diag(i)=',epmax_diag(i)
+    !           WRITE(*,*) 'ep(i,k)=',ep(i,k)
+    !           WRITE(*,*) 'ep_bak(i,k)=',ep_bak(i,k)
+    !           WRITE(*,*) 'hp(i,k)=',hp(i,k)
+    !           WRITE(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
+    !           WRITE(*,*) 'h(i,k)=',h(i,k)
+    !           WRITE(*,*) 'nk(i)=',nk(i)
+    !           WRITE(*,*) 'h(i,nk(i))=',h(i,nk(i))
+    !           WRITE(*,*) 'lv(i,k)=',lv(i,k)
+    !           WRITE(*,*) 't(i,k)=',t(i,k)
+    !           WRITE(*,*) 'clw(i,k)=',clw(i,k)
+    !           WRITE(*,*) 'cpd,cpv=',cpd,cpv
+    !           stop
+    !        endif
+    !       enddo !do k=1,nl
+    !      enddo !do i=1,ncum
+  endif !if (coef_epmax_cape.gt.1e-12) THEN
+  !WRITE(*,*) 'cv3_routines check 4367'
+
+END SUBROUTINE  cv3_epmax_fn_cape
+
+
+

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_compress.F90

@@ -29 +29 @@
   ! **************************************************************
 USE lmdz_abort_physic, ONLY: abort_physic
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
   ! inputs:

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_uncompress.F90

@@ -38 +38 @@
   ! **************************************************************
 
+  USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
   ! inputs:

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90

@@ -22 +22 @@
   USE lmdz_abort_physic, ONLY: abort_physic
   USE lmdz_conema3
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-  include "cvthermo.h"
-  include "cv3param.h"
   include "YOMCST2.h"
   include "YOMCST.h"

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90

@@ -22 +22 @@
   USE lmdz_conema3
   USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-  include "cvthermo.h"
-  include "cv3param.h"
   include "YOMCST2.h"
   include "YOMCST.h"

LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90

@@ -17 +17 @@
   USE add_phys_tend_mod, ONLY: fl_cor_ebil
   USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
 
   IMPLICIT NONE
 
-  include "cvthermo.h"
-  include "cv3param.h"
   include "YOMCST2.h"
 

LMDZ6/branches/Amaury_dev/libf/phylmd/cv_driver.F90

@@ -12 +12 @@
 
   USE dimphy
+  USE lmdz_cv30, ONLY: cv30_param, cv30_prelim, cv30_feed, cv30_undilute1, cv30_trigger, cv30_compress, cv30_undilute2, &
+          cv30_closure, cv30_epmax_fn_cape, cv30_mixing, cv30_unsat, cv30_yield, cv30_tracer, cv30_uncompress
+
   IMPLICIT NONE
 
@@ -714 +717 @@
 ! ==================================================================
 SUBROUTINE cv_thermo(iflag_con)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -721 +726 @@
 
   include "YOMCST.h"
-  include "cvthermo.h"
 
   INTEGER iflag_con

LMDZ6/branches/Amaury_dev/libf/phylmd/cv_routines.F90

@@ -1 @@
-
 ! $Id$
 
@@ -38 +37 @@
   include "cvparam.h"
   INTEGER nd
-  CHARACTER (LEN=20) :: modname = 'cv_routines'
-  CHARACTER (LEN=80) :: abort_message
+  CHARACTER (LEN = 20) :: modname = 'cv_routines'
+  CHARACTER (LEN = 80) :: abort_message
 
   ! noff: integer limit for convection (nd-noff)
@@ -71 +70 @@
   delta = 0.01 ! cld
 
-
 END SUBROUTINE cv_param
 
 SUBROUTINE cv_prelim(len, nd, ndp1, t, q, p, ph, lv, cpn, tv, gz, h, hm)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -93 +93 @@
   REAL cpx(len, nd)
 
-  include "cvthermo.h"
   include "cvparam.h"
-
 
   DO k = 1, nlp
     DO 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)
+      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)
     END DO
   END DO
@@ -113 +111 @@
   DO k = 2, nlp
     DO 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)
+      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)
     END DO
   END DO
@@ -123 +121 @@
   DO k = 1, nlp
     DO 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)
-    END DO
-  END DO
-
+      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)
+    END DO
+  END DO
 
 END SUBROUTINE cv_prelim
 
 SUBROUTINE cv_feed(len, nd, t, q, qs, p, hm, gz, nk, icb, icbmax, iflag, tnk, &
-    qnk, gznk, plcl)
+        qnk, gznk, plcl)
   IMPLICIT NONE
 
@@ -169 +166 @@
   DO k = 2, nlp
     DO i = 1, len
-      IF ((hm(i,k)<work(i)) .AND. (hm(i,k)<hm(i,k-1))) THEN
+      IF ((hm(i, k)<work(i)) .AND. (hm(i, k)<hm(i, k - 1))) THEN
         work(i) = hm(i, k)
         ihmin(i) = k
@@ -193 +190 @@
   DO k = minorig + 1, nl
     DO i = 1, len
-      IF ((hm(i,k)>work(i)) .AND. (k<=ihmin(i))) THEN
+      IF ((hm(i, k)>work(i)) .AND. (k<=ihmin(i))) THEN
         work(i) = hm(i, k)
         nk(i) = k
@@ -204 +201 @@
   ! -------------------------------------------------------------------
   DO i = 1, len
-    IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0) .OR. (p(i,ihmin(i))< &
-      400.0)) .AND. (iflag(i)==0)) iflag(i) = 7
+    IF (((t(i, nk(i))<250.0) .OR. (q(i, nk(i))<=0.0) .OR. (p(i, ihmin(i))< &
+            400.0)) .AND. (iflag(i)==0)) iflag(i) = 7
   END DO
   ! -------------------------------------------------------------------
@@ -218 +215 @@
     qsnk(i) = qs(i, nk(i))
 
-    rh(i) = qnk(i)/qsnk(i)
+    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))
+    chi(i) = tnk(i) / (1669.0 - 122.0 * rh(i) - tnk(i))
+    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
+            ) = 8
   END DO
   ! -------------------------------------------------------------------
@@ -234 +231 @@
   DO k = minorig, nl
     DO i = 1, len
-      IF ((k>=(nk(i)+1)) .AND. (p(i,k)<plcl(i))) icb(i) = min(icb(i), k)
+      IF ((k>=(nk(i) + 1)) .AND. (p(i, k)<plcl(i))) icb(i) = min(icb(i), k)
     END DO
   END DO
@@ -249 +246 @@
   END DO
 
-
 END SUBROUTINE cv_feed
 
 SUBROUTINE cv_undilute1(len, nd, t, q, qs, gz, p, nk, icb, icbmax, tp, tvp, &
-    clw)
+        clw)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -292 +289 @@
 
   DO 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
+    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
   END DO
 
@@ -301 +298 @@
   DO k = minorig, icbmax - 1
     DO 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)
+      tp(i, k) = tnk(i) - (gz(i, k) - gznk(i)) / cpp(i)
+      tvp(i, k) = tp(i, k) * (1. + qnk(i) * epsi)
     END DO
   END DO
@@ -311 +308 @@
     tg = ticb(i)
     qg = qs(i, icb(i))
-    alv = lv0 - clmcpv*(ticb(i)-t0)
+    alv = lv0 - clmcpv * (ticb(i) - t0)
 
     ! First iteration.
 
-    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)
+    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>=0.0) THEN
-      es = 6.112*exp(17.67*tc/denom)
+      es = 6.112 * exp(17.67 * tc / denom)
     ELSE
-      es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
+      es = exp(23.33086 - 6111.72784 / tg + 0.15215 * log(tg))
     END IF
-    qg = eps*es/(p(i,icb(i))-es*(1.-eps))
+    qg = eps * es / (p(i, icb(i)) - es * (1. - eps))
 
     ! Second iteration.
 
-    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)
+    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>=0.0) THEN
-      es = 6.112*exp(17.67*tc/denom)
+      es = 6.112 * exp(17.67 * tc / denom)
     ELSE
-      es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
+      es = exp(23.33086 - 6111.72784 / tg + 0.15215 * log(tg))
     END IF
-    qg = eps*es/(p(i,icb(i))-es*(1.-eps))
-
-    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
+    qg = eps * es / (p(i, icb(i)) - es * (1. - eps))
+
+    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)
+    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)
   END DO
 
   DO k = minorig, icbmax
     DO i = 1, len
-      tvp(i, k) = tvp(i, k) - tp(i, k)*qnk(i)
-    END DO
-  END DO
-
+      tvp(i, k) = tvp(i, k) - tp(i, k) * qnk(i)
+    END DO
+  END DO
 
 END SUBROUTINE cv_undilute1
@@ -383 +379 @@
   INTEGER i
 
-
   DO i = 1, len
     IF ((cbmf(i)==0.0) .AND. (iflag(i)==0) .AND. (tvp(i, &
-      icb(i))<=(tv(i,icb(i))-dtmax))) iflag(i) = 4
-  END DO
-
+            icb(i))<=(tv(i, icb(i)) - dtmax))) iflag(i) = 4
+  END DO
 
 END SUBROUTINE cv_trigger
 
 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, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, q, qs, u, &
-    v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
+        tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, tv1, &
+        tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, q, qs, u, &
+        v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
   USE lmdz_print_control, ONLY: lunout
   USE lmdz_abort_physic, ONLY: abort_physic
@@ -408 +402 @@
   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 p1(len, nd), ph1(len, nd + 1), tv1(len, nd), tp1(len, nd)
   REAL tvp1(len, nd), clw1(len, nd)
 
@@ -416 +410 @@
   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 p(nloc, nd), ph(nloc, nd + 1), tv(nloc, nd), tp(nloc, nd)
   REAL tvp(nloc, nd), clw(nloc, nd)
   REAL dph(nloc, nd)
@@ -422 +416 @@
   ! local variables:
   INTEGER i, k, nn
-  CHARACTER (LEN=20) :: modname = 'cv_compress'
-  CHARACTER (LEN=80) :: abort_message
-
+  CHARACTER (LEN = 20) :: modname = 'cv_compress'
+  CHARACTER (LEN = 80) :: abort_message
 
   DO k = 1, nl + 1
@@ -473 +466 @@
   DO k = 1, nl
     DO i = 1, ncum
-      dph(i, k) = ph(i, k) - ph(i, k+1)
-    END DO
-  END DO
-
+      dph(i, k) = ph(i, k) - ph(i, k + 1)
+    END DO
+  END DO
 
 END SUBROUTINE cv_compress
 
 SUBROUTINE cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
-    gz, p, dph, h, tv, lv, inb, inb1, tp, tvp, clw, hp, ep, sigp, frac)
+        gz, p, dph, h, tv, lv, inb, inb1, tp, tvp, clw, hp, ep, sigp, frac)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -494 +488 @@
   ! ---------------------------------------------------------------------
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -538 +531 @@
   ! ***  Calculate certain parcel quantities, including static energy   ***
 
-
-  DO i = 1, ncum
-    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) + qnk(i)*(lv0-clmcpv*(tnk(i)- &
-      t0)) + gznk(i)
+  DO i = 1, ncum
+    ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) + qnk(i) * (lv0 - clmcpv * (tnk(i) - &
+            t0)) + gznk(i)
   END DO
 
@@ -547 +539 @@
   ! ***  Find lifted parcel quantities above cloud base    ***
 
-
   DO k = minorig + 1, nl
     DO i = 1, ncum
-      IF (k>=(icb(i)+1)) THEN
+      IF (k>=(icb(i) + 1)) THEN
         tg = t(i, k)
         qg = qs(i, k)
-        alv = lv0 - clmcpv*(t(i,k)-t0)
+        alv = lv0 - clmcpv * (t(i, k) - t0)
 
         ! First iteration.
 
-        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)
+        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>=0.0) THEN
-          es = 6.112*exp(17.67*tc/denom)
+          es = 6.112 * exp(17.67 * tc / denom)
         ELSE
-          es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          es = exp(23.33086 - 6111.72784 / tg + 0.15215 * log(tg))
         END IF
-        qg = eps*es/(p(i,k)-es*(1.-eps))
+        qg = eps * es / (p(i, k) - es * (1. - eps))
 
         ! Second iteration.
 
-        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)
+        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>=0.0) THEN
-          es = 6.112*exp(17.67*tc/denom)
+          es = 6.112 * exp(17.67 * tc / denom)
         ELSE
-          es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          es = exp(23.33086 - 6111.72784 / tg + 0.15215 * log(tg))
         END IF
-        qg = eps*es/(p(i,k)-es*(1.-eps))
-
-        alv = lv0 - clmcpv*(t(i,k)-t0)
+        qg = eps * es / (p(i, k) - es * (1. - eps))
+
+        alv = lv0 - clmcpv * (t(i, k) - t0)
         ! PRINT*,'cpd dans convect2 ',cpd
         ! PRINT*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
         ! 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
+        tp(i, k) = (ah0(i) - (cl - cpd) * qnk(i) * t(i, k) - gz(i, k) - alv * qg) / cpd
         ! if (.NOT.cpd.gt.1000.) THEN
         ! PRINT*,'CPD=',cpd
@@ -597 +588 @@
         ! END IF
         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)
+        clw(i, k) = max(0.0, clw(i, k))
+        rg = qg / (1. - qnk(i))
+        tvp(i, k) = tp(i, k) * (1. + rg * epsi)
       END IF
     END DO
@@ -612 +603 @@
   DO k = minorig + 1, nl
     DO i = 1, ncum
-      IF (k>=(nk(i)+1)) THEN
+      IF (k>=(nk(i) + 1)) THEN
         tca = tp(i, k) - t0
         IF (tca>=0.0) THEN
           elacrit = elcrit
         ELSE
-          elacrit = elcrit*(1.0-tca/tlcrit)
+          elacrit = elcrit * (1.0 - tca / tlcrit)
         END IF
         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)
+        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
       END IF
@@ -635 +626 @@
   DO k = minorig + 1, nl
     DO i = 1, ncum
-      IF (k>=(icb(i)+1)) THEN
-        tvp(i, k) = tvp(i, k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
+      IF (k>=(icb(i) + 1)) THEN
+        tvp(i, k) = tvp(i, k) * (1.0 - qnk(i) + ep(i, k) * clw(i, k))
         ! PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
         ! PRINT*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
@@ -643 +634 @@
   END DO
   DO i = 1, ncum
-    tvp(i, nlp) = tvp(i, nl) - (gz(i,nlp)-gz(i,nl))/cpd
+    tvp(i, nlp) = tvp(i, nl) - (gz(i, nlp) - gz(i, nl)) / cpd
   END DO
 
@@ -721 +712 @@
     DO i = 1, ncum
       IF (cape(i)<0.0) lcape(i) = .FALSE.
-      IF ((k>=(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)
+      IF ((k>=(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>=0.0) inb1(i) = k + 1
@@ -737 +728 @@
     defrac = capem(i) - cape(i)
     defrac = max(defrac, 0.001)
-    frac(i) = -cape(i)/defrac
+    frac(i) = -cape(i) / defrac
     frac(i) = min(frac(i), 1.0)
     frac(i) = max(frac(i), 0.0)
@@ -747 +738 @@
 
   ! initialization:
-  DO i = 1, ncum*nlp
+  DO i = 1, ncum * nlp
     hp(i, 1) = h(i, 1)
   END DO
@@ -754 +745 @@
     DO i = 1, ncum
       IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
-        hp(i, k) = h(i, nk(i)) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k &
-          )
-      END IF
-    END DO
-  END DO
-
+        hp(i, k) = h(i, nk(i)) + (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k &
+                )
+      END IF
+    END DO
+  END DO
 
 END SUBROUTINE cv_undilute2
 
 SUBROUTINE cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
-    cpn, iflag, cbmf)
+        cpn, iflag, cbmf)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -771 +763 @@
   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 ph(nloc, nd + 1) ! caution nd instead ndp1 to be consistent...
   REAL plcl(nloc), cpn(nloc, nd)
 
@@ -783 +775 @@
   REAL work(nloc)
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -805 +796 @@
   DO 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))
+    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))
   END DO
 
@@ -820 +811 @@
   DO k = minorig, icbmax
     DO i = 1, ncum
-      IF ((k>=nk(i)) .AND. (k<=(icb(i)-1))) THEN
-        dtpbl(i) = dtpbl(i) + (tvp(i,k)-tv(i,k))*dph(i, k)
-      END IF
-    END DO
-  END DO
-  DO i = 1, ncum
-    dtpbl(i) = dtpbl(i)/(ph(i,nk(i))-ph(i,icb(i)))
+      IF ((k>=nk(i)) .AND. (k<=(icb(i) - 1))) THEN
+        dtpbl(i) = dtpbl(i) + (tvp(i, k) - tv(i, k)) * dph(i, k)
+      END IF
+    END DO
+  END DO
+  DO i = 1, ncum
+    dtpbl(i) = dtpbl(i) / (ph(i, nk(i)) - ph(i, icb(i)))
     dtmin(i) = tvpplcl(i) - tvaplcl(i) + dtmax + dtpbl(i)
   END DO
@@ -836 +827 @@
   DO i = 1, ncum
     work(i) = cbmf(i)
-    cbmf(i) = max(0.0, (1.0-damp)*cbmf(i)+0.1*alpha*dtmin(i))
+    cbmf(i) = max(0.0, (1.0 - damp) * cbmf(i) + 0.1 * alpha * dtmin(i))
     IF ((work(i)==0.0) .AND. (cbmf(i)==0.0)) THEN
       iflag(i) = 3
@@ -842 +833 @@
   END DO
 
-
 END SUBROUTINE cv_closure
 
 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)
+        h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, nent, &
+        sij, elij)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -857 +848 @@
   INTEGER icb(nloc), inb(nloc), inb1(nloc), nk(nloc)
   REAL cbmf(nloc), qnk(nloc)
-  REAL ph(nloc, nd+1)
+  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)
@@ -881 +872 @@
   ! =====================================================================
 
-  DO i = 1, ncum*nlp
+  DO i = 1, ncum * nlp
     nent(i, 1) = 0
     m(i, 1) = 0.0
@@ -907 +898 @@
   DO j = minorig + 1, nl
     DO i = 1, ncum
-      IF ((j>=(icb(i)+1)) .AND. (j<=inb(i))) THEN
+      IF ((j>=(icb(i) + 1)) .AND. (j<=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))
+        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
+        m(i, j) = cbmf(i) * dbo
       END IF
     END DO
@@ -918 +909 @@
   DO k = minorig + 1, nl
     DO i = 1, ncum
-      IF ((k>=(icb(i)+1)) .AND. (k<=inb(i))) THEN
-        m(i, k) = m(i, k)/work(i)
+      IF ((k>=(icb(i) + 1)) .AND. (k<=inb(i))) THEN
+        m(i, k) = m(i, k) / work(i)
       END IF
     END DO
@@ -931 +922 @@
   ! =====================================================================
 
-
   DO i = minorig + 1, nl
     DO j = minorig + 1, nl
       DO ij = 1, ncum
-        IF ((i>=(icb(ij)+1)) .AND. (j>=icb(ij)) .AND. (i<=inb(ij)) .AND. (j<= &
-            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)
+        IF ((i>=(icb(ij) + 1)) .AND. (j>=icb(ij)) .AND. (i<=inb(ij)) .AND. (j<= &
+                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)<0.01) dei = 0.01
-          sij(ij, i, j) = anum/dei
+          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))
+          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<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
-            anum = anum - lv(ij, j)*(qti-qs(ij,j)-cwat*bf2)
-            denom = denom + lv(ij, j)*(q(ij,i)-qti)
+            anum = anum - lv(ij, j) * (qti - qs(ij, j) - cwat * bf2)
+            denom = denom + lv(ij, j) * (q(ij, i) - qti)
             IF (abs(denom)<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
+            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
           END IF
-          IF (sij(ij,i,j)>0.0 .AND. sij(ij,i,j)<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))
+          IF (sij(ij, i, j)>0.0 .AND. sij(ij, i, j)<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))
+            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
           END IF
-          sij(ij, i, j) = max(0.0, sij(ij,i,j))
-          sij(ij, i, j) = min(1.0, sij(ij,i,j))
+          sij(ij, i, j) = max(0.0, sij(ij, i, j))
+          sij(ij, i, j) = min(1.0, sij(ij, i, j))
         END IF
       END DO
@@ -980 +970 @@
 
     DO ij = 1, ncum
-      IF ((i>=(icb(ij)+1)) .AND. (i<=inb(ij)) .AND. (nent(ij,i)==0)) THEN
+      IF ((i>=(icb(ij) + 1)) .AND. (i<=inb(ij)) .AND. (nent(ij, i)==0)) THEN
         ment(ij, i, i) = m(ij, i)
-        qent(ij, i, i) = q(ij, nk(ij)) - ep(ij, i)*clw(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))
@@ -1000 +990 @@
   ! =====================================================================
 
-  CALL zilch(bsum, ncum*nlp)
+  CALL zilch(bsum, ncum * nlp)
   DO ij = 1, ncum
     lwork(ij) = .FALSE.
@@ -1008 +998 @@
     num1 = 0
     DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij))) num1 = num1 + 1
+      IF ((i>=icb(ij) + 1) .AND. (i<=inb(ij))) num1 = num1 + 1
     END DO
     IF (num1<=0) GO TO 789
 
     DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij))) THEN
-        lwork(ij) = (nent(ij,i)/=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 ((i>=icb(ij) + 1) .AND. (i<=inb(ij))) THEN
+        lwork(ij) = (nent(ij, i)/=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)<0.01) denom = 0.01
-        scrit(ij) = anum/denom
-        alt = qp1 - qs(ij, i) + scrit(ij)*(q(ij,i)-qp1)
+        scrit(ij) = anum / denom
+        alt = qp1 - qs(ij, i) + scrit(ij) * (q(ij, i) - qp1)
         IF (scrit(ij)<0.0 .OR. alt<0.0) scrit(ij) = 1.0
         asij(ij) = 0.0
@@ -1030 +1020 @@
       num2 = 0
       DO ij = 1, ncum
-        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &
-          ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) num2 = num2 + 1
+        IF ((i>=icb(ij) + 1) .AND. (i<=inb(ij)) .AND. (j>=icb(&
+                ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) num2 = num2 + 1
       END DO
       IF (num2<=0) GO TO 783
 
       DO ij = 1, ncum
-        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &
-            ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) THEN
-          IF (sij(ij,i,j)>0.0 .AND. sij(ij,i,j)<0.9) THEN
+        IF ((i>=icb(ij) + 1) .AND. (i<=inb(ij)) .AND. (j>=icb(&
+                ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) THEN
+          IF (sij(ij, i, j)>0.0 .AND. sij(ij, i, j)<0.9) THEN
             IF (j>i) THEN
-              smid = min(sij(ij,i,j), scrit(ij))
+              smid = min(sij(ij, i, j), scrit(ij))
               sjmax = smid
               sjmin = smid
-              IF (smid<smin(ij) .AND. sij(ij,i,j+1)<smid) THEN
+              IF (smid<smin(ij) .AND. sij(ij, i, j + 1)<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))
+                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))
               END IF
             ELSE
-              sjmax = max(sij(ij,i,j+1), scrit(ij))
-              smid = max(sij(ij,i,j), scrit(ij))
+              sjmax = max(sij(ij, i, j + 1), scrit(ij))
+              smid = max(sij(ij, i, j), scrit(ij))
               sjmin = 0.0
-              IF (j>1) sjmin = sij(ij, i, j-1)
+              IF (j>1) sjmin = sij(ij, i, j - 1)
               sjmin = max(sjmin, scrit(ij))
             END IF
-            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))
+            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))
           END IF
         END IF
       END DO
-783 END DO
+    783 END DO
     DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. lwork(ij)) THEN
+      IF ((i>=icb(ij) + 1) .AND. (i<=inb(ij)) .AND. lwork(ij)) THEN
         asij(ij) = max(1.0E-21, asij(ij))
-        asij(ij) = 1.0/asij(ij)
+        asij(ij) = 1.0 / asij(ij)
         bsum(ij, i) = 0.0
       END IF
@@ -1073 +1063 @@
     DO j = minorig, nl + 1
       DO ij = 1, ncum
-        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &
-            ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) THEN
-          ment(ij, i, j) = ment(ij, i, j)*asij(ij)
+        IF ((i>=icb(ij) + 1) .AND. (i<=inb(ij)) .AND. (j>=icb(&
+                ij)) .AND. (j<=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)
         END IF
@@ -1081 +1071 @@
     END DO
     DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (bsum(ij, &
-          i)<1.0E-18) .AND. lwork(ij)) THEN
+      IF ((i>=icb(ij) + 1) .AND. (i<=inb(ij)) .AND. (bsum(ij, &
+              i)<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)
+        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))
@@ -1092 +1082 @@
       END IF
     END DO
-789 END DO
-
+  789 END DO
 
 END SUBROUTINE cv_mixing
 
 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)
+        ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -1110 +1099 @@
   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 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)
@@ -1150 +1139 @@
   DO k = 2, nl + 1
     DO i = 1, ncum
-      qp(i, k) = q(i, k-1)
-      up(i, k) = u(i, k-1)
-      vp(i, k) = v(i, k-1)
+      qp(i, k) = q(i, k - 1)
+      up(i, k) = u(i, k - 1)
+      vp(i, k) = v(i, k - 1)
     END DO
   END DO
@@ -1164 +1153 @@
   ! ***                and condensed water flux                    ***
 
-
   DO i = 1, ncum
     jtt(i) = 2
-    IF (ep(i,inb(i))<=0.0001) iflag(i) = 2
+    IF (ep(i, inb(i))<=0.0001) iflag(i) = 2
     IF (iflag(i)==0) THEN
       lwork(i) = .TRUE.
@@ -1177 +1165 @@
   ! ***                    Begin downdraft loop                    ***
 
-
   CALL zilch(wdtrain, ncum)
   DO i = nl + 1, 1, -1
@@ -1192 +1179 @@
     DO ij = 1, ncum
       IF ((i<=inb(ij)) .AND. (lwork(ij))) THEN
-        wdtrain(ij) = g*ep(ij, i)*m(ij, i)*clw(ij, i)
+        wdtrain(ij) = g * ep(ij, i) * m(ij, i) * clw(ij, i)
       END IF
     END DO
@@ -1200 +1187 @@
         DO ij = 1, ncum
           IF ((i<=inb(ij)) .AND. (lwork(ij))) THEN
-            awat = elij(ij, j, i) - (1.-ep(ij,i))*clw(ij, i)
+            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)
+            wdtrain(ij) = wdtrain(ij) + g * awat * ment(ij, j, i)
           END IF
         END DO
@@ -1223 +1210 @@
         ! rain   ***
 
-        IF (t(ij,i)>273.0) THEN
+        IF (t(ij, i)>273.0) THEN
           coeff = coeffr
           wt(ij, i) = omtrain
         END IF
-        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))
+        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
+        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
 
         ! ***  Calculate precipitating downdraft mass flux under     ***
@@ -1243 +1230 @@
 
         IF (i>1) THEN
-          dhdp = (h(ij,i)-h(ij,i-1))/(p(ij,i-1)-p(ij,i))
+          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)
+          mp(ij, i) = 100. * ginv * lv(ij, i) * sigd * evap(ij, i) / dhdp
+          mp(ij, i) = max(mp(ij, i), 0.0)
 
           ! ***   Add small amount of inertia to downdraft              ***
 
-          fac = 20.0/(ph(ij,i-1)-ph(ij,i))
-          mp(ij, i) = (fac*mp(ij,i+1)+mp(ij,i))/(1.+fac)
+          fac = 20.0 / (ph(ij, i - 1) - ph(ij, i))
+          mp(ij, i) = (fac * mp(ij, i + 1) + mp(ij, i)) / (1. + fac)
 
           ! ***      Force mp to decrease linearly to zero
@@ -1258 +1245 @@
           ! ***
 
-          IF (p(ij,i)>(0.949*p(ij,1))) THEN
+          IF (p(ij, i)>(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)))
+            mp(ij, i) = mp(ij, jtt(ij)) * (p(ij, 1) - p(ij, i)) / &
+                    (p(ij, 1) - p(ij, jtt(ij)))
           END IF
         END IF
@@ -1271 +1258 @@
             qstm = qs(ij, 1)
           ELSE
-            qstm = qs(ij, i-1)
+            qstm = qs(ij, i - 1)
           END IF
-          IF (mp(ij,i)>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)
+          IF (mp(ij, i)>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)>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)
+            IF (mp(ij, i + 1)>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)
             END IF
           END IF
-          qp(ij, i) = min(qp(ij,i), qstm)
-          qp(ij, i) = max(qp(ij,i), 0.0)
+          qp(ij, i) = min(qp(ij, i), qstm)
+          qp(ij, i) = max(qp(ij, i), 0.0)
         END IF
       END IF
     END DO
-899 END DO
-
+  899 END DO
 
 END SUBROUTINE cv_unsat
 
 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, iflag, wd, qprime, tprime, &
-    precip, cbmf, ft, fq, fu, fv, ma, qcondc)
+        ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, evap, &
+        ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, tprime, &
+        precip, cbmf, ft, fq, fu, fv, ma, qcondc)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -1314 +1301 @@
   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 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)
@@ -1344 +1331 @@
   ! -- initializations:
 
-  delti = 1.0/delt
+  delti = 1.0 / delt
 
   DO i = 1, ncum
@@ -1356 +1343 @@
       fv(i, k) = 0.0
       fq(i, k) = 0.0
-      lvcp(i, k) = lv(i, k)/cpn(i, k)
+      lvcp(i, k) = lv(i, k) / cpn(i, k)
       qcondc(i, k) = 0.0 ! cld
       qcond(i, k) = 0.0 ! cld
@@ -1371 +1358 @@
       ! c     &                /(rowl*g)
       ! c            precip(i)=precip(i)*delt/86400.
-      precip(i) = wt(i, 1)*sigd*water(i, 1)*86400/g
+      precip(i) = wt(i, 1) * sigd * water(i, 1) * 86400 / g
     END IF
   END DO
@@ -1380 +1367 @@
 
   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
+    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
   END DO
 
@@ -1389 +1376 @@
 
   DO i = 1, ncum
-    work(i) = 0.01/(ph(i,1)-ph(i,2))
+    work(i) = 0.01 / (ph(i, 1) - ph(i, 2))
     am(i) = 0.0
   END DO
@@ -1400 +1387 @@
   END DO
   DO i = 1, ncum
-    IF ((g*work(i)*am(i))>=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)))
+    IF ((g * work(i) * am(i))>=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)))
   END DO
   DO j = 2, nl
     DO i = 1, ncum
       IF (j<=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))
+        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))
       END IF
     END DO
@@ -1443 +1430 @@
     DO k = i + 1, nl + 1
       DO ij = 1, ncum
-        IF ((i>=nk(ij)) .AND. (i<=inb(ij)) .AND. (k<=(inb(ij)+1))) THEN
+        IF ((i>=nk(ij)) .AND. (i<=inb(ij)) .AND. (k<=(inb(ij) + 1))) THEN
           amp1(ij) = amp1(ij) + m(ij, k)
         END IF
@@ -1452 +1439 @@
       DO j = i + 1, nl + 1
         DO ij = 1, ncum
-          IF ((j<=(inb(ij)+1)) .AND. (i<=inb(ij))) THEN
+          IF ((j<=(inb(ij) + 1)) .AND. (i<=inb(ij))) THEN
             amp1(ij) = amp1(ij) + ment(ij, k, j)
           END IF
@@ -1470 +1457 @@
     DO ij = 1, ncum
       IF (i<=inb(ij)) THEN
-        dpinv = 0.01/(ph(ij,i)-ph(ij,i+1))
-        cpinv = 1.0/cpn(ij, i)
-
-        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)))
+        dpinv = 0.01 / (ph(ij, i) - ph(ij, i + 1))
+        cpinv = 1.0 / cpn(ij, i)
+
+        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)))
       END IF
     END DO
@@ -1491 +1478 @@
       DO ij = 1, ncum
         IF (i<=inb(ij)) THEN
-          awat = elij(ij, k, i) - (1.-ep(ij,i))*clw(ij, i)
+          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 &
-            ))
+          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 &
+                  ))
           ! (saturated updrafts resulting from mixing)               ! cld
-          qcond(ij, i) = qcond(ij, i) + (elij(ij,k,i)-awat) ! cld
+          qcond(ij, i) = qcond(ij, i) + (elij(ij, k, i) - awat) ! cld
           nqcond(ij, i) = nqcond(ij, i) + 1. ! cld
         END IF
@@ -1508 +1495 @@
       DO ij = 1, ncum
         IF ((i<=inb(ij)) .AND. (k<=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 &
-            ))
+          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 &
+                  ))
         END IF
       END DO
@@ -1519 +1506 @@
     DO ij = 1, ncum
       IF (i<=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
+        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
         ! (saturated downdrafts resulting from mixing)               ! cld
         DO k = i + 1, inb(ij) ! cld
@@ -1531 +1518 @@
         END DO ! cld
         ! (particular case: no detraining level is found)            ! cld
-        IF (nent(ij,i)==0) THEN ! cld
-          qcond(ij, i) = qcond(ij, i) + (1.-ep(ij,i))*clw(ij, i) ! cld
+        IF (nent(ij, i)==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
         END IF ! cld
-        IF (nqcond(ij,i)/=0.) THEN ! cld
-          qcond(ij, i) = qcond(ij, i)/nqcond(ij, i) ! cld
+        IF (nqcond(ij, i)/=0.) THEN ! cld
+          qcond(ij, i) = qcond(ij, i) / nqcond(ij, i) ! cld
         END IF ! cld
       END IF
     END DO
-1500 END DO
+  1500 END DO
 
   ! *** Adjust tendencies at top of convection layer to reflect  ***
@@ -1547 +1534 @@
   DO 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))/(ph(ij,inb(ij)-1)-ph(ij, &
-      inb(ij))))*lv(ij, inb(ij))/lv(ij, inb(ij)-1)
+    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)) / (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))/(ph(ij,inb(ij)-1)-ph(ij, &
-      inb(ij))))*cpn(ij, inb(ij))/cpn(ij, inb(ij)-1)
+    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)) / (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))/(ph(ij,inb(ij)-1)-ph(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)) / (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))/(ph(ij,inb(ij)-1)-ph(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)) / (ph(ij, inb(ij) - 1) - ph(ij, inb(ij))))
   END DO
 
@@ -1574 +1561 @@
     vav(ij) = 0.0
     DO 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))
+      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))
     END DO
   END DO
   DO 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))
+    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))
   END DO
   DO ij = 1, ncum
     DO 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))
+      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))
     END DO
   END DO
@@ -1595 +1582 @@
   DO k = 1, nl + 1
     DO i = 1, ncum
-      IF ((q(i,k)+delt*fq(i,k))<0.0) iflag(i) = 10
-    END DO
-  END DO
-
+      IF ((q(i, k) + delt * fq(i, k))<0.0) iflag(i) = 10
+    END DO
+  END DO
 
   DO i = 1, ncum
@@ -1625 +1611 @@
   DO k = nl, 1, -1
     DO i = 1, ncum
-      ma(i, k) = ma(i, k+1) + m(i, k)
+      ma(i, k) = ma(i, k + 1) + m(i, k)
     END DO
   END DO
@@ -1647 +1633 @@
       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
+        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
       END DO ! cld
-      IF (ax(ij,i)>0.0) THEN ! cld
-        wa(ij, i) = sqrt(2.*ax(ij,i)) ! cld
+      IF (ax(ij, i)>0.0) THEN ! cld
+        wa(ij, i) = sqrt(2. * ax(ij, i)) ! cld
       END IF ! cld
     END DO ! cld
     DO i = 1, nl ! cld
-      IF (wa(ij,i)>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
+      IF (wa(ij, i)>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
     END DO ! cld
   END DO ! cld
 
-
 END SUBROUTINE cv_yield
 
 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)
+        fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, ma1, &
+        qcondc1)
   IMPLICIT NONE
 
@@ -1710 +1695 @@
   END DO
 
-
 END SUBROUTINE cv_uncompress
 

LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv30.f90

@@ -1 +1 @@
 ! $Id$
 
-
-
-SUBROUTINE cv30_param(nd, delt)
-  USE lmdz_conema3
-  IMPLICIT NONE
-
-  ! ------------------------------------------------------------
-  ! Set parameters for convectL for iflag_con = 3
-  ! ------------------------------------------------------------
-
-
-  ! ***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
-  ! ***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
-  ! ***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***
-  ! ***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
-  ! ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-  ! ***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***
-  ! ***                        OF CLOUD                         ***
-
-  ! [TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
-  ! ***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
-  ! ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
-  ! ***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
-  ! ***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
-
-  ! ***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
-  ! ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
-  ! ***                     IT MUST BE LESS THAN 0              ***
-
-  include "cv30param.h"
-
-  INTEGER nd
-  REAL delt ! timestep (seconds)
-
-  ! noff: integer limit for convection (nd-noff)
-  ! minorig: First level of convection
-
-  ! -- limit levels for convection:
-
-  noff = 1
-  minorig = 1
-  nl = nd - noff
-  nlp = nl + 1
-  nlm = nl - 1
-
-  ! -- "microphysical" parameters:
-
-  sigd = 0.01
-  spfac = 0.15
-  pbcrit = 150.0
-  ptcrit = 500.0
-  ! IM cf. FH     epmax  = 0.993
-
-  omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
-
-  ! -- misc:
-
-  dtovsh = -0.2 ! dT for overshoot
-  dpbase = -40. ! definition cloud base (400m above LCL)
-  dttrig = 5. ! (loose) condition for triggering
-
-  ! -- rate of approach to quasi-equilibrium:
-
-  dtcrit = -2.0
-  tau = 8000.
-  beta = 1.0 - delt / tau
-  alpha = 1.5E-3 * delt / tau
-  ! increase alpha to compensate W decrease:
-  alpha = alpha * 1.5
-
-  ! -- interface cloud parameterization:
-
-  delta = 0.01 ! cld
-
-  ! -- interface with boundary-layer (gust factor): (sb)
-
-  betad = 10.0 ! original value (from convect 4.3)
-
-END SUBROUTINE cv30_param
-
-SUBROUTINE cv30_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
-  ! =====================================================================
-
-  ! inputs:
-  INTEGER len, nd, ndp1
-  REAL t(len, nd), q(len, nd), p(len, nd), ph(len, ndp1)
-
-  ! 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)
-
-  ! local variables:
-  INTEGER k, i
-  REAL rdcp
-  REAL tvx, tvy ! convect3
-  REAL cpx(len, nd)
-
-  include "cvthermo.h"
-  include "cv30param.h"
-
-
-  ! ori      do 110 k=1,nlp
-  DO k = 1, nl ! convect3
+MODULE lmdz_cv30
+  !------------------------------------------------------------
+  ! Parameters for convectL, iflag_con=30:
+  ! (includes - microphysical parameters,
+  !                     - parameters that control the rate of approach
+  !               to quasi-equilibrium)
+  !                     - noff & minorig (previously in input of convect1)
+  !------------------------------------------------------------
+
+  IMPLICIT NONE; PRIVATE
+  PUBLIC sigd, spfac, pbcrit, ptcrit, omtrain, dtovsh, dpbase, dttrig, dtcrit, &
+          tau, beta, alpha, delta, betad, noff, minorig, nl, nlp, nlm, &
+          cv30_param, cv30_prelim, cv30_feed, cv30_undilute1, cv30_trigger, &
+          cv30_compress, cv30_undilute2, cv30_closure, cv30_mixing, cv30_unsat, &
+          cv30_yield, cv30_tracer, cv30_uncompress, cv30_epmax_fn_cape
+
+  INTEGER noff, minorig, nl, nlp, nlm
+  REAL sigd, spfac
+  REAL pbcrit, ptcrit
+  REAL omtrain
+  REAL dtovsh, dpbase, dttrig
+  REAL dtcrit, tau, beta, alpha
+  REAL delta
+  REAL betad
+
+  !$OMP THREADPRIVATE(sigd, spfac, pbcrit, ptcrit, omtrain, dtovsh, dpbase, dttrig, dtcrit, &
+  !$OMP      tau, beta, alpha, delta, betad, noff, minorig, nl, nlp, nlm)
+CONTAINS
+
+  SUBROUTINE cv30_param(nd, delt)
+    USE lmdz_conema3
+
+    IMPLICIT NONE
+
+    ! ------------------------------------------------------------
+    ! Set parameters for convectL for iflag_con = 3
+    ! ------------------------------------------------------------
+
+
+    ! ***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
+    ! ***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
+    ! ***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***
+    ! ***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
+    ! ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
+    ! ***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***
+    ! ***                        OF CLOUD                         ***
+
+    ! [TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
+    ! ***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
+    ! ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+    ! ***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
+    ! ***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
+
+    ! ***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
+    ! ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+    ! ***                     IT MUST BE LESS THAN 0              ***
+
+    INTEGER nd
+    REAL delt ! timestep (seconds)
+
+    ! noff: integer limit for convection (nd-noff)
+    ! minorig: First level of convection
+
+    ! -- limit levels for convection:
+
+    noff = 1
+    minorig = 1
+    nl = nd - noff
+    nlp = nl + 1
+    nlm = nl - 1
+
+    ! -- "microphysical" parameters:
+
+    sigd = 0.01
+    spfac = 0.15
+    pbcrit = 150.0
+    ptcrit = 500.0
+    ! IM cf. FH     epmax  = 0.993
+
+    omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
+
+    ! -- misc:
+
+    dtovsh = -0.2 ! dT for overshoot
+    dpbase = -40. ! definition cloud base (400m above LCL)
+    dttrig = 5. ! (loose) condition for triggering
+
+    ! -- rate of approach to quasi-equilibrium:
+
+    dtcrit = -2.0
+    tau = 8000.
+    beta = 1.0 - delt / tau
+    alpha = 1.5E-3 * delt / tau
+    ! increase alpha to compensate W decrease:
+    alpha = alpha * 1.5
+
+    ! -- interface cloud parameterization:
+
+    delta = 0.01 ! cld
+
+    ! -- interface with boundary-layer (gust factor): (sb)
+
+    betad = 10.0 ! original value (from convect 4.3)
+
+  END SUBROUTINE cv30_param
+
+  SUBROUTINE cv30_prelim(len, nd, ndp1, t, q, p, ph, lv, cpn, tv, gz, h, hm, &
+          th)
+    USE lmdz_cvthermo
+
+    IMPLICIT NONE
+
+    ! =====================================================================
+    ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+    ! "ori": from convect4.3 (vectorized)
+    ! "convect3": to be exactly consistent with convect3
+    ! =====================================================================
+
+    ! inputs:
+    INTEGER len, nd, ndp1
+    REAL t(len, nd), q(len, nd), p(len, nd), ph(len, ndp1)
+
+    ! 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)
+
+    ! local variables:
+    INTEGER k, i
+    REAL rdcp
+    REAL tvx, tvy ! convect3
+    REAL cpx(len, nd)
+
+    ! ori      do 110 k=1,nlp
+    DO k = 1, nl ! convect3
+      DO i = 1, len
+        ! debug          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)
+        ! 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
+      END DO
+    END DO
+
+    ! gz = phi at the full levels (same as p).
+
     DO i = 1, len
-      ! debug          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)
-      ! 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
-    END DO
-  END DO
-
-  ! gz = phi at the full levels (same as p).
-
-  DO i = 1, len
-    gz(i, 1) = 0.0
-  END DO
-  ! ori      do 140 k=2,nlp
-  DO k = 2, nl ! convect3
+      gz(i, 1) = 0.0
+    END DO
+    ! ori      do 140 k=2,nlp
+    DO k = 2, nl ! convect3
+      DO 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
+
+        ! ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
+        ! ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
+      END DO
+    END DO
+
+    ! h  = phi + cpT (dry static energy).
+    ! hm = phi + cp(T-Tbase)+Lq
+
+    ! ori      do 170 k=1,nlp
+    DO k = 1, nl ! convect3
+      DO 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)
+      END DO
+    END DO
+
+  END SUBROUTINE cv30_prelim
+
+  SUBROUTINE cv30_feed(len, nd, t, q, qs, p, ph, hm, gz, nk, icb, icbmax, &
+          iflag, tnk, qnk, gznk, plcl)
+
+    IMPLICIT NONE
+
+    ! ================================================================
+    ! Purpose: CONVECTIVE FEED
+
+    ! Main differences with cv_feed:
+    ! - ph added in input
+    ! - here, nk(i)=minorig
+    ! - icb defined differently (plcl compared with ph instead of p)
+
+    ! Main differences with convect3:
+    ! - we do not compute dplcldt and dplcldr of CLIFT anymore
+    ! - values iflag different (but tests identical)
+    ! - A,B explicitely defined (!...)
+    ! ================================================================
+
+    ! 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)
+
+    ! outputs:
+    INTEGER iflag(len), nk(len), icb(len), icbmax
+    REAL tnk(len), qnk(len), gznk(len), plcl(len)
+
+    ! local variables:
+    INTEGER i, k
+    INTEGER ihmin(len)
+    REAL work(len)
+    REAL pnk(len), qsnk(len), rh(len), chi(len)
+    REAL a, b ! convect3
+    ! ym
+    plcl = 0.0
+    ! @ !-------------------------------------------------------------------
+    ! @ ! --- 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
+
+    ! -------------------------------------------------------------------
+    ! --- Origin level of ascending parcels for convect3:
+    ! -------------------------------------------------------------------
+
     DO 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
-
-      ! ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
-      ! ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
-    END DO
-  END DO
-
-  ! h  = phi + cpT (dry static energy).
-  ! hm = phi + cp(T-Tbase)+Lq
-
-  ! ori      do 170 k=1,nlp
-  DO k = 1, nl ! convect3
+      nk(i) = minorig
+    END DO
+
+    ! -------------------------------------------------------------------
+    ! --- Check whether parcel level temperature and specific humidity
+    ! --- are reasonable
+    ! -------------------------------------------------------------------
     DO 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)
-    END DO
-  END DO
-
-END SUBROUTINE cv30_prelim
-
-SUBROUTINE cv30_feed(len, nd, t, q, qs, p, ph, hm, gz, nk, icb, icbmax, &
-        iflag, tnk, qnk, gznk, plcl)
-  IMPLICIT NONE
-
-  ! ================================================================
-  ! Purpose: CONVECTIVE FEED
-
-  ! Main differences with cv_feed:
-  ! - ph added in input
-  ! - here, nk(i)=minorig
-  ! - icb defined differently (plcl compared with ph instead of p)
-
-  ! Main differences with convect3:
-  ! - we do not compute dplcldt and dplcldr of CLIFT anymore
-  ! - values iflag different (but tests identical)
-  ! - A,B explicitely defined (!...)
-  ! ================================================================
-
-  include "cv30param.h"
-
-  ! 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)
-
-  ! outputs:
-  INTEGER iflag(len), nk(len), icb(len), icbmax
-  REAL tnk(len), qnk(len), gznk(len), plcl(len)
-
-  ! local variables:
-  INTEGER i, k
-  INTEGER ihmin(len)
-  REAL work(len)
-  REAL pnk(len), qsnk(len), rh(len), chi(len)
-  REAL a, b ! convect3
-  ! ym
-  plcl = 0.0
-  ! @ !-------------------------------------------------------------------
-  ! @ ! --- 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
-
-  ! -------------------------------------------------------------------
-  ! --- Origin level of ascending parcels for convect3:
-  ! -------------------------------------------------------------------
-
-  DO i = 1, len
-    nk(i) = minorig
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Check whether parcel level temperature and specific humidity
-  ! --- are reasonable
-  ! -------------------------------------------------------------------
-  DO i = 1, len
-    IF (((t(i, nk(i))<250.0) .OR. (q(i, nk(i))<=0.0)) & ! @      &       .OR.(
-            ! p(i,ihmin(i)).lt.400.0
-            ! )  )
-            .AND. (iflag(i)==0)) iflag(i) = 7
-  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
-
-  DO i = 1, len
-
-    IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002
-
+      IF (((t(i, nk(i))<250.0) .OR. (q(i, nk(i))<=0.0)) & ! @      &       .OR.(
+              ! p(i,ihmin(i)).lt.400.0
+              ! )  )
+              .AND. (iflag(i)==0)) iflag(i) = 7
+    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
+
+    DO i = 1, len
+
+      IF (iflag(i)/=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))
+
+        rh(i) = qnk(i) / qsnk(i)
+        ! ori        rh(i)=min(1.0,rh(i)) ! removed for convect3
+        ! 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)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) iflag &
+                (i) = 8
+
+      END IF ! iflag=7
+
+    END DO
+
+    ! -------------------------------------------------------------------
+    ! --- 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
+
+    DO i = 1, len
+      icb(i) = nlm
+    END DO
+
+    ! la modification consiste a comparer plcl a ph et non a p:
+    ! icb est defini par :  ph(icb)<plcl<ph(icb-1)
+    ! @      do 290 k=minorig,nl
+    DO k = 3, nl - 1 ! modif pour que icb soit sup/egal a 2
+      DO i = 1, len
+        IF (ph(i, k)<plcl(i)) icb(i) = min(icb(i), k)
+      END DO
+    END DO
+
+    DO i = 1, len
+      ! @        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
+      IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
+    END DO
+
+    DO i = 1, len
+      icb(i) = icb(i) - 1 ! icb sup ou egal a 2
+    END DO
+
+    ! Compute icbmax.
+
+    icbmax = 2
+    DO i = 1, len
+      !        icbmax=max(icbmax,icb(i))
+      IF (iflag(i)<7) icbmax = max(icbmax, icb(i)) ! sb Jun7th02
+    END DO
+
+  END SUBROUTINE cv30_feed
+
+  SUBROUTINE cv30_undilute1(len, nd, t, q, qs, gz, plcl, p, nk, icb, tp, tvp, &
+          clw, icbs)
+    USE lmdz_cvthermo
+
+    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)
+    ! ----------------------------------------------------------------
+
+
+
+    ! 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
+
+    ! outputs:
+    REAL tp(len, nd), tvp(len, nd), clw(len, nd)
+
+    ! 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 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))
-
-      rh(i) = qnk(i) / qsnk(i)
-      ! ori        rh(i)=min(1.0,rh(i)) ! removed for convect3
-      ! 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)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) iflag &
-              (i) = 8
-
-    END IF ! iflag=7
-
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- 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
-
-  DO i = 1, len
-    icb(i) = nlm
-  END DO
-
-  ! la modification consiste a comparer plcl a ph et non a p:
-  ! icb est defini par :  ph(icb)<plcl<ph(icb-1)
-  ! @      do 290 k=minorig,nl
-  DO k = 3, nl - 1 ! modif pour que icb soit sup/egal a 2
+      ! ori        ticb(i)=t(i,icb(i))
+      ! ori        gzicb(i)=gz(i,icb(i))
+    END DO
+
+    ! ***  Calculate certain parcel quantities, including static energy   ***
+
     DO i = 1, len
-      IF (ph(i, k)<plcl(i)) icb(i) = min(icb(i), k)
-    END DO
-  END DO
-
-  DO i = 1, len
-    ! @        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
-    IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
-  END DO
-
-  DO i = 1, len
-    icb(i) = icb(i) - 1 ! icb sup ou egal a 2
-  END DO
-
-  ! Compute icbmax.
-
-  icbmax = 2
-  DO i = 1, len
-    !        icbmax=max(icbmax,icb(i))
-    IF (iflag(i)<7) icbmax = max(icbmax, icb(i)) ! sb Jun7th02
-  END DO
-
-END SUBROUTINE cv30_feed
-
-SUBROUTINE cv30_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 "cv30param.h"
-
-  ! 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
-
-  ! outputs:
-  REAL tp(len, nd), tvp(len, nd), clw(len, nd)
-
-  ! 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 i = 1, len
-    tnk(i) = t(i, nk(i))
-    qnk(i) = q(i, nk(i))
-    gznk(i) = gz(i, nk(i))
-    ! ori        ticb(i)=t(i,icb(i))
-    ! ori        gzicb(i)=gz(i,icb(i))
-  END DO
-
-  ! ***  Calculate certain parcel quantities, including static energy   ***
-
-  DO 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)
-  END DO
-
-  ! ***   Calculate lifted parcel quantities below cloud base   ***
-
-  DO i = 1, len !convect3
-    icb1(i) = min(max(icb(i), 2), nl)
-    ! if icb is below LCL, start loop at ICB+1:
-    ! (icbs est le premier niveau au-dessus du LCL)
-    icbs(i) = icb1(i) !convect3
-    IF (plcl(i)<p(i, icb1(i))) THEN
-      icbs(i) = min(icbs(i) + 1, nl) !convect3
+      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)
+    END DO
+
+    ! ***   Calculate lifted parcel quantities below cloud base   ***
+
+    DO i = 1, len !convect3
+      icb1(i) = min(max(icb(i), 2), nl)
+      ! if icb is below LCL, start loop at ICB+1:
+      ! (icbs est le premier niveau au-dessus du LCL)
+      icbs(i) = icb1(i) !convect3
+      IF (plcl(i)<p(i, icb1(i))) THEN
+        icbs(i) = min(icbs(i) + 1, nl) !convect3
+      END IF
+    END DO !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
+    END DO !convect3
+
+
+    ! Re-compute icbsmax (icbsmax2):        !convect3
+    !convect3
+    icbsmax2 = 2 !convect3
+    DO i = 1, len !convect3
+      icbsmax2 = max(icbsmax2, icbs(i)) !convect3
+    END DO !convect3
+
+    ! 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
+      END DO ! convect3
+    END DO ! convect3
+
+    ! tp and tvp below cloud base:
+
+    DO k = minorig, icbsmax2 - 1
+      DO 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)
+      END DO
+    END DO
+
+    ! ***  Find lifted parcel quantities above cloud base    ***
+
+    DO i = 1, len
+      tg = ticb(i)
+      ! ori         qg=qs(i,icb(i))
+      qg = qsicb(i) ! convect3
+      ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
+      alv = lv0 - clmcpv * (ticb(i) - 273.15)
+
+      ! First iteration.
+
+      ! 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
+      ! 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)
+      ! ori          tg=max(tg,35.0)
+      ! debug          tc=tg-t0
+      tc = tg - 273.15
+      denom = 243.5 + tc
+      denom = max(denom, 1.0) ! convect3
+      ! ori          IF(tc.ge.0.0)THEN
+      es = 6.112 * exp(17.67 * tc / denom)
+      ! ori          else
+      ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+      ! ori          endif
+      ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+      qg = eps * es / (p(i, icbs(i)) - es * (1. - eps))
+
+      ! Second iteration.
+
+
+      ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+      ! ori          s=1./s
+      ! 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)
+      ! ori          tg=max(tg,35.0)
+      ! debug          tc=tg-t0
+      tc = tg - 273.15
+      denom = 243.5 + tc
+      denom = max(denom, 1.0) ! convect3
+      ! ori          IF(tc.ge.0.0)THEN
+      es = 6.112 * exp(17.67 * tc / denom)
+      ! ori          else
+      ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+      ! ori          end if
+      ! 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)
+
+      ! ori c approximation here:
+      ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+      ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
+
+      ! convect3: no approximation:
+      tp(i, icbs(i)) = (ah0(i) - gz(i, icbs(i)) - alv * qg) / (cpd + (cl - cpd) * qnk(i))
+
+      ! ori         clw(i,icb(i))=qnk(i)-qg
+      ! 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))
+      ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+      ! 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
+
+    END DO
+
+    ! ori      do 380 k=minorig,icbsmax2
+    ! ori       do 370 i=1,len
+    ! ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
+    ! ori 370   continue
+    ! ori 380  continue
+
+
+    ! -- The following is only for convect3:
+
+    ! * icbs is the first level above the LCL:
+    ! if plcl<p(icb), then icbs=icb+1
+    ! if plcl>p(icb), then icbs=icb
+
+    ! * the routine above computes tvp from minorig to icbs (included).
+
+    ! * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
+    ! must be known. This is the case if icbs=icb+1, but not if icbs=icb.
+
+    ! * therefore, in the case icbs=icb, we compute tvp at level icb+1
+    ! (tvp at other levels will be computed in cv3_undilute2.F)
+
+    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)
+    END DO
+
+    DO i = 1, len
+      tg = ticb(i)
+      qg = qsicb(i) ! convect3
+      ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
+      alv = lv0 - clmcpv * (ticb(i) - 273.15)
+
+      ! First iteration.
+
+      ! 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
+      ! 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)
+      ! ori          tg=max(tg,35.0)
+      ! debug          tc=tg-t0
+      tc = tg - 273.15
+      denom = 243.5 + tc
+      denom = max(denom, 1.0) ! convect3
+      ! ori          IF(tc.ge.0.0)THEN
+      es = 6.112 * exp(17.67 * tc / denom)
+      ! ori          else
+      ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+      ! ori          endif
+      ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+      qg = eps * es / (p(i, icb(i) + 1) - es * (1. - eps))
+
+      ! Second iteration.
+
+
+      ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+      ! ori          s=1./s
+      ! 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)
+      ! ori          tg=max(tg,35.0)
+      ! debug          tc=tg-t0
+      tc = tg - 273.15
+      denom = 243.5 + tc
+      denom = max(denom, 1.0) ! convect3
+      ! ori          IF(tc.ge.0.0)THEN
+      es = 6.112 * exp(17.67 * tc / denom)
+      ! ori          else
+      ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+      ! ori          end if
+      ! 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)
+
+      ! ori c approximation here:
+      ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+      ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
+
+      ! convect3: no approximation:
+      tp(i, icb(i) + 1) = (ah0(i) - gz(i, icb(i) + 1) - alv * qg) / (cpd + (cl - cpd) * qnk(i))
+
+      ! ori         clw(i,icb(i))=qnk(i)-qg
+      ! 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))
+      ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+      ! 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
+
+    END DO
+
+  END SUBROUTINE cv30_undilute1
+
+  SUBROUTINE cv30_trigger(len, nd, icb, plcl, p, th, tv, tvp, 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
+    ! -------------------------------------------------------------------
+
+
+
+    ! input:
+    INTEGER len, nd
+    INTEGER icb(len)
+    REAL plcl(len), p(len, nd)
+    REAL th(len, nd), tv(len, nd), tvp(len, nd)
+
+    ! output:
+    REAL pbase(len), buoybase(len)
+
+    ! input AND output:
+    INTEGER iflag(len)
+    REAL sig(len, nd), w0(len, nd)
+
+    ! local variables:
+    INTEGER i, k
+    REAL tvpbase, tvbase, tdif, ath, ath1
+
+
+    ! ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
+
+    DO 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
+    END DO
+
+
+    ! ***   make sure that column is dry adiabatic between the surface  ***
+    ! ***    and cloud base, and that lifted air is positively buoyant  ***
+    ! ***                         at cloud base                         ***
+    ! ***       if not, return to calling program after resetting       ***
+    ! ***                        sig(i) and w0(i)                       ***
+
+
+    ! oct3      do 200 i=1,len
+    ! oct3
+    ! oct3       tdif = buoybase(i)
+    ! oct3       ath1 = th(i,1)
+    ! oct3       ath  = th(i,icb(i)-1) - dttrig
+    ! oct3
+    ! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
+    ! oct3         do 60 k=1,nl
+    ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
+    ! oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
+    ! oct3            w0(i,k)  = beta*w0(i,k)
+    ! oct3   60    continue
+    ! oct3         iflag(i)=4 ! pour version vectorisee
+    ! oct3c convect3         iflag(i)=0
+    ! oct3cccc         RETURN
+    ! oct3       endif
+    ! oct3
+    ! oct3200   continue
+
+    ! -- oct3: on reecrit la boucle 200 (pour la vectorisation)
+
+    DO k = 1, nl
+      DO i = 1, len
+
+        tdif = buoybase(i)
+        ath1 = th(i, 1)
+        ath = th(i, icb(i) - 1) - dttrig
+
+        IF (tdif<dtcrit .OR. ath>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
+          ! convect3         iflag(i)=0
+        END IF
+
+      END DO
+    END DO
+
+    ! fin oct3 --
+
+  END SUBROUTINE cv30_trigger
+
+  SUBROUTINE cv30_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, &
+          iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, &
+          v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, w0)
+    USE lmdz_print_control, ONLY: lunout
+    USE lmdz_abort_physic, ONLY: abort_physic
+    IMPLICIT NONE
+
+
+
+    ! 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)
+
+    ! outputs:
+    ! 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)
+
+    ! local variables:
+    INTEGER i, k, nn, j
+
+    CHARACTER (LEN = 20) :: modname = 'cv30_compress'
+    CHARACTER (LEN = 80) :: abort_message
+
+    DO k = 1, nl + 1
+      nn = 0
+      DO i = 1, len
+        IF (iflag1(i)==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)
+        END IF
+      END DO
+    END DO
+
+    ! do 121 j=1,ntra
+    ! 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)
+    ! END IF
+    ! 101  continue
+    ! 111  continue
+    ! 121  continue
+
+    IF (nn/=ncum) THEN
+      WRITE (lunout, *) 'strange! nn not equal to ncum: ', nn, ncum
+      abort_message = ''
+      CALL abort_physic(modname, abort_message, 1)
     END IF
-  END DO !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
-  END DO !convect3
-
-
-  ! Re-compute icbsmax (icbsmax2):        !convect3
-  !convect3
-  icbsmax2 = 2 !convect3
-  DO i = 1, len !convect3
-    icbsmax2 = max(icbsmax2, icbs(i)) !convect3
-  END DO !convect3
-
-  ! 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
-    END DO ! convect3
-  END DO ! convect3
-
-  ! tp and tvp below cloud base:
-
-  DO k = minorig, icbsmax2 - 1
-    DO 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)
-    END DO
-  END DO
-
-  ! ***  Find lifted parcel quantities above cloud base    ***
-
-  DO i = 1, len
-    tg = ticb(i)
-    ! ori         qg=qs(i,icb(i))
-    qg = qsicb(i) ! convect3
-    ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
-    alv = lv0 - clmcpv * (ticb(i) - 273.15)
-
-    ! First iteration.
-
-    ! 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
-    ! 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)
-    ! ori          tg=max(tg,35.0)
-    ! debug          tc=tg-t0
-    tc = tg - 273.15
-    denom = 243.5 + tc
-    denom = max(denom, 1.0) ! convect3
-    ! ori          IF(tc.ge.0.0)THEN
-    es = 6.112 * exp(17.67 * tc / denom)
-    ! ori          else
-    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-    ! ori          endif
-    ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-    qg = eps * es / (p(i, icbs(i)) - es * (1. - eps))
-
-    ! Second iteration.
-
-
-    ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-    ! ori          s=1./s
-    ! 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)
-    ! ori          tg=max(tg,35.0)
-    ! debug          tc=tg-t0
-    tc = tg - 273.15
-    denom = 243.5 + tc
-    denom = max(denom, 1.0) ! convect3
-    ! ori          IF(tc.ge.0.0)THEN
-    es = 6.112 * exp(17.67 * tc / denom)
-    ! ori          else
-    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-    ! ori          end if
-    ! 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)
-
-    ! ori c approximation here:
-    ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-    ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
-
-    ! convect3: no approximation:
-    tp(i, icbs(i)) = (ah0(i) - gz(i, icbs(i)) - alv * qg) / (cpd + (cl - cpd) * qnk(i))
-
-    ! ori         clw(i,icb(i))=qnk(i)-qg
-    ! 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))
-    ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-    ! 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
-
-  END DO
-
-  ! ori      do 380 k=minorig,icbsmax2
-  ! ori       do 370 i=1,len
-  ! ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
-  ! ori 370   continue
-  ! ori 380  continue
-
-
-  ! -- The following is only for convect3:
-
-  ! * icbs is the first level above the LCL:
-  ! if plcl<p(icb), then icbs=icb+1
-  ! if plcl>p(icb), then icbs=icb
-
-  ! * the routine above computes tvp from minorig to icbs (included).
-
-  ! * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
-  ! must be known. This is the case if icbs=icb+1, but not if icbs=icb.
-
-  ! * therefore, in the case icbs=icb, we compute tvp at level icb+1
-  ! (tvp at other levels will be computed in cv3_undilute2.F)
-
-  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)
-  END DO
-
-  DO i = 1, len
-    tg = ticb(i)
-    qg = qsicb(i) ! convect3
-    ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
-    alv = lv0 - clmcpv * (ticb(i) - 273.15)
-
-    ! First iteration.
-
-    ! 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
-    ! 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)
-    ! ori          tg=max(tg,35.0)
-    ! debug          tc=tg-t0
-    tc = tg - 273.15
-    denom = 243.5 + tc
-    denom = max(denom, 1.0) ! convect3
-    ! ori          IF(tc.ge.0.0)THEN
-    es = 6.112 * exp(17.67 * tc / denom)
-    ! ori          else
-    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-    ! ori          endif
-    ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-    qg = eps * es / (p(i, icb(i) + 1) - es * (1. - eps))
-
-    ! Second iteration.
-
-
-    ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-    ! ori          s=1./s
-    ! 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)
-    ! ori          tg=max(tg,35.0)
-    ! debug          tc=tg-t0
-    tc = tg - 273.15
-    denom = 243.5 + tc
-    denom = max(denom, 1.0) ! convect3
-    ! ori          IF(tc.ge.0.0)THEN
-    es = 6.112 * exp(17.67 * tc / denom)
-    ! ori          else
-    ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-    ! ori          end if
-    ! 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)
-
-    ! ori c approximation here:
-    ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-    ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
-
-    ! convect3: no approximation:
-    tp(i, icb(i) + 1) = (ah0(i) - gz(i, icb(i) + 1) - alv * qg) / (cpd + (cl - cpd) * qnk(i))
-
-    ! ori         clw(i,icb(i))=qnk(i)-qg
-    ! 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))
-    ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-    ! 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
-
-  END DO
-
-END SUBROUTINE cv30_undilute1
-
-SUBROUTINE cv30_trigger(len, nd, icb, plcl, p, th, tv, tvp, 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 "cv30param.h"
-
-  ! input:
-  INTEGER len, nd
-  INTEGER icb(len)
-  REAL plcl(len), p(len, nd)
-  REAL th(len, nd), tv(len, nd), tvp(len, nd)
-
-  ! output:
-  REAL pbase(len), buoybase(len)
-
-  ! input AND output:
-  INTEGER iflag(len)
-  REAL sig(len, nd), w0(len, nd)
-
-  ! local variables:
-  INTEGER i, k
-  REAL tvpbase, tvbase, tdif, ath, ath1
-
-
-  ! ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
-
-  DO 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
-  END DO
-
-
-  ! ***   make sure that column is dry adiabatic between the surface  ***
-  ! ***    and cloud base, and that lifted air is positively buoyant  ***
-  ! ***                         at cloud base                         ***
-  ! ***       if not, return to calling program after resetting       ***
-  ! ***                        sig(i) and w0(i)                       ***
-
-
-  ! oct3      do 200 i=1,len
-  ! oct3
-  ! oct3       tdif = buoybase(i)
-  ! oct3       ath1 = th(i,1)
-  ! oct3       ath  = th(i,icb(i)-1) - dttrig
-  ! oct3
-  ! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
-  ! oct3         do 60 k=1,nl
-  ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
-  ! oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
-  ! oct3            w0(i,k)  = beta*w0(i,k)
-  ! oct3   60    continue
-  ! oct3         iflag(i)=4 ! pour version vectorisee
-  ! oct3c convect3         iflag(i)=0
-  ! oct3cccc         RETURN
-  ! oct3       endif
-  ! oct3
-  ! oct3200   continue
-
-  ! -- oct3: on reecrit la boucle 200 (pour la vectorisation)
-
-  DO k = 1, nl
-    DO i = 1, len
-
-      tdif = buoybase(i)
-      ath1 = th(i, 1)
-      ath = th(i, icb(i) - 1) - dttrig
-
-      IF (tdif<dtcrit .OR. ath>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
-        ! convect3         iflag(i)=0
-      END IF
-
-    END DO
-  END DO
-
-  ! fin oct3 --
-
-END SUBROUTINE cv30_trigger
-
-SUBROUTINE cv30_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, &
-        iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, &
-        v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, w0)
-  USE lmdz_print_control, ONLY: lunout
-  USE lmdz_abort_physic, ONLY: abort_physic
-  IMPLICIT NONE
-
-  include "cv30param.h"
-
-  ! 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)
-
-  ! outputs:
-  ! 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)
-
-  ! local variables:
-  INTEGER i, k, nn, j
-
-  CHARACTER (LEN = 20) :: modname = 'cv30_compress'
-  CHARACTER (LEN = 80) :: abort_message
-
-  DO k = 1, nl + 1
+
     nn = 0
     DO i = 1, len
       IF (iflag1(i)==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)
+        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)
       END IF
     END DO
-  END DO
-
-  ! do 121 j=1,ntra
-  ! 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)
-  ! END IF
-  ! 101  continue
-  ! 111  continue
-  ! 121  continue
-
-  IF (nn/=ncum) THEN
-    WRITE (lunout, *) 'strange! nn not equal to ncum: ', nn, ncum
-    abort_message = ''
-    CALL abort_physic(modname, abort_message, 1)
-  END IF
-
-  nn = 0
-  DO i = 1, len
-    IF (iflag1(i)==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)
-    END IF
-  END DO
-
-END SUBROUTINE cv30_compress
-
-SUBROUTINE cv30_undilute2(nloc, ncum, nd, icb, icbs, nk, tnk, qnk, gznk, t, &
-        q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, &
-        ep, sigp, buoy)
-  ! epmax_cape: ajout arguments
-  USE lmdz_conema3
-
-  IMPLICIT NONE
-
-  ! ---------------------------------------------------------------------
-  ! Purpose:
-  ! 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
-
-  ! Main differences convect3/convect4:
-  ! - icbs (input) is the first level above LCL (may differ from icb)
-  ! - many minor differences in the iterations
-  ! - condensed water not removed from tvp in convect3
-  ! - vertical profile of buoyancy computed here (use of buoybase)
-  ! - the determination of inb is different
-  ! - no inb1, ONLY inb in output
-  ! ---------------------------------------------------------------------
-
-  include "cvthermo.h"
-  include "cv30param.h"
-
-  ! 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)
-
-  ! 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)
-
-  ! 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 k = 1, nl
-    DO i = 1, ncum
-      ep(i, k) = 0.0
-      sigp(i, k) = spfac
-    END DO
-  END DO
-
-  ! =====================================================================
-  ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-  ! =====================================================================
-
-  ! ---       The procedure is to solve the equation.
-  ! cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-
-  ! ***  Calculate certain parcel quantities, including static energy   ***
-
-  DO i = 1, ncum
-    ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) & ! debug     &
-            ! +qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
-            + qnk(i) * (lv0 - clmcpv * (tnk(i) - 273.15)) + gznk(i)
-  END DO
-
-
-  ! ***  Find lifted parcel quantities above cloud base    ***
-
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-      ! ori         IF(k.ge.(icb(i)+1))THEN
-      IF (k>=(icbs(i) + 1)) THEN ! convect3
-        tg = t(i, k)
-        qg = qs(i, k)
-        ! debug       alv=lv0-clmcpv*(t(i,k)-t0)
-        alv = lv0 - clmcpv * (t(i, k) - 273.15)
-
-        ! First iteration.
-
-        ! 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
-        ! 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)
-        ! ori          tg=max(tg,35.0)
-        ! debug        tc=tg-t0
-        tc = tg - 273.15
-        denom = 243.5 + tc
-        denom = max(denom, 1.0) ! convect3
-        ! ori          IF(tc.ge.0.0)THEN
-        es = 6.112 * exp(17.67 * tc / denom)
-        ! ori          else
-        ! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-        ! ori          endif
-        qg = eps * es / (p(i, k) - es * (1. - eps))
-
-        ! Second iteration.
-
-        ! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-        ! ori          s=1./s
-        ! 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)
-        ! ori          tg=max(tg,35.0)
-        ! debug        tc=tg-t0
-        tc = tg - 273.15
-        denom = 243.5 + tc
-        denom = max(denom, 1.0) ! convect3
-        ! ori          IF(tc.ge.0.0)THEN
-        es = 6.112 * exp(17.67 * tc / denom)
-        ! ori          else
-        ! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-        ! ori          endif
-        qg = eps * es / (p(i, k) - es * (1. - eps))
-
-        ! debug        alv=lv0-clmcpv*(t(i,k)-t0)
-        alv = lv0 - clmcpv * (t(i, k) - 273.15)
-        ! PRINT*,'cpd dans convect2 ',cpd
-        ! PRINT*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
-        ! PRINT*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
-
-        ! ori c approximation here:
-        ! ori
-        ! tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-
-        ! 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))
-        ! ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
-        ! convect3: (qg utilise au lieu du vrai mixing ratio rg):
-        tvp(i, k) = tp(i, k) * (1. + qg / eps - qnk(i)) ! whole thing
-      END IF
-    END DO
-  END DO
-
-  ! =====================================================================
-  ! --- 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)
-  ! =====================================================================
-
-  ! ori      do 320 k=minorig+1,nl
-  DO k = 1, nl ! convect3
-    DO 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
-      ! ori          IF(k.ge.(nk(i)+1))THEN
-      ! ori            tca=tp(i,k)-t0
-      ! ori            IF(tca.ge.0.0)THEN
-      ! ori              elacrit=elcrit
-      ! ori            else
-      ! ori              elacrit=elcrit*(1.0-tca/tlcrit)
-      ! ori            endif
-      ! ori            elacrit=max(elacrit,0.0)
-      ! ori            ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
-      ! ori            ep(i,k)=max(ep(i,k),0.0 )
-      ! ori            ep(i,k)=min(ep(i,k),1.0 )
-      ! ori            sigp(i,k)=sigs
-      ! ori          endif
-    END DO
-  END DO
-
-  ! =====================================================================
-  ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
-  ! --- VIRTUAL TEMPERATURE
-  ! =====================================================================
-
-  ! dans convect3, tvp est calcule en une seule fois, et sans retirer
-  ! l'eau condensee (~> reversible CAPE)
-
-  ! ori      do 340 k=minorig+1,nl
-  ! ori        do 330 i=1,ncum
-  ! ori        IF(k.ge.(icb(i)+1))THEN
-  ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
-  ! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
-  ! oric         PRINT*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
-  ! ori        endif
-  ! ori 330    continue
-  ! ori 340  continue
-
-  ! ori      do 350 i=1,ncum
-  ! ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
-  ! ori 350  continue
-
-  DO i = 1, ncum ! convect3
-    tp(i, nlp) = tp(i, nl) ! convect3
-  END DO ! convect3
-
-  ! =====================================================================
-  ! --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
-  ! =====================================================================
-
-  ! -- this is for convect3 only:
-
-  ! first estimate of buoyancy:
-
-  DO i = 1, ncum
-    DO k = 1, nl
-      buoy(i, k) = tvp(i, k) - tv(i, k)
-    END DO
-  END DO
-
-  ! set buoyancy=buoybase for all levels below base
-  ! for safety, set buoy(icb)=buoybase
-
-  DO i = 1, ncum
-    DO k = 1, nl
-      IF ((k>=icb(i)) .AND. (k<=nl) .AND. (p(i, k)>=pbase(i))) THEN
-        buoy(i, k) = buoybase(i)
-      END IF
-    END DO
-    ! IM cf. CRio/JYG 270807   buoy(icb(i),k)=buoybase(i)
-    buoy(i, icb(i)) = buoybase(i)
-  END DO
-
-  ! -- end convect3
-
-  ! =====================================================================
-  ! --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
-  ! --- LEVEL OF NEUTRAL BUOYANCY
-  ! =====================================================================
-
-  ! -- this is for convect3 only:
-
-  DO i = 1, ncum
-    inb(i) = nl - 1
-  END DO
-
-  DO i = 1, ncum
-    DO k = 1, nl - 1
-      IF ((k>=icb(i)) .AND. (buoy(i, k)<dtovsh)) THEN
-        inb(i) = min(inb(i), k)
-      END IF
-    END DO
-  END DO
-
-  ! -- end convect3
-
-  ! ori      do 510 i=1,ncum
-  ! ori        cape(i)=0.0
-  ! ori        capem(i)=0.0
-  ! ori        inb(i)=icb(i)+1
-  ! ori        inb1(i)=inb(i)
-  ! ori 510  continue
-
-  ! Originial Code
-
-  ! do 530 k=minorig+1,nl-1
-  ! do 520 i=1,ncum
-  ! IF(k.ge.(icb(i)+1))THEN
-  ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-  ! byp=(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)
-  ! END IF
-  ! END IF
-  ! 520    continue
-  ! 530  continue
-  ! do 540 i=1,ncum
-  ! byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
-  ! cape(i)=capem(i)+byp
-  ! 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
-
-  ! K Emanuel fix
-
-  ! CALL zilch(byp,ncum)
-  ! do 530 k=minorig+1,nl-1
-  ! do 520 i=1,ncum
-  ! IF(k.ge.(icb(i)+1))THEN
-  ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-  ! 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)
-  ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! END IF
-  ! END IF
-  ! 520    continue
-  ! 530  continue
-  ! do 540 i=1,ncum
-  ! inb(i)=max(inb(i),inb1(i))
-  ! 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
-
-  ! J Teixeira fix
-
-  ! ori      CALL zilch(byp,ncum)
-  ! ori      do 515 i=1,ncum
-  ! ori        lcape(i)=.TRUE.
-  ! ori 515  continue
-  ! ori      do 530 k=minorig+1,nl-1
-  ! ori        do 520 i=1,ncum
-  ! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
-  ! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
-  ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-  ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! ori            cape(i)=cape(i)+by
-  ! ori            IF(by.ge.0.0)inb1(i)=k+1
-  ! ori            IF(cape(i).gt.0.0)THEN
-  ! ori              inb(i)=k+1
-  ! ori              capem(i)=cape(i)
-  ! ori            endif
-  ! ori          endif
-  ! ori 520    continue
-  ! ori 530  continue
-  ! ori      do 540 i=1,ncum
-  ! ori          cape(i)=capem(i)+byp(i)
-  ! ori          defrac=capem(i)-cape(i)
-  ! ori          defrac=max(defrac,0.001)
-  ! ori          frac(i)=-cape(i)/defrac
-  ! ori          frac(i)=min(frac(i),1.0)
-  ! ori          frac(i)=max(frac(i),0.0)
-  ! ori 540  continue
-
-  ! =====================================================================
-  ! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
-  ! =====================================================================
-
-  ! ym      do i=1,ncum*nlp
-  ! ym       hp(i,1)=h(i,1)
-  ! ym      enddo
-
-  DO k = 1, nlp
-    DO i = 1, ncum
-      hp(i, k) = h(i, k)
-    END DO
-  END DO
-
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-      IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
-        hp(i, k) = h(i, nk(i)) + (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k &
-                )
-      END IF
-    END DO
-  END DO
-
-END SUBROUTINE cv30_undilute2
-
-SUBROUTINE cv30_closure(nloc, ncum, nd, icb, inb, pbase, p, ph, tv, buoy, &
-        sig, w0, cape, m)
-  IMPLICIT NONE
-
-  ! ===================================================================
-  ! ---  CLOSURE OF CONVECT3
-
-  ! vectorization: S. Bony
-  ! ===================================================================
-
-  include "cvthermo.h"
-  include "cv30param.h"
-
-  ! 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)
-
-  ! input/output:
-  REAL sig(nloc, nd), w0(nloc, nd)
-
-  ! output:
-  REAL cape(nloc)
-  REAL m(nloc, nd)
-
-  ! local variables:
-  INTEGER i, j, k, icbmax
-  REAL deltap, fac, w, amu
-  REAL dtmin(nloc, nd), sigold(nloc, nd)
-
-  ! -------------------------------------------------------
-  ! -- Initialization
-  ! -------------------------------------------------------
-
-  DO k = 1, nl
-    DO i = 1, ncum
-      m(i, k) = 0.0
-    END DO
-  END DO
-
-  ! -------------------------------------------------------
-  ! -- Reset sig(i) and w0(i) for i>inb and i<icb
-  ! -------------------------------------------------------
-
-  ! update sig and w0 above LNB:
-
-  DO k = 1, nl - 1
-    DO i = 1, ncum
-      IF ((inb(i)<(nl - 1)) .AND. (k>=(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)
-      END IF
-    END DO
-  END DO
-
-  ! compute icbmax:
-
-  icbmax = 2
-  DO i = 1, ncum
-    icbmax = max(icbmax, icb(i))
-  END DO
-
-  ! update sig and w0 below cloud base:
-
-  DO k = 1, icbmax
-    DO i = 1, ncum
-      IF (k<=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)
-      END IF
-    END DO
-  END DO
-
-  !      IF(inb.lt.(nl-1))THEN
-  !         do 85 i=inb+1,nl-1
-  !            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
-  !     1              abs(buoy(inb))
-  !            sig(i)=amax1(sig(i),0.0)
-  !            w0(i)=beta*w0(i)
-  !   85    continue
-  !      end if
-
-  !      do 87 i=1,icb
-  !         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
-  !         sig(i)=amax1(sig(i),0.0)
-  !         w0(i)=beta*w0(i)
-  !   87 continue
-
-  ! -------------------------------------------------------------
-  ! -- Reset fractional areas of updrafts and w0 at initial time
-  ! -- and after 10 time steps of no convection
-  ! -------------------------------------------------------------
-
-  DO k = 1, nl - 1
-    DO i = 1, ncum
-      IF (sig(i, nd)<1.5 .OR. sig(i, nd)>12.0) THEN
-        sig(i, k) = 0.0
-        w0(i, k) = 0.0
-      END IF
-    END DO
-  END DO
-
-  ! -------------------------------------------------------------
-  ! -- Calculate convective available potential energy (cape),
-  ! -- vertical velocity (w), fractional area covered by
-  ! -- undilute updraft (sig), and updraft mass flux (m)
-  ! -------------------------------------------------------------
-
-  DO i = 1, ncum
-    cape(i) = 0.0
-  END DO
-
-  ! compute dtmin (minimum buoyancy between ICB and given level k):
-
-  DO i = 1, ncum
-    DO k = 1, nl
-      dtmin(i, k) = 100.0
-    END DO
-  END DO
-
-  DO i = 1, ncum
-    DO k = 1, nl
-      DO j = minorig, nl
-        IF ((k>=(icb(i) + 1)) .AND. (k<=inb(i)) .AND. (j>=icb(i)) .AND. (j<=(k - &
-                1))) THEN
-          dtmin(i, k) = amin1(dtmin(i, k), buoy(i, j))
-        END IF
-      END DO
-    END DO
-  END DO
-
-  ! the interval on which cape is computed starts at pbase :
-  DO k = 1, nl
-    DO i = 1, ncum
-
-      IF ((k>=(icb(i) + 1)) .AND. (k<=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)
-
-        ! dtmin(i,k)=100.0
-        ! do 97 j=icb(i),k-1 ! mauvaise vectorisation
-        ! dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
-        ! 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
-      END IF
-
-    END DO
-  END DO
-
-  DO 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))
-  END DO
-
-
-  !      cape=0.0
-  !      do 98 i=icb+1,inb
-  !         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
-  !         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
-  !         dcape=rrd*buoy(i-1)*deltap/p(i-1)
-  !         dlnp=deltap/p(i-1)
-  !         cape=amax1(0.0,cape)
-  !         sigold=sig(i)
-
-  !         dtmin=100.0
-  !         do 97 j=icb,i-1
-  !            dtmin=amin1(dtmin,buoy(j))
-  !   97    continue
-
-  !         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
-  !         sig(i)=amax1(sig(i),0.0)
-  !         sig(i)=amin1(sig(i),0.01)
-  !         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
-  !         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
-  !         amu=0.5*(sig(i)+sigold)*w
-  !         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
-  !         w0(i)=w
-  !   98 continue
-  !      w0(icb)=0.5*w0(icb+1)
-  !      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
-  !      sig(icb)=sig(icb+1)
-  !      sig(icb-1)=sig(icb)
-
-END SUBROUTINE cv30_closure
-
-SUBROUTINE cv30_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 "cv30param.h"
-
-  ! 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
-
-  ! 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)
-
-  ! 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
-  REAL zm(nloc, na)
-  LOGICAL lwork(nloc)
-
-  ! =====================================================================
-  ! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-  ! =====================================================================
-
-  ! ori        do 360 i=1,ncum*nlp
-  DO j = 1, nl
-    DO i = 1, ncum
-      nent(i, j) = 0
-      ! in convect3, m is computed in cv3_closure
-      ! ori          m(i,1)=0.0
-    END DO
-  END DO
-
-  ! ori      do 400 k=1,nlp
-  ! ori       do 390 j=1,nlp
-  DO j = 1, nl
+
+  END SUBROUTINE cv30_compress
+
+  SUBROUTINE cv30_undilute2(nloc, ncum, nd, icb, icbs, nk, tnk, qnk, gznk, t, &
+          q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, &
+          ep, sigp, buoy)
+    ! epmax_cape: ajout arguments
+    USE lmdz_conema3
+    USE lmdz_cvthermo
+
+    IMPLICIT NONE
+
+    ! ---------------------------------------------------------------------
+    ! Purpose:
+    ! 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
+
+    ! Main differences convect3/convect4:
+    ! - icbs (input) is the first level above LCL (may differ from icb)
+    ! - many minor differences in the iterations
+    ! - condensed water not removed from tvp in convect3
+    ! - vertical profile of buoyancy computed here (use of buoybase)
+    ! - the determination of inb is different
+    ! - no inb1, ONLY inb in output
+    ! ---------------------------------------------------------------------
+
+
+
+    ! 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)
+
+    ! 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)
+
+    ! 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 k = 1, nl
       DO 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
-        ! ym            ment(i,k,j)=0.0
-        ! ym            sij(i,k,j)=0.0
-      END DO
-    END DO
-  END DO
-
-  ! ym
-  ment(1:ncum, 1:nd, 1:nd) = 0.0
-  sij(1:ncum, 1:nd, 1:nd) = 0.0
-
-  ! 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
-  zm(:, :) = 0.
-
-  ! =====================================================================
-  ! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
-  ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
-  ! --- FRACTION (sij)
-  ! =====================================================================
-
-  DO i = minorig + 1, nl
-
-    DO j = minorig, nl
+        ep(i, k) = 0.0
+        sigp(i, k) = spfac
+      END DO
+    END DO
+
+    ! =====================================================================
+    ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+    ! =====================================================================
+
+    ! ---       The procedure is to solve the equation.
+    ! cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+
+    ! ***  Calculate certain parcel quantities, including static energy   ***
+
+    DO i = 1, ncum
+      ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) & ! debug     &
+              ! +qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
+              + qnk(i) * (lv0 - clmcpv * (tnk(i) - 273.15)) + gznk(i)
+    END DO
+
+
+    ! ***  Find lifted parcel quantities above cloud base    ***
+
+    DO k = minorig + 1, nl
+      DO i = 1, ncum
+        ! ori       IF(k.ge.(icb(i)+1))THEN
+        IF (k>=(icbs(i) + 1)) THEN ! convect3
+          tg = t(i, k)
+          qg = qs(i, k)
+          ! debug             alv=lv0-clmcpv*(t(i,k)-t0)
+          alv = lv0 - clmcpv * (t(i, k) - 273.15)
+
+          ! First iteration.
+
+          ! 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
+          ! 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)
+          ! ori        tg=max(tg,35.0)
+          ! debug              tc=tg-t0
+          tc = tg - 273.15
+          denom = 243.5 + tc
+          denom = max(denom, 1.0) ! convect3
+          ! ori        IF(tc.ge.0.0)THEN
+          es = 6.112 * exp(17.67 * tc / denom)
+          ! ori        else
+          ! ori                 es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori        endif
+          qg = eps * es / (p(i, k) - es * (1. - eps))
+
+          ! Second iteration.
+
+          ! ori        s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+          ! ori        s=1./s
+          ! 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)
+          ! ori        tg=max(tg,35.0)
+          ! debug              tc=tg-t0
+          tc = tg - 273.15
+          denom = 243.5 + tc
+          denom = max(denom, 1.0) ! convect3
+          ! ori        IF(tc.ge.0.0)THEN
+          es = 6.112 * exp(17.67 * tc / denom)
+          ! ori        else
+          ! ori                 es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori        endif
+          qg = eps * es / (p(i, k) - es * (1. - eps))
+
+          ! debug              alv=lv0-clmcpv*(t(i,k)-t0)
+          alv = lv0 - clmcpv * (t(i, k) - 273.15)
+          ! PRINT*,'cpd dans convect2 ',cpd
+          ! PRINT*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
+          ! PRINT*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
+
+          ! ori c approximation here:
+          ! ori
+          ! tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
+
+          ! 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))
+          ! ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
+          ! convect3: (qg utilise au lieu du vrai mixing ratio rg):
+          tvp(i, k) = tp(i, k) * (1. + qg / eps - qnk(i)) ! whole thing
+        END IF
+      END DO
+    END DO
+
+    ! =====================================================================
+    ! --- 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)
+    ! =====================================================================
+
+    ! ori      do 320 k=minorig+1,nl
+    DO k = 1, nl ! convect3
+      DO 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
+        ! ori          IF(k.ge.(nk(i)+1))THEN
+        ! ori            tca=tp(i,k)-t0
+        ! ori            IF(tca.ge.0.0)THEN
+        ! ori              elacrit=elcrit
+        ! ori            else
+        ! ori              elacrit=elcrit*(1.0-tca/tlcrit)
+        ! ori            endif
+        ! ori            elacrit=max(elacrit,0.0)
+        ! ori            ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
+        ! ori            ep(i,k)=max(ep(i,k),0.0 )
+        ! ori            ep(i,k)=min(ep(i,k),1.0 )
+        ! ori            sigp(i,k)=sigs
+        ! ori          endif
+      END DO
+    END DO
+
+    ! =====================================================================
+    ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
+    ! --- VIRTUAL TEMPERATURE
+    ! =====================================================================
+
+    ! dans convect3, tvp est calcule en une seule fois, et sans retirer
+    ! l'eau condensee (~> reversible CAPE)
+
+    ! ori      do 340 k=minorig+1,nl
+    ! ori        do 330 i=1,ncum
+    ! ori        IF(k.ge.(icb(i)+1))THEN
+    ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
+    ! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
+    ! oric         PRINT*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
+    ! ori        endif
+    ! ori 330    continue
+    ! ori 340  continue
+
+    ! ori      do 350 i=1,ncum
+    ! ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
+    ! ori 350  continue
+
+    DO i = 1, ncum ! convect3
+      tp(i, nlp) = tp(i, nl) ! convect3
+    END DO ! convect3
+
+    ! =====================================================================
+    ! --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
+    ! =====================================================================
+
+    ! -- this is for convect3 only:
+
+    ! first estimate of buoyancy:
+
+    DO i = 1, ncum
+      DO k = 1, nl
+        buoy(i, k) = tvp(i, k) - tv(i, k)
+      END DO
+    END DO
+
+    ! set buoyancy=buoybase for all levels below base
+    ! for safety, set buoy(icb)=buoybase
+
+    DO i = 1, ncum
+      DO k = 1, nl
+        IF ((k>=icb(i)) .AND. (k<=nl) .AND. (p(i, k)>=pbase(i))) THEN
+          buoy(i, k) = buoybase(i)
+        END IF
+      END DO
+      ! IM cf. CRio/JYG 270807   buoy(icb(i),k)=buoybase(i)
+      buoy(i, icb(i)) = buoybase(i)
+    END DO
+
+    ! -- end convect3
+
+    ! =====================================================================
+    ! --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
+    ! --- LEVEL OF NEUTRAL BUOYANCY
+    ! =====================================================================
+
+    ! -- this is for convect3 only:
+
+    DO i = 1, ncum
+      inb(i) = nl - 1
+    END DO
+
+    DO i = 1, ncum
+      DO k = 1, nl - 1
+        IF ((k>=icb(i)) .AND. (buoy(i, k)<dtovsh)) THEN
+          inb(i) = min(inb(i), k)
+        END IF
+      END DO
+    END DO
+
+    ! -- end convect3
+
+    ! ori      do 510 i=1,ncum
+    ! ori        cape(i)=0.0
+    ! ori        capem(i)=0.0
+    ! ori        inb(i)=icb(i)+1
+    ! ori        inb1(i)=inb(i)
+    ! ori 510  continue
+
+    ! Originial Code
+
+    ! do 530 k=minorig+1,nl-1
+    ! do 520 i=1,ncum
+    ! IF(k.ge.(icb(i)+1))THEN
+    ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+    ! byp=(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)
+    ! END IF
+    ! END IF
+    ! 520    continue
+    ! 530  continue
+    ! do 540 i=1,ncum
+    ! byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
+    ! cape(i)=capem(i)+byp
+    ! 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
+
+    ! K Emanuel fix
+
+    ! CALL zilch(byp,ncum)
+    ! do 530 k=minorig+1,nl-1
+    ! do 520 i=1,ncum
+    ! IF(k.ge.(icb(i)+1))THEN
+    ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+    ! 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)
+    ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+    ! END IF
+    ! END IF
+    ! 520    continue
+    ! 530  continue
+    ! do 540 i=1,ncum
+    ! inb(i)=max(inb(i),inb1(i))
+    ! 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
+
+    ! J Teixeira fix
+
+    ! ori      CALL zilch(byp,ncum)
+    ! ori      do 515 i=1,ncum
+    ! ori        lcape(i)=.TRUE.
+    ! ori 515  continue
+    ! ori      do 530 k=minorig+1,nl-1
+    ! ori        do 520 i=1,ncum
+    ! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
+    ! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
+    ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+    ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+    ! ori            cape(i)=cape(i)+by
+    ! ori            IF(by.ge.0.0)inb1(i)=k+1
+    ! ori            IF(cape(i).gt.0.0)THEN
+    ! ori              inb(i)=k+1
+    ! ori              capem(i)=cape(i)
+    ! ori            endif
+    ! ori          endif
+    ! ori 520    continue
+    ! ori 530  continue
+    ! ori      do 540 i=1,ncum
+    ! ori          cape(i)=capem(i)+byp(i)
+    ! ori          defrac=capem(i)-cape(i)
+    ! ori          defrac=max(defrac,0.001)
+    ! ori          frac(i)=-cape(i)/defrac
+    ! ori          frac(i)=min(frac(i),1.0)
+    ! ori          frac(i)=max(frac(i),0.0)
+    ! ori 540  continue
+
+    ! =====================================================================
+    ! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
+    ! =====================================================================
+
+    ! ym      do i=1,ncum*nlp
+    ! ym       hp(i,1)=h(i,1)
+    ! ym      enddo
+
+    DO k = 1, nlp
+      DO i = 1, ncum
+        hp(i, k) = h(i, k)
+      END DO
+    END DO
+
+    DO k = minorig + 1, nl
+      DO i = 1, ncum
+        IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
+          hp(i, k) = h(i, nk(i)) + (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k &
+                  )
+        END IF
+      END DO
+    END DO
+
+  END SUBROUTINE cv30_undilute2
+
+  SUBROUTINE cv30_closure(nloc, ncum, nd, icb, inb, pbase, p, ph, tv, buoy, &
+          sig, w0, cape, m)
+    USE lmdz_cvthermo
+
+    IMPLICIT NONE
+
+    ! ===================================================================
+    ! ---  CLOSURE OF CONVECT3
+
+    ! vectorization: S. Bony
+    ! ===================================================================
+
+
+
+    ! 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)
+
+    ! input/output:
+    REAL sig(nloc, nd), w0(nloc, nd)
+
+    ! output:
+    REAL cape(nloc)
+    REAL m(nloc, nd)
+
+    ! local variables:
+    INTEGER i, j, k, icbmax
+    REAL deltap, fac, w, amu
+    REAL dtmin(nloc, nd), sigold(nloc, nd)
+
+    ! -------------------------------------------------------
+    ! -- Initialization
+    ! -------------------------------------------------------
+
+    DO k = 1, nl
+      DO i = 1, ncum
+        m(i, k) = 0.0
+      END DO
+    END DO
+
+    ! -------------------------------------------------------
+    ! -- Reset sig(i) and w0(i) for i>inb and i<icb
+    ! -------------------------------------------------------
+
+    ! update sig and w0 above LNB:
+
+    DO k = 1, nl - 1
+      DO i = 1, ncum
+        IF ((inb(i)<(nl - 1)) .AND. (k>=(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)
+        END IF
+      END DO
+    END DO
+
+    ! compute icbmax:
+
+    icbmax = 2
+    DO i = 1, ncum
+      icbmax = max(icbmax, icb(i))
+    END DO
+
+    ! update sig and w0 below cloud base:
+
+    DO k = 1, icbmax
+      DO i = 1, ncum
+        IF (k<=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)
+        END IF
+      END DO
+    END DO
+
+    !      IF(inb.lt.(nl-1))THEN
+    !         do 85 i=inb+1,nl-1
+    !            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
+    !     1              abs(buoy(inb))
+    !            sig(i)=amax1(sig(i),0.0)
+    !            w0(i)=beta*w0(i)
+    !   85    continue
+    !      end if
+
+    !      do 87 i=1,icb
+    !         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
+    !         sig(i)=amax1(sig(i),0.0)
+    !         w0(i)=beta*w0(i)
+    !   87 continue
+
+    ! -------------------------------------------------------------
+    ! -- Reset fractional areas of updrafts and w0 at initial time
+    ! -- and after 10 time steps of no convection
+    ! -------------------------------------------------------------
+
+    DO k = 1, nl - 1
+      DO i = 1, ncum
+        IF (sig(i, nd)<1.5 .OR. sig(i, nd)>12.0) THEN
+          sig(i, k) = 0.0
+          w0(i, k) = 0.0
+        END IF
+      END DO
+    END DO
+
+    ! -------------------------------------------------------------
+    ! -- Calculate convective available potential energy (cape),
+    ! -- vertical velocity (w), fractional area covered by
+    ! -- undilute updraft (sig), and updraft mass flux (m)
+    ! -------------------------------------------------------------
+
+    DO i = 1, ncum
+      cape(i) = 0.0
+    END DO
+
+    ! compute dtmin (minimum buoyancy between ICB and given level k):
+
+    DO i = 1, ncum
+      DO k = 1, nl
+        dtmin(i, k) = 100.0
+      END DO
+    END DO
+
+    DO i = 1, ncum
+      DO k = 1, nl
+        DO j = minorig, nl
+          IF ((k>=(icb(i) + 1)) .AND. (k<=inb(i)) .AND. (j>=icb(i)) .AND. (j<=(k - &
+                  1))) THEN
+            dtmin(i, k) = amin1(dtmin(i, k), buoy(i, j))
+          END IF
+        END DO
+      END DO
+    END DO
+
+    ! the interval on which cape is computed starts at pbase :
+    DO k = 1, nl
+      DO i = 1, ncum
+
+        IF ((k>=(icb(i) + 1)) .AND. (k<=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)
+
+          ! dtmin(i,k)=100.0
+          ! do 97 j=icb(i),k-1 ! mauvaise vectorisation
+          ! dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
+          ! 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
+        END IF
+
+      END DO
+    END DO
+
+    DO 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))
+    END DO
+
+
+    !      cape=0.0
+    !      do 98 i=icb+1,inb
+    !         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
+    !         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
+    !         dcape=rrd*buoy(i-1)*deltap/p(i-1)
+    !         dlnp=deltap/p(i-1)
+    !         cape=amax1(0.0,cape)
+    !         sigold=sig(i)
+
+    !         dtmin=100.0
+    !         do 97 j=icb,i-1
+    !            dtmin=amin1(dtmin,buoy(j))
+    !   97    continue
+
+    !         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
+    !         sig(i)=amax1(sig(i),0.0)
+    !         sig(i)=amin1(sig(i),0.01)
+    !         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
+    !         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
+    !         amu=0.5*(sig(i)+sigold)*w
+    !         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
+    !         w0(i)=w
+    !   98 continue
+    !      w0(icb)=0.5*w0(icb+1)
+    !      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
+    !      sig(icb)=sig(icb+1)
+    !      sig(icb-1)=sig(icb)
+
+  END SUBROUTINE cv30_closure
+
+  SUBROUTINE cv30_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)
+    USE lmdz_cvthermo
+
+    IMPLICIT NONE
+
+    ! ---------------------------------------------------------------------
+    ! a faire:
+    ! - changer rr(il,1) -> qnk(il)
+    ! - vectorisation de la partie normalisation des flux (do 789...)
+    ! ---------------------------------------------------------------------
+
+
+
+    ! 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
+
+    ! 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)
+
+    ! 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
+    REAL zm(nloc, na)
+    LOGICAL lwork(nloc)
+
+    ! =====================================================================
+    ! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
+    ! =====================================================================
+
+    ! ori        do 360 i=1,ncum*nlp
+    DO j = 1, nl
+      DO i = 1, ncum
+        nent(i, j) = 0
+        ! in convect3, m is computed in cv3_closure
+        ! ori          m(i,1)=0.0
+      END DO
+    END DO
+
+    ! ori      do 400 k=1,nlp
+    ! ori       do 390 j=1,nlp
+    DO j = 1, nl
+      DO k = 1, nl
+        DO 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
+          ! ym            ment(i,k,j)=0.0
+          ! ym            sij(i,k,j)=0.0
+        END DO
+      END DO
+    END DO
+
+    ! ym
+    ment(1:ncum, 1:nd, 1:nd) = 0.0
+    sij(1:ncum, 1:nd, 1:nd) = 0.0
+
+    ! 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
+    zm(:, :) = 0.
+
+    ! =====================================================================
+    ! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
+    ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
+    ! --- FRACTION (sij)
+    ! =====================================================================
+
+    DO i = minorig + 1, nl
+
+      DO j = minorig, nl
+        DO il = 1, ncum
+          IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il) - &
+                  1)) .AND. (j<=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)<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<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>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)<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)>0.0 .AND. sij(il, i, j)<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))
+              ! !!!      do k=1,ntra
+              ! !!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+              ! !!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
+              ! !!!      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))
+          END IF ! new
+        END DO
+      END DO
+
+      ! 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)
+      ! END IF
+      ! enddo
+      ! enddo
+      ! enddo
+
+
+      ! ***   if no air can entrain at level i assume that updraft detrains
+      ! ***
+      ! ***   at that level and calculate detrained air flux and properties
+      ! ***
+
+
+      ! @      do 170 i=icb(il),inb(il)
+
       DO il = 1, ncum
-        IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il) - &
-                1)) .AND. (j<=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)<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<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>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)<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)>0.0 .AND. sij(il, i, j)<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))
-            ! !!!      do k=1,ntra
-            ! !!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
-            ! !!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
-            ! !!!      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))
-        END IF ! new
-      END DO
-    END DO
-
-    ! do k=1,ntra
-    ! do j=minorig,nl
+        IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il, i)==0)) THEN
+          ! @      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)
+          ! MAF      sij(il,i,i)=1.0
+          sij(il, i, i) = 0.0
+        END IF
+      END DO
+    END DO
+
+    ! do j=1,ntra
+    ! do i=minorig+1,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)
+    ! 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)
     ! END IF
     ! enddo
@@ -1561 +1620 @@
     ! enddo
 
-
-    ! ***   if no air can entrain at level i assume that updraft detrains
-    ! ***
-    ! ***   at that level and calculate detrained air flux and properties
-    ! ***
-
-
-    ! @      do 170 i=icb(il),inb(il)
+    DO j = minorig, nl
+      DO i = minorig, nl
+        DO il = 1, ncum
+          IF ((j>=(icb(il) - 1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<= &
+                  inb(il))) THEN
+            sigij(il, i, j) = sij(il, i, j)
+          END IF
+        END DO
+      END DO
+    END DO
+    ! @      enddo
+
+    ! @170   continue
+
+    ! =====================================================================
+    ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
+    ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
+    ! =====================================================================
+
+    ! ym      CALL zilch(asum,ncum*nd)
+    ! ym      CALL zilch(bsum,ncum*nd)
+    ! ym      CALL zilch(csum,ncum*nd)
+    CALL zilch(asum, nloc * nd)
+    CALL zilch(csum, nloc * nd)
+    CALL zilch(csum, nloc * nd)
 
     DO il = 1, ncum
-      IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il, i)==0)) THEN
-        ! @      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)
-        ! MAF      sij(il,i,i)=1.0
-        sij(il, i, i) = 0.0
-      END IF
-    END DO
-  END DO
-
-  ! 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)
-  ! END IF
-  ! enddo
-  ! enddo
-  ! enddo
-
-  DO j = minorig, nl
-    DO i = minorig, nl
+      lwork(il) = .FALSE.
+    END DO
+
+    DO i = minorig + 1, nl
+
+      num1 = 0
       DO il = 1, ncum
-        IF ((j>=(icb(il) - 1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<= &
-                inb(il))) THEN
-          sigij(il, i, j) = sij(il, i, j)
+        IF (i>=icb(il) .AND. i<=inb(il)) num1 = num1 + 1
+      END DO
+      IF (num1<=0) GO TO 789
+
+      DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il)) THEN
+          lwork(il) = (nent(il, i)/=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)<0.01) denom = 0.01
+          scrit(il) = anum / denom
+          alt = qp - rs(il, i) + scrit(il) * (rr(il, i) - qp)
+          IF (scrit(il)<=0.0 .OR. alt<=0.0) scrit(il) = 1.0
+          smax(il) = 0.0
+          asij(il) = 0.0
         END IF
       END DO
-    END DO
-  END DO
-  ! @      enddo
-
-  ! @170   continue
-
-  ! =====================================================================
-  ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
-  ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
-  ! =====================================================================
-
-  ! ym      CALL zilch(asum,ncum*nd)
-  ! ym      CALL zilch(bsum,ncum*nd)
-  ! ym      CALL zilch(csum,ncum*nd)
-  CALL zilch(asum, nloc * nd)
-  CALL zilch(csum, nloc * nd)
-  CALL zilch(csum, nloc * nd)
-
-  DO il = 1, ncum
-    lwork(il) = .FALSE.
-  END DO
-
-  DO i = minorig + 1, nl
-
-    num1 = 0
+
+      DO j = nl, minorig, -1
+
+        num2 = 0
+        DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb(&
+                  il) - 1) .AND. j<=inb(il) .AND. lwork(il)) num2 = num2 + 1
+        END DO
+        IF (num2<=0) GO TO 175
+
+        DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb(&
+                  il) - 1) .AND. j<=inb(il) .AND. lwork(il)) THEN
+
+            IF (sij(il, i, j)>1.0E-16 .AND. sij(il, i, j)<0.95) THEN
+              wgh = 1.0
+              IF (j>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)<(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>1) sjmin = sij(il, i, j - 1)
+                sjmin = amax1(sjmin, scrit(il))
+              END IF
+              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
+            END IF
+          END IF
+        END DO
+
+      175 END DO
+
+      DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=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
+        END IF
+      END DO
+
+      DO j = minorig, nl
+        DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
+                  il) - 1) .AND. j<=inb(il)) THEN
+            ment(il, i, j) = ment(il, i, j) * asij(il)
+          END IF
+        END DO
+      END DO
+
+      DO j = minorig, nl
+        DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
+                  il) - 1) .AND. j<=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)
+          END IF
+        END DO
+      END DO
+
+      DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
+          bsum(il, i) = amax1(bsum(il, i), 1.0E-16)
+          bsum(il, i) = 1.0 / bsum(il, i)
+        END IF
+      END DO
+
+      DO j = minorig, nl
+        DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
+                  il) - 1) .AND. j<=inb(il)) THEN
+            ment(il, i, j) = ment(il, i, j) * asum(il, i) * bsum(il, i)
+          END IF
+        END DO
+      END DO
+
+      DO j = minorig, nl
+        DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
+                  il) - 1) .AND. j<=inb(il)) THEN
+            csum(il, i) = csum(il, i) + ment(il, i, j)
+          END IF
+        END DO
+      END DO
+
+      DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
+                csum(il, i)<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)
+          ! MAF        sij(il,i,i)=1.0
+          sij(il, i, i) = 0.0
+        END IF
+      END DO ! 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)
+      ! END IF
+      ! enddo
+      ! enddo
+    789 END DO
+
+    ! MAF: renormalisation de MENT
+    DO jm = 1, nd
+      DO im = 1, nd
+        DO il = 1, ncum
+          zm(il, im) = zm(il, im) + (1. - sij(il, im, jm)) * ment(il, im, jm)
+        END DO
+      END DO
+    END DO
+
+    DO jm = 1, nd
+      DO im = 1, nd
+        DO il = 1, ncum
+          IF (zm(il, im)/=0.) THEN
+            ment(il, im, jm) = ment(il, im, jm) * m(il, im) / zm(il, im)
+          END IF
+        END DO
+      END DO
+    END DO
+
+    DO jm = 1, nd
+      DO im = 1, nd
+        DO il = 1, ncum
+          qents(il, im, jm) = qent(il, im, jm)
+          ments(il, im, jm) = ment(il, im, jm)
+        END DO
+      END DO
+    END DO
+
+  END SUBROUTINE cv30_mixing
+
+
+  SUBROUTINE cv30_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 & ! RomP-jyg
+          , wdtraina, wdtrainm) ! 26/08/10  RomP-jyg
+    USE lmdz_cvflag
+    USE lmdz_cvthermo
+
+    IMPLICIT NONE
+
+
+
+    ! 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)
+
+    ! 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)
+    ! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
+    ! lascendance adiabatique et des flux melanges Pa et Pm.
+    ! Distinction des wdtrain
+    ! Pa = wdtrainA     Pm = wdtrainM
+    REAL wdtraina(nloc, na), wdtrainm(nloc, na)
+
+    ! 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)
+
+
+    ! ------------------------------------------------------
+
+    delti = 1. / delt
+    tinv = 1. / 3.
+
+    mp(:, :) = 0.
+
+    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)
+      END DO
+    END DO
+
+    ! do k=1,ntra
+    ! do i=1,nd
+    ! do il=1,ncum
+    ! trap(il,i,k)=tra(il,i,k)
+    ! enddo
+    ! enddo
+    ! enddo
+    ! RomP >>>
+    DO i = 1, nd
+      DO il = 1, ncum
+        wdtraina(il, i) = 0.0
+        wdtrainm(il, i) = 0.0
+      END DO
+    END DO
+    ! RomP <<<
+
+    ! ***  check whether ep(inb)=0, if so, skip precipitating    ***
+    ! ***             downdraft calculation                      ***
+
     DO il = 1, ncum
-      IF (i>=icb(il) .AND. i<=inb(il)) num1 = num1 + 1
-    END DO
-    IF (num1<=0) GO TO 789
-
-    DO il = 1, ncum
-      IF (i>=icb(il) .AND. i<=inb(il)) THEN
-        lwork(il) = (nent(il, i)/=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)<0.01) denom = 0.01
-        scrit(il) = anum / denom
-        alt = qp - rs(il, i) + scrit(il) * (rr(il, i) - qp)
-        IF (scrit(il)<=0.0 .OR. alt<=0.0) scrit(il) = 1.0
-        smax(il) = 0.0
-        asij(il) = 0.0
-      END IF
-    END DO
-
-    DO j = nl, minorig, -1
-
-      num2 = 0
+      lwork(il) = .TRUE.
+      IF (ep(il, inb(il))<0.0001) lwork(il) = .FALSE.
+    END DO
+
+    CALL zilch(wdtrain, ncum)
+
+    DO i = nl + 1, 1, -1
+
+      num1 = 0
       DO il = 1, ncum
-        IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb(&
-                il) - 1) .AND. j<=inb(il) .AND. lwork(il)) num2 = num2 + 1
-      END DO
-      IF (num2<=0) GO TO 175
+        IF (i<=inb(il) .AND. lwork(il)) num1 = num1 + 1
+      END DO
+      IF (num1<=0) GO TO 400
+
+
+      ! ***  integrate liquid water equation to find condensed water   ***
+      ! ***                and condensed water flux                    ***
+
+
+
+      ! ***                    begin downdraft loop                    ***
+
+
+
+      ! ***              calculate detrained precipitation             ***
 
       DO il = 1, ncum
-        IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb(&
-                il) - 1) .AND. j<=inb(il) .AND. lwork(il)) THEN
-
-          IF (sij(il, i, j)>1.0E-16 .AND. sij(il, i, j)<0.95) THEN
-            wgh = 1.0
-            IF (j>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)<(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>1) sjmin = sij(il, i, j - 1)
-              sjmin = amax1(sjmin, scrit(il))
-            END IF
-            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
+        IF (i<=inb(il) .AND. lwork(il)) THEN
+          IF (cvflag_grav) THEN
+            wdtrain(il) = grav * ep(il, i) * m(il, i) * clw(il, i)
+            wdtraina(il, i) = wdtrain(il) / grav !   Pa  26/08/10   RomP
+          ELSE
+            wdtrain(il) = 10.0 * ep(il, i) * m(il, i) * clw(il, i)
+            wdtraina(il, i) = wdtrain(il) / 10. !   Pa  26/08/10   RomP
           END IF
         END IF
       END DO
 
-    175 END DO
+      IF (i>1) THEN
+
+        DO j = 1, i - 1
+          DO il = 1, ncum
+            IF (i<=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)
+              END IF
+            END IF
+          END DO
+        END DO
+        DO il = 1, ncum
+          IF (cvflag_grav) THEN
+            wdtrainm(il, i) = wdtrain(il) / grav - wdtraina(il, i) !   Pm  26/08/10   RomP
+          ELSE
+            wdtrainm(il, i) = wdtrain(il) / 10. - wdtraina(il, i) !   Pm  26/08/10   RomP
+          END IF
+        END DO
+
+      END IF
+
+
+      ! ***    find rain water and evaporation using provisional   ***
+      ! ***              estimates of rp(i)and rp(i-1)             ***
+
+      DO il = 1, ncum
+
+        IF (i<=inb(il) .AND. lwork(il)) THEN
+
+          wt(il, i) = 45.0
+
+          IF (i<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))
+          END IF
+          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==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)
+          END IF
+          IF (i==inb(il)) afac = 0.0
+          afac = amax1(afac, 0.0)
+          bfac = 1. / (sigd * wt(il, i))
+
+          ! jyg1
+          ! cc        sigt=1.0
+          ! cc        IF(i.ge.icb)sigt=sigp(i)
+          ! prise en compte de la variation progressive de sigt dans
+          ! les couches icb et icb-1:
+          ! pour plcl<ph(i+1), pr1=0 & pr2=1
+          ! pour plcl>ph(i),   pr1=1 & pr2=0
+          ! pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
+          ! sur le nuage, et pr2 est la proportion sous la base du
+          ! 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
+          ! jyg2
+
+          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>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
+
+          ! ***  calculate precipitating downdraft mass flux under     ***
+          ! ***              hydrostatic approximation                 ***
+
+          IF (i/=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
+            END IF
+
+            ! ***           if hydrostatic assumption fails,             ***
+            ! ***   solve cubic difference equation for downdraft theta  ***
+            ! ***  and mass flux from two simultaneous differential eqns ***
+
+            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>(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<0.0) fac2 = -1.0
+              bf = abs(bf)
+              ur = 0.25 * bf * bf - af * af * af * tinv * tinv * tinv
+              IF (ur>=0.0) THEN
+                sru = sqrt(ur)
+                fac = 1.0
+                IF ((0.5 * bf - sru)<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<0.0) d = 3.14159 - d
+                mp(il, i) = mp(il, i + 1) * tinv + 2. * sqrt(af * tinv) * cos(d * tinv)
+              END IF
+              mp(il, i) = amax1(0.0, mp(il, i))
+
+              IF (cvflag_grav) THEN
+                ! jyg : il y a vraisemblablement une erreur dans la ligne 2
+                ! suivante:
+                ! il faut diviser par (mp(il,i)*sigd*grav) et non par
+                ! (mp(il,i)+sigd*0.1).
+                ! 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 / (mp(il, &
+                        i) + sigd * 0.1) - 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 / (mp(il, &
+                        i) + sigd * 0.1) - 10.0 * (th(il, i) - th(il, i - 1)) * t(il, i) / (lvcp(il, i &
+                        ) * sigd * th(il, i))
+              END IF
+              b(il, i - 1) = amax1(b(il, i - 1), 0.0)
+            END IF
+
+            ! ***         limit magnitude of mp(i) to meet cfl condition
+            ! ***
+
+            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)
+
+            ! ***      force mp to decrease linearly to zero
+            ! ***
+            ! ***       between cloud base and the surface
+            ! ***
+
+            IF (p(il, i)>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)))
+            END IF
+
+          END IF ! i.EQ.1
+
+          ! ***       find mixing ratio of precipitating downdraft     ***
+
+          IF (i/=inb(il)) THEN
+
+            rp(il, i) = rr(il, i)
+
+            IF (mp(il, i)>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))
+              END IF
+              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)
+              ! testmaf     :            +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
+              ! :            +tra(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)>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)
+                END IF
+                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
+
+              END IF
+            END IF
+            rp(il, i) = amin1(rp(il, i), rs(il, i))
+            rp(il, i) = amax1(rp(il, i), 0.0)
+
+          END IF
+        END IF
+      END DO
+
+    400 END DO
+
+  END SUBROUTINE cv30_unsat
+
+  SUBROUTINE cv30_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, vprecip, ft, fr, fu, fv, ftra, upwd, dnwd, dnwd0, ma, &
+          mike, tls, tps, qcondc, wd)
+    USE lmdz_conema3
+    USE lmdz_cvflag
+    USE lmdz_cvthermo
+
+    IMPLICIT NONE
+
+    ! 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)
+    ! ym      real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
+    REAL vent(nloc, na, na), elij(nloc, na, na)
+    INTEGER nent(nloc, na)
+    REAL traent(nloc, na, na, ntra)
+    REAL tv(nloc, nd), tvp(nloc, nd)
+
+    ! input/output:
+    INTEGER iflag(nloc)
+
+    ! outputs:
+    REAL precip(nloc)
+    REAL vprecip(nloc, nd + 1)
+    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
+
+    ! 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)
+    ! !!      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
+
+
+    ! -------------------------------------------------------------
+
+    ! initialization:
+
+    delti = 1.0 / delt
 
     DO il = 1, ncum
-      IF (i>=icb(il) .AND. i<=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
+      precip(il) = 0.0
+      wd(il) = 0.0 ! gust
+      vprecip(il, nd + 1) = 0.
+    END DO
+
+    DO i = 1, nd
+      DO il = 1, ncum
+        vprecip(il, i) = 0.0
+        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
+      END DO
+    END DO
+
+    ! 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)
+      END DO
+    END DO
+
+
+
+    ! ***  calculate surface precipitation in mm/day     ***
+
+    DO il = 1, ncum
+      IF (ep(il, inb(il))>=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.
+        END IF
       END IF
     END DO
 
-    DO j = minorig, nl
+    ! ***  CALCULATE VERTICAL PROFILE OF  PRECIPITATIONs IN kg/m2/s  ===
+
+    ! MAF rajout pour lessivage
+    DO k = 1, nl
       DO il = 1, ncum
-        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
-                il) - 1) .AND. j<=inb(il)) THEN
-          ment(il, i, j) = ment(il, i, j) * asij(il)
+        IF (k<=inb(il)) THEN
+          IF (cvflag_grav) THEN
+            vprecip(il, k) = wt(il, k) * sigd * water(il, k) / grav
+          ELSE
+            vprecip(il, k) = wt(il, k) * sigd * water(il, k) / 10.
+          END IF
         END IF
       END DO
     END DO
 
-    DO j = minorig, nl
+
+    ! ***  Calculate downdraft velocity scale    ***
+    ! ***  NE PAS UTILISER POUR L'INSTANT ***
+
+    !      do il=1,ncum
+    !        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il))
+    !     :                                  /(sigd*p(il,icb(il)))
+    !      enddo
+
+
+    ! ***  calculate tendencies of lowest level potential temperature  ***
+    ! ***                      and mixing ratio                        ***
+
+    DO il = 1, ncum
+      work(il) = 1.0 / (ph(il, 1) - ph(il, 2))
+      am(il) = 0.0
+    END DO
+
+    DO k = 2, nl
       DO il = 1, ncum
-        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
-                il) - 1) .AND. j<=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)
+        IF (k<=inb(il)) THEN
+          am(il) = am(il) + m(il, k)
         END IF
       END DO
@@ -1720 +2339 @@
 
     DO il = 1, ncum
-      IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
-        bsum(il, i) = amax1(bsum(il, i), 1.0E-16)
-        bsum(il, i) = 1.0 / bsum(il, i)
+
+      ! convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
+      IF (cvflag_grav) THEN
+        IF ((0.01 * grav * work(il) * am(il))>=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))>=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))
       END IF
-    END DO
-
-    DO j = minorig, nl
-      DO il = 1, ncum
-        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
-                il) - 1) .AND. j<=inb(il)) THEN
-          ment(il, i, j) = ment(il, i, j) * asum(il, i) * bsum(il, i)
-        END IF
-      END DO
-    END DO
-
-    DO j = minorig, nl
-      DO il = 1, ncum
-        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb(&
-                il) - 1) .AND. j<=inb(il)) THEN
-          csum(il, i) = csum(il, i) + ment(il, i, j)
-        END IF
-      END DO
-    END DO
-
-    DO il = 1, ncum
-      IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
-              csum(il, i)<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)
-        ! MAF        sij(il,i,i)=1.0
-        sij(il, i, i) = 0.0
+
+      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)
       END IF
+
+      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
+        ! jyg1  Correction pour mieux conserver l'eau (conformite avec
+        ! CONVECT4.3)
+        ! (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))
+        ! +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)))
+      END IF ! cvflag_grav
+
     END DO ! 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)
+    ! 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)))
     ! END IF
     ! enddo
     ! enddo
-  789 END DO
-
-  ! MAF: renormalisation de MENT
-  DO jm = 1, nd
-    DO im = 1, nd
+
+    DO j = 2, nl
       DO il = 1, ncum
-        zm(il, im) = zm(il, im) + (1. - sij(il, im, jm)) * ment(il, im, jm)
-      END DO
-    END DO
-  END DO
-
-  DO jm = 1, nd
-    DO im = 1, nd
-      DO il = 1, ncum
-        IF (zm(il, im)/=0.) THEN
-          ment(il, im, jm) = ment(il, im, jm) * m(il, im) / zm(il, im)
-        END IF
-      END DO
-    END DO
-  END DO
-
-  DO jm = 1, nd
-    DO im = 1, nd
-      DO il = 1, ncum
-        qents(il, im, jm) = qent(il, im, jm)
-        ments(il, im, jm) = ment(il, im, jm)
-      END DO
-    END DO
-  END DO
-
-END SUBROUTINE cv30_mixing
-
-
-SUBROUTINE cv30_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 & ! RomP-jyg
-        , wdtraina, wdtrainm) ! 26/08/10  RomP-jyg
-  USE lmdz_cvflag
-
-  IMPLICIT NONE
-
-  include "cvthermo.h"
-  include "cv30param.h"
-
-  ! 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)
-
-  ! 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)
-  ! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
-  ! lascendance adiabatique et des flux melanges Pa et Pm.
-  ! Distinction des wdtrain
-  ! Pa = wdtrainA     Pm = wdtrainM
-  REAL wdtraina(nloc, na), wdtrainm(nloc, na)
-
-  ! 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)
-
-
-  ! ------------------------------------------------------
-
-  delti = 1. / delt
-  tinv = 1. / 3.
-
-  mp(:, :) = 0.
-
-  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)
-    END DO
-  END DO
-
-  ! do k=1,ntra
-  ! do i=1,nd
-  ! do il=1,ncum
-  ! trap(il,i,k)=tra(il,i,k)
-  ! enddo
-  ! enddo
-  ! enddo
-  ! RomP >>>
-  DO i = 1, nd
-    DO il = 1, ncum
-      wdtraina(il, i) = 0.0
-      wdtrainm(il, i) = 0.0
-    END DO
-  END DO
-  ! RomP <<<
-
-  ! ***  check whether ep(inb)=0, if so, skip precipitating    ***
-  ! ***             downdraft calculation                      ***
-
-  DO il = 1, ncum
-    lwork(il) = .TRUE.
-    IF (ep(il, inb(il))<0.0001) lwork(il) = .FALSE.
-  END DO
-
-  CALL zilch(wdtrain, ncum)
-
-  DO i = nl + 1, 1, -1
-
-    num1 = 0
-    DO il = 1, ncum
-      IF (i<=inb(il) .AND. lwork(il)) num1 = num1 + 1
-    END DO
-    IF (num1<=0) GO TO 400
-
-
-    ! ***  integrate liquid water equation to find condensed water   ***
-    ! ***                and condensed water flux                    ***
-
-
-
-    ! ***                    begin downdraft loop                    ***
-
-
-
-    ! ***              calculate detrained precipitation             ***
-
-    DO il = 1, ncum
-      IF (i<=inb(il) .AND. lwork(il)) THEN
-        IF (cvflag_grav) THEN
-          wdtrain(il) = grav * ep(il, i) * m(il, i) * clw(il, i)
-          wdtraina(il, i) = wdtrain(il) / grav !   Pa  26/08/10   RomP
-        ELSE
-          wdtrain(il) = 10.0 * ep(il, i) * m(il, i) * clw(il, i)
-          wdtraina(il, i) = wdtrain(il) / 10. !   Pa  26/08/10   RomP
-        END IF
-      END IF
-    END DO
-
-    IF (i>1) THEN
-
-      DO j = 1, i - 1
-        DO il = 1, ncum
-          IF (i<=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)
-            END IF
-          END IF
-        END DO
-      END DO
-      DO il = 1, ncum
-        IF (cvflag_grav) THEN
-          wdtrainm(il, i) = wdtrain(il) / grav - wdtraina(il, i) !   Pm  26/08/10   RomP
-        ELSE
-          wdtrainm(il, i) = wdtrain(il) / 10. - wdtraina(il, i) !   Pm  26/08/10   RomP
-        END IF
-      END DO
-
-    END IF
-
-
-    ! ***    find rain water and evaporation using provisional   ***
-    ! ***              estimates of rp(i)and rp(i-1)             ***
-
-    DO il = 1, ncum
-
-      IF (i<=inb(il) .AND. lwork(il)) THEN
-
-        wt(il, i) = 45.0
-
-        IF (i<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))
-        END IF
-        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==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)
-        END IF
-        IF (i==inb(il)) afac = 0.0
-        afac = amax1(afac, 0.0)
-        bfac = 1. / (sigd * wt(il, i))
-
-        ! jyg1
-        ! cc        sigt=1.0
-        ! cc        IF(i.ge.icb)sigt=sigp(i)
-        ! prise en compte de la variation progressive de sigt dans
-        ! les couches icb et icb-1:
-        ! pour plcl<ph(i+1), pr1=0 & pr2=1
-        ! pour plcl>ph(i),   pr1=1 & pr2=0
-        ! pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
-        ! sur le nuage, et pr2 est la proportion sous la base du
-        ! 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
-        ! jyg2
-
-        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>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
-
-        ! ***  calculate precipitating downdraft mass flux under     ***
-        ! ***              hydrostatic approximation                 ***
-
-        IF (i/=1) THEN
-
-          tevap = amax1(0.0, evap(il, i))
-          delth = amax1(0.001, (th(il, i) - th(il, i - 1)))
+        IF (j<=inb(il)) THEN
           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
-          END IF
-
-          ! ***           if hydrostatic assumption fails,             ***
-          ! ***   solve cubic difference equation for downdraft theta  ***
-          ! ***  and mass flux from two simultaneous differential eqns ***
-
-          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>(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<0.0) fac2 = -1.0
-            bf = abs(bf)
-            ur = 0.25 * bf * bf - af * af * af * tinv * tinv * tinv
-            IF (ur>=0.0) THEN
-              sru = sqrt(ur)
-              fac = 1.0
-              IF ((0.5 * bf - sru)<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<0.0) d = 3.14159 - d
-              mp(il, i) = mp(il, i + 1) * tinv + 2. * sqrt(af * tinv) * cos(d * tinv)
-            END IF
-            mp(il, i) = amax1(0.0, mp(il, i))
-
-            IF (cvflag_grav) THEN
-              ! jyg : il y a vraisemblablement une erreur dans la ligne 2
-              ! suivante:
-              ! il faut diviser par (mp(il,i)*sigd*grav) et non par
-              ! (mp(il,i)+sigd*0.1).
-              ! 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 / (mp(il, &
-                      i) + sigd * 0.1) - 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 / (mp(il, &
-                      i) + sigd * 0.1) - 10.0 * (th(il, i) - th(il, i - 1)) * t(il, i) / (lvcp(il, i &
-                      ) * sigd * th(il, i))
-            END IF
-            b(il, i - 1) = amax1(b(il, i - 1), 0.0)
-          END IF
-
-          ! ***         limit magnitude of mp(i) to meet cfl condition
-          ! ***
-
-          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)
-
-          ! ***      force mp to decrease linearly to zero
-          ! ***
-          ! ***       between cloud base and the surface
-          ! ***
-
-          IF (p(il, i)>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)))
-          END IF
-
-        END IF ! i.EQ.1
-
-        ! ***       find mixing ratio of precipitating downdraft     ***
-
-        IF (i/=inb(il)) THEN
-
-          rp(il, i) = rr(il, i)
-
-          IF (mp(il, i)>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))
-            END IF
-            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)
-            ! testmaf     :            +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
-            ! :            +tra(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)>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)
-              END IF
-              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
-
-            END IF
-          END IF
-          rp(il, i) = amin1(rp(il, i), rs(il, i))
-          rp(il, i) = amax1(rp(il, i), 0.0)
-
-        END IF
-      END IF
-    END DO
-
-  400 END DO
-
-END SUBROUTINE cv30_unsat
-
-SUBROUTINE cv30_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, vprecip, ft, fr, fu, fv, ftra, upwd, dnwd, dnwd0, ma, &
-        mike, tls, tps, qcondc, wd)
-  USE lmdz_conema3
-  USE lmdz_cvflag
-
-  IMPLICIT NONE
-
-  include "cvthermo.h"
-  include "cv30param.h"
-
-  ! 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)
-  ! ym      real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
-  REAL vent(nloc, na, na), elij(nloc, na, na)
-  INTEGER nent(nloc, na)
-  REAL traent(nloc, na, na, ntra)
-  REAL tv(nloc, nd), tvp(nloc, nd)
-
-  ! input/output:
-  INTEGER iflag(nloc)
-
-  ! outputs:
-  REAL precip(nloc)
-  REAL vprecip(nloc, nd + 1)
-  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
-
-  ! 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)
-  ! !!      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
-
-
-  ! -------------------------------------------------------------
-
-  ! initialization:
-
-  delti = 1.0 / delt
-
-  DO il = 1, ncum
-    precip(il) = 0.0
-    wd(il) = 0.0 ! gust
-    vprecip(il, nd + 1) = 0.
-  END DO
-
-  DO i = 1, nd
-    DO il = 1, ncum
-      vprecip(il, i) = 0.0
-      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
-    END DO
-  END DO
-
-  ! 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)
-    END DO
-  END DO
-
-
-
-  ! ***  calculate surface precipitation in mm/day     ***
-
-  DO il = 1, ncum
-    IF (ep(il, inb(il))>=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.
-      END IF
-    END IF
-  END DO
-
-  ! ***  CALCULATE VERTICAL PROFILE OF  PRECIPITATIONs IN kg/m2/s  ===
-
-  ! MAF rajout pour lessivage
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (k<=inb(il)) THEN
-        IF (cvflag_grav) THEN
-          vprecip(il, k) = wt(il, k) * sigd * water(il, k) / grav
-        ELSE
-          vprecip(il, k) = wt(il, k) * sigd * water(il, k) / 10.
-        END IF
-      END IF
-    END DO
-  END DO
-
-
-  ! ***  Calculate downdraft velocity scale    ***
-  ! ***  NE PAS UTILISER POUR L'INSTANT ***
-
-  !      do il=1,ncum
-  !        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il))
-  !     :                                  /(sigd*p(il,icb(il)))
-  !      enddo
-
-
-  ! ***  calculate tendencies of lowest level potential temperature  ***
-  ! ***                      and mixing ratio                        ***
-
-  DO il = 1, ncum
-    work(il) = 1.0 / (ph(il, 1) - ph(il, 2))
-    am(il) = 0.0
-  END DO
-
-  DO k = 2, nl
-    DO il = 1, ncum
-      IF (k<=inb(il)) THEN
-        am(il) = am(il) + m(il, k)
-      END IF
-    END DO
-  END DO
-
-  DO il = 1, ncum
-
-    ! convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
-    IF (cvflag_grav) THEN
-      IF ((0.01 * grav * work(il) * am(il))>=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))>=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))
-    END IF
-
-    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)
-    END IF
-
-    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
-      ! jyg1  Correction pour mieux conserver l'eau (conformite avec
-      ! CONVECT4.3)
-      ! (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))
-      ! +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)))
-    END IF ! cvflag_grav
-
-  END DO ! 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)))
-  ! END IF
-  ! enddo
-  ! enddo
-
-  DO j = 2, nl
-    DO il = 1, ncum
-      IF (j<=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))
-        END IF ! cvflag_grav
-      END IF ! j
-    END DO
-  END DO
-
-  ! 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))
-  ! END IF
-
-  ! END IF
-  ! enddo
-  ! enddo
-  ! enddo
-
-
-  ! ***  calculate tendencies of potential temperature and mixing ratio  ***
-  ! ***               at levels above the lowest level                   ***
-
-  ! ***  first find the net saturated updraft and downdraft mass fluxes  ***
-  ! ***                      through each level                          ***
-
-  DO i = 2, nl + 1 ! newvecto: mettre nl au lieu nl+1?
-
-    num1 = 0
-    DO il = 1, ncum
-      IF (i<=inb(il)) num1 = num1 + 1
-    END DO
-    IF (num1<=0) GO TO 500
-
-    CALL zilch(amp1, ncum)
-    CALL zilch(ad, ncum)
-
-    DO k = i + 1, nl + 1
-      DO il = 1, ncum
-        IF (i<=inb(il) .AND. k<=(inb(il) + 1)) THEN
-          amp1(il) = amp1(il) + m(il, k)
-        END IF
-      END DO
-    END DO
-
-    DO k = 1, i
-      DO j = i + 1, nl + 1
-        DO il = 1, ncum
-          IF (i<=inb(il) .AND. j<=(inb(il) + 1)) THEN
-            amp1(il) = amp1(il) + ment(il, k, j)
-          END IF
-        END DO
-      END DO
-    END DO
-
-    DO k = 1, i - 1
-      DO j = i, nl + 1 ! newvecto: nl au lieu nl+1?
-        DO il = 1, ncum
-          IF (i<=inb(il) .AND. j<=inb(il)) THEN
-            ad(il) = ad(il) + ment(il, j, k)
-          END IF
-        END DO
-      END DO
-    END DO
-
-    DO il = 1, ncum
-      IF (i<=inb(il)) THEN
-        dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
-        cpinv = 1.0 / cpn(il, i)
-
-        ! convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
-        IF (cvflag_grav) THEN
-          IF ((0.01 * grav * dpinv * amp1(il))>=delti) iflag(il) = 1 ! vecto
-        ELSE
-          IF ((0.1 * dpinv * amp1(il))>=delti) iflag(il) = 1 ! vecto
-        END IF
-
-        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
-        END IF ! 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)))
-        END IF ! cvflag_grav
-
-      END IF ! i
+            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))
+          END IF ! cvflag_grav
+        END IF ! j
+      END DO
     END DO
 
     ! do k=1,ntra
+    ! do j=2,nl
     ! 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 (j.le.inb(il)) THEN
     ! 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)))
+    ! 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,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)))
+    ! 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))
     ! END IF
+
     ! END IF
     ! enddo
     ! enddo
-
-    DO k = 1, i - 1
+    ! enddo
+
+
+    ! ***  calculate tendencies of potential temperature and mixing ratio  ***
+    ! ***               at levels above the lowest level                   ***
+
+    ! ***  first find the net saturated updraft and downdraft mass fluxes  ***
+    ! ***                      through each level                          ***
+
+    DO i = 2, nl + 1 ! newvecto: mettre nl au lieu nl+1?
+
+      num1 = 0
+      DO il = 1, ncum
+        IF (i<=inb(il)) num1 = num1 + 1
+      END DO
+      IF (num1<=0) GO TO 500
+
+      CALL zilch(amp1, ncum)
+      CALL zilch(ad, ncum)
+
+      DO k = i + 1, nl + 1
+        DO il = 1, ncum
+          IF (i<=inb(il) .AND. k<=(inb(il) + 1)) THEN
+            amp1(il) = amp1(il) + m(il, k)
+          END IF
+        END DO
+      END DO
+
+      DO k = 1, i
+        DO j = i + 1, nl + 1
+          DO il = 1, ncum
+            IF (i<=inb(il) .AND. j<=(inb(il) + 1)) THEN
+              amp1(il) = amp1(il) + ment(il, k, j)
+            END IF
+          END DO
+        END DO
+      END DO
+
+      DO k = 1, i - 1
+        DO j = i, nl + 1 ! newvecto: nl au lieu nl+1?
+          DO il = 1, ncum
+            IF (i<=inb(il) .AND. j<=inb(il)) THEN
+              ad(il) = ad(il) + ment(il, j, k)
+            END IF
+          END DO
+        END DO
+      END DO
+
       DO il = 1, ncum
         IF (i<=inb(il)) THEN
@@ -2545 +2494 @@
           cpinv = 1.0 / cpn(il, i)
 
-          awat = elij(il, k, i) - (1. - ep(il, i)) * clw(il, i)
-          awat = amax1(awat, 0.0)
-
+          ! convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
           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))
+            IF ((0.01 * grav * dpinv * amp1(il))>=delti) iflag(il) = 1 ! vecto
+          ELSE
+            IF ((0.1 * dpinv * amp1(il))>=delti) iflag(il) = 1 ! vecto
+          END IF
+
+          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
-            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))
+            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
           END IF ! cvflag_grav
 
-          ! (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
+          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)))
+          END IF ! cvflag_grav
+
         END IF ! i
       END DO
-    END DO
-
-    ! 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))
-    ! END IF
-    ! END IF
-    ! enddo
-    ! enddo
-    ! enddo
-
-    DO k = i, nl + 1
+
+      ! 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)))
+      ! END IF
+      ! END IF
+      ! enddo
+      ! enddo
+
+      DO k = 1, i - 1
+        DO il = 1, ncum
+          IF (i<=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))
+            END IF ! cvflag_grav
+
+            ! (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
+          END IF ! i
+        END DO
+      END DO
+
+      ! 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))
+      ! END IF
+      ! END IF
+      ! enddo
+      ! enddo
+      ! enddo
+
+      DO k = i, nl + 1
+        DO il = 1, ncum
+          IF (i<=inb(il) .AND. k<=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))
+            END IF ! cvflag_grav
+          END IF ! i and k
+        END DO
+      END DO
+
+      ! 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))
+      ! END IF
+      ! END IF ! i and k
+      ! enddo
+      ! enddo
+      ! enddo
+
       DO il = 1, ncum
-        IF (i<=inb(il) .AND. k<=inb(il)) THEN
+        IF (i<=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))
+            ! sb: on ne fait pas encore la correction permettant de mieux
+            ! 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.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))
+            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
           END IF ! cvflag_grav
-        END IF ! i and k
-      END DO
-    END DO
-
-    ! 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))
-    ! END IF
-    ! END IF ! i and k
-    ! enddo
-    ! enddo
-    ! enddo
-
-    DO il = 1, ncum
-      IF (i<=inb(il)) THEN
-        dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
-        cpinv = 1.0 / cpn(il, i)
-
-        IF (cvflag_grav) THEN
-          ! sb: on ne fait pas encore la correction permettant de mieux
-          ! 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
-        END IF ! cvflag_grav
-
-      END IF ! i
-    END DO
-
-    ! sb: interface with the cloud parameterization:          ! cld
-
-    DO k = i + 1, nl
-      DO il = 1, ncum
-        IF (k<=inb(il) .AND. i<=inb(il)) THEN ! cld
-          ! (saturated downdrafts resulting from mixing)            ! cld
-          qcond(il, i) = qcond(il, i) + elij(il, k, i) ! cld
+
+        END IF ! i
+      END DO
+
+      ! sb: interface with the cloud parameterization:          ! cld
+
+      DO k = i + 1, nl
+        DO il = 1, ncum
+          IF (k<=inb(il) .AND. i<=inb(il)) THEN ! cld
+            ! (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
+          END IF ! cld
+        END DO ! cld
+      END DO ! cld
+
+      ! (particular case: no detraining level is found)         ! cld
+      DO il = 1, ncum ! cld
+        IF (i<=inb(il) .AND. nent(il, i)==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
         END IF ! cld
       END DO ! cld
-    END DO ! cld
-
-    ! (particular case: no detraining level is found)         ! cld
-    DO il = 1, ncum ! cld
-      IF (i<=inb(il) .AND. nent(il, i)==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
-      END IF ! cld
-    END DO ! cld
-
-    DO il = 1, ncum ! cld
-      IF (i<=inb(il) .AND. nqcond(il, i)/=0.) THEN ! cld
-        qcond(il, i) = qcond(il, i) / nqcond(il, i) ! cld
-      END IF ! cld
+
+      DO il = 1, ncum ! cld
+        IF (i<=inb(il) .AND. nqcond(il, i)/=0.) THEN ! cld
+          qcond(il, i) = qcond(il, i) / nqcond(il, i) ! cld
+        END IF ! cld
+      END DO
+
+      ! 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)-tra(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)-tra(il,i-1,j)))
+      ! END IF
+      ! END IF ! i
+      ! enddo
+      ! enddo
+
+    500 END DO
+
+
+    ! ***   move the detrainment at level inb down to level inb-1   ***
+    ! ***        in such a way as to preserve the vertically        ***
+    ! ***          integrated enthalpy and water tendencies         ***
+
+    DO 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)))
+
     END DO
 
     ! 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)-tra(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)-tra(il,i-1,j)))
-    ! END IF
-    ! END IF ! i
+    ! ex=0.1*ment(il,inb(il),inb(il))
+    ! :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+    ! :      /(ph(il,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
 
-  500 END DO
-
-
-  ! ***   move the detrainment at level inb down to level inb-1   ***
-  ! ***        in such a way as to preserve the vertically        ***
-  ! ***          integrated enthalpy and water tendencies         ***
-
-  DO 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)))
-
-  END DO
-
-  ! 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(il,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
-
-
-  ! ***    homoginize tendencies below cloud base    ***
-
-  DO il = 1, ncum
-    asum(il) = 0.0
-    bsum(il) = 0.0
-    csum(il) = 0.0
-    dsum(il) = 0.0
-  END DO
-
-  DO i = 1, nl
+
+    ! ***    homoginize tendencies below cloud base    ***
+
     DO il = 1, ncum
-      IF (i<=(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)
-      END IF
-    END DO
-  END DO
-
-  ! !!!      do 700 i=1,icb(il)-1
-  DO i = 1, nl
+      asum(il) = 0.0
+      bsum(il) = 0.0
+      csum(il) = 0.0
+      dsum(il) = 0.0
+    END DO
+
+    DO i = 1, nl
+      DO il = 1, ncum
+        IF (i<=(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)
+        END IF
+      END DO
+    END DO
+
+    ! !!!      do 700 i=1,icb(il)-1
+    DO i = 1, nl
+      DO il = 1, ncum
+        IF (i<=(icb(il) - 1)) THEN
+          ft(il, i) = asum(il) * t(il, i) / (th(il, i) * dsum(il))
+          fr(il, i) = bsum(il) / csum(il)
+        END IF
+      END DO
+    END DO
+
+
+    ! ***           reset counter and return           ***
+
     DO il = 1, ncum
-      IF (i<=(icb(il) - 1)) THEN
-        ft(il, i) = asum(il) * t(il, i) / (th(il, i) * dsum(il))
-        fr(il, i) = bsum(il) / csum(il)
-      END IF
-    END DO
-  END DO
-
-
-  ! ***           reset counter and return           ***
-
-  DO il = 1, ncum
-    sig(il, nd) = 2.0
-  END DO
-
-  DO i = 1, nd
-    DO il = 1, ncum
-      upwd(il, i) = 0.0
-      dnwd(il, i) = 0.0
-    END DO
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      dnwd0(il, i) = -mp(il, i)
-    END DO
-  END DO
-  DO i = nl + 1, nd
-    DO il = 1, ncum
-      dnwd0(il, i) = 0.
-    END DO
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>=icb(il) .AND. i<=inb(il)) THEN
+      sig(il, nd) = 2.0
+    END DO
+
+    DO i = 1, nd
+      DO il = 1, ncum
         upwd(il, i) = 0.0
         dnwd(il, i) = 0.0
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, nl
-    DO k = 1, nl
+      END DO
+    END DO
+
+    DO i = 1, nl
       DO il = 1, ncum
-        up1(il, k, i) = 0.0
-        dn1(il, k, i) = 0.0
-      END DO
-    END DO
-  END DO
-
-  DO i = 1, nl
-    DO k = i, nl
-      DO n = 1, i - 1
+        dnwd0(il, i) = -mp(il, i)
+      END DO
+    END DO
+    DO i = nl + 1, nd
+      DO il = 1, ncum
+        dnwd0(il, i) = 0.
+      END DO
+    END DO
+
+    DO i = 1, nl
+      DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il)) THEN
+          upwd(il, i) = 0.0
+          dnwd(il, i) = 0.0
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, nl
+      DO k = 1, nl
         DO il = 1, ncum
-          IF (i>=icb(il) .AND. i<=inb(il) .AND. k<=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)
+          up1(il, k, i) = 0.0
+          dn1(il, k, i) = 0.0
+        END DO
+      END DO
+    END DO
+
+    DO i = 1, nl
+      DO k = i, nl
+        DO n = 1, i - 1
+          DO il = 1, ncum
+            IF (i>=icb(il) .AND. i<=inb(il) .AND. k<=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)
+            END IF
+          END DO
+        END DO
+      END DO
+    END DO
+
+    DO i = 2, nl
+      DO k = i, nl
+        DO il = 1, ncum
+          ! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il))
+          ! THEN
+          IF (i<=inb(il) .AND. k<=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)
           END IF
         END DO
       END DO
     END DO
-  END DO
-
-  DO i = 2, nl
-    DO k = i, nl
+
+
+    ! !!!      DO il=1,ncum
+    ! !!!      do i=icb(il),inb(il)
+    ! !!!
+    ! !!!      upwd(il,i)=0.0
+    ! !!!      dnwd(il,i)=0.0
+    ! !!!      do k=i,inb(il)
+    ! !!!      up1=0.0
+    ! !!!      dn1=0.0
+    ! !!!      do n=1,i-1
+    ! !!!      up1=up1+ment(il,n,k)
+    ! !!!      dn1=dn1-ment(il,k,n)
+    ! !!!      enddo
+    ! !!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
+    ! !!!      dnwd(il,i)=dnwd(il,i)+dn1
+    ! !!!      enddo
+    ! !!!      enddo
+    ! !!!
+    ! !!!      ENDDO
+
+    ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+    ! determination de la variation de flux ascendant entre
+    ! deux niveau non dilue mike
+    ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+    DO i = 1, nl
       DO il = 1, ncum
-        ! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il))
-        ! THEN
-        IF (i<=inb(il) .AND. k<=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)
+        mike(il, i) = m(il, i)
+      END DO
+    END DO
+
+    DO i = nl + 1, nd
+      DO il = 1, ncum
+        mike(il, i) = 0.
+      END DO
+    END DO
+
+    DO i = 1, nd
+      DO il = 1, ncum
+        ma(il, i) = 0
+      END DO
+    END DO
+
+    DO i = 1, nl
+      DO j = i, nl
+        DO il = 1, ncum
+          ma(il, i) = ma(il, i) + m(il, j)
+        END DO
+      END DO
+    END DO
+
+    DO i = nl + 1, nd
+      DO il = 1, ncum
+        ma(il, i) = 0.
+      END DO
+    END DO
+
+    DO i = 1, nl
+      DO il = 1, ncum
+        IF (i<=(icb(il) - 1)) THEN
+          ma(il, i) = 0
         END IF
       END DO
     END DO
-  END DO
-
-
-  ! !!!      DO il=1,ncum
-  ! !!!      do i=icb(il),inb(il)
-  ! !!!
-  ! !!!      upwd(il,i)=0.0
-  ! !!!      dnwd(il,i)=0.0
-  ! !!!      do k=i,inb(il)
-  ! !!!      up1=0.0
-  ! !!!      dn1=0.0
-  ! !!!      do n=1,i-1
-  ! !!!      up1=up1+ment(il,n,k)
-  ! !!!      dn1=dn1-ment(il,k,n)
-  ! !!!      enddo
-  ! !!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
-  ! !!!      dnwd(il,i)=dnwd(il,i)+dn1
-  ! !!!      enddo
-  ! !!!      enddo
-  ! !!!
-  ! !!!      ENDDO
-
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  ! determination de la variation de flux ascendant entre
-  ! deux niveau non dilue mike
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      mike(il, i) = m(il, i)
-    END DO
-  END DO
-
-  DO i = nl + 1, nd
-    DO il = 1, ncum
-      mike(il, i) = 0.
-    END DO
-  END DO
-
-  DO i = 1, nd
-    DO il = 1, ncum
-      ma(il, i) = 0
-    END DO
-  END DO
-
-  DO i = 1, nl
-    DO j = i, nl
+
+    ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+    ! icb represente de niveau ou se trouve la
+    ! base du nuage , et inb le top du nuage
+    ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+    DO i = 1, nd
       DO il = 1, ncum
-        ma(il, i) = ma(il, i) + m(il, j)
-      END DO
-    END DO
-  END DO
-
-  DO i = nl + 1, nd
-    DO il = 1, ncum
-      ma(il, i) = 0.
-    END DO
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i<=(icb(il) - 1)) THEN
-        ma(il, i) = 0
-      END IF
-    END DO
-  END DO
-
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  ! icb represente de niveau ou se trouve la
-  ! base du nuage , et inb le top du nuage
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-  DO i = 1, nd
-    DO il = 1, ncum
-      mke(il, i) = upwd(il, i) + dnwd(il, i)
-    END DO
-  END DO
-
-  DO i = 1, nd
-    DO 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)
-    END DO
-  END DO
-
-
-  ! *** diagnose the in-cloud mixing ratio   ***            ! cld
-  ! ***           of condensed water         ***            ! cld
-  ! 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
+        mke(il, i) = upwd(il, i) + dnwd(il, i)
+      END DO
+    END DO
+
+    DO i = 1, nd
+      DO 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)
+      END DO
+    END DO
+
+
+    ! *** diagnose the in-cloud mixing ratio   ***            ! cld
+    ! ***           of condensed water         ***            ! cld
+    ! 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
+      END DO ! cld
     END DO ! cld
-  END DO ! cld
-
-  DO i = minorig, nl ! cld
-    DO k = i + 1, nl + 1 ! cld
+
+    DO i = minorig, nl ! cld
+      DO k = i + 1, nl + 1 ! cld
+        DO il = 1, ncum ! cld
+          IF (i<=inb(il) .AND. k<=(inb(il) + 1)) THEN ! cld
+            mac(il, i) = mac(il, i) + m(il, k) ! cld
+          END IF ! cld
+        END DO ! cld
+      END DO ! cld
+    END DO ! cld
+
+    DO i = 1, nl ! cld
+      DO j = 1, i ! cld
+        DO il = 1, ncum ! cld
+          IF (i>=icb(il) .AND. i<=(inb(il) - 1) & ! cld
+                  .AND. j>=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
+          END IF ! cld
+        END DO ! cld
+      END DO ! cld
+    END DO ! cld
+
+    DO i = 1, nl ! cld
       DO il = 1, ncum ! cld
-        IF (i<=inb(il) .AND. k<=(inb(il) + 1)) THEN ! cld
-          mac(il, i) = mac(il, i) + m(il, k) ! cld
+        IF (i>=icb(il) .AND. i<=(inb(il) - 1) & ! cld
+                .AND. sax(il, i)>0.0) THEN ! cld
+          wa(il, i) = sqrt(2. * sax(il, i)) ! cld
         END IF ! cld
       END DO ! cld
     END DO ! cld
-  END DO ! cld
-
-  DO i = 1, nl ! cld
-    DO j = 1, i ! cld
+
+    DO i = 1, nl ! cld
       DO il = 1, ncum ! cld
-        IF (i>=icb(il) .AND. i<=(inb(il) - 1) & ! cld
-                .AND. j>=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
-        END IF ! cld
+        IF (wa(il, i)>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
+        ! IM cf. FH
+        IF (iflag_clw==0) THEN
+          qcondc(il, i) = siga(il, i) * clw(il, i) * (1. - ep(il, i)) & ! cld
+                  + (1. - siga(il, i)) * qcond(il, i) ! cld
+        ELSE IF (iflag_clw==1) THEN
+          qcondc(il, i) = qcond(il, i) ! cld
+        END IF
+
       END DO ! cld
     END DO ! cld
-  END DO ! cld
-
-  DO i = 1, nl ! cld
-    DO il = 1, ncum ! cld
-      IF (i>=icb(il) .AND. i<=(inb(il) - 1) & ! cld
-              .AND. sax(il, i)>0.0) THEN ! cld
-        wa(il, i) = sqrt(2. * sax(il, i)) ! cld
-      END IF ! cld
-    END DO ! cld
-  END DO ! cld
-
-  DO i = 1, nl ! cld
-    DO il = 1, ncum ! cld
-      IF (wa(il, i)>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
-      ! IM cf. FH
-      IF (iflag_clw==0) THEN
-        qcondc(il, i) = siga(il, i) * clw(il, i) * (1. - ep(il, i)) & ! cld
-                + (1. - siga(il, i)) * qcond(il, i) ! cld
-      ELSE IF (iflag_clw==1) THEN
-        qcondc(il, i) = qcond(il, i) ! cld
-      END IF
-
-    END DO ! cld
-  END DO ! cld
-
-END SUBROUTINE cv30_yield
-
-!RomP >>>
-SUBROUTINE cv30_tracer(nloc, len, ncum, nd, na, ment, sij, da, phi, phi2, &
-        d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
-  IMPLICIT NONE
-
-  include "cv30param.h"
-
-  ! inputs:
-  INTEGER ncum, nd, na, nloc, len
-  REAL ment(nloc, na, na), sij(nloc, na, na)
-  REAL clw(nloc, nd), elij(nloc, na, na)
-  REAL ep(nloc, na)
-  INTEGER icb(nloc), inb(nloc)
-  REAL vprecip(nloc, nd + 1)
-  ! ouputs:
-  REAL da(nloc, na), phi(nloc, na, na)
-  REAL phi2(nloc, na, na)
-  REAL d1a(nloc, na), dam(nloc, na)
-  REAL epmlmmm(nloc, na, na), eplamm(nloc, na)
-  ! variables pour tracer dans precip de l'AA et des mel
-  ! local variables:
-  INTEGER i, j, k, nam1
-  REAL epm(nloc, na, na)
-
-  nam1 = na - 1 ! Introduced because ep is not defined for j=na
-  ! variables d'Emanuel : du second indice au troisieme
-  ! --->    tab(i,k,j) -> de l origine k a l arrivee j
-  ! ment, sij, elij
-  ! variables personnelles : du troisieme au second indice
-  ! --->    tab(i,j,k) -> de k a j
-  ! phi, phi2
-
-  ! initialisations
-  DO j = 1, na
-    DO i = 1, ncum
-      da(i, j) = 0.
-      d1a(i, j) = 0.
-      dam(i, j) = 0.
-      eplamm(i, j) = 0.
-    END DO
-  END DO
-  DO k = 1, na
+
+  END SUBROUTINE cv30_yield
+
+  !RomP >>>
+  SUBROUTINE cv30_tracer(nloc, len, ncum, nd, na, ment, sij, da, phi, phi2, &
+          d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
+    IMPLICIT NONE
+
+
+
+    ! inputs:
+    INTEGER ncum, nd, na, nloc, len
+    REAL ment(nloc, na, na), sij(nloc, na, na)
+    REAL clw(nloc, nd), elij(nloc, na, na)
+    REAL ep(nloc, na)
+    INTEGER icb(nloc), inb(nloc)
+    REAL vprecip(nloc, nd + 1)
+    ! ouputs:
+    REAL da(nloc, na), phi(nloc, na, na)
+    REAL phi2(nloc, na, na)
+    REAL d1a(nloc, na), dam(nloc, na)
+    REAL epmlmmm(nloc, na, na), eplamm(nloc, na)
+    ! variables pour tracer dans precip de l'AA et des mel
+    ! local variables:
+    INTEGER i, j, k, nam1
+    REAL epm(nloc, na, na)
+
+    nam1 = na - 1 ! Introduced because ep is not defined for j=na
+    ! variables d'Emanuel : du second indice au troisieme
+    ! --->    tab(i,k,j) -> de l origine k a l arrivee j
+    ! ment, sij, elij
+    ! variables personnelles : du troisieme au second indice
+    ! --->    tab(i,j,k) -> de k a j
+    ! phi, phi2
+
+    ! initialisations
     DO j = 1, na
       DO i = 1, ncum
-        epm(i, j, k) = 0.
-        epmlmmm(i, j, k) = 0.
-        phi(i, j, k) = 0.
-        phi2(i, j, k) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! fraction deau condensee dans les melanges convertie en precip : epm
-  ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
-  DO j = 1, nam1
-    DO k = 1, j - 1
+        da(i, j) = 0.
+        d1a(i, j) = 0.
+        dam(i, j) = 0.
+        eplamm(i, j) = 0.
+      END DO
+    END DO
+    DO k = 1, na
+      DO j = 1, na
+        DO i = 1, ncum
+          epm(i, j, k) = 0.
+          epmlmmm(i, j, k) = 0.
+          phi(i, j, k) = 0.
+          phi2(i, j, k) = 0.
+        END DO
+      END DO
+    END DO
+
+    ! fraction deau condensee dans les melanges convertie en precip : epm
+    ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
+    DO j = 1, nam1
+      DO k = 1, j - 1
+        DO i = 1, ncum
+          IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
+            !jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
+            epm(i, j, k) = 1. - (1. - ep(i, j)) * clw(i, j) / max(elij(i, k, j), 1.E-16)
+            !
+            epm(i, j, k) = max(epm(i, j, k), 0.0)
+          END IF
+        END DO
+      END DO
+    END DO
+
+    DO j = 1, nam1
+      DO k = 1, nam1
+        DO i = 1, ncum
+          IF (k>=icb(i) .AND. k<=inb(i)) THEN
+            eplamm(i, j) = eplamm(i, j) + ep(i, j) * clw(i, j) * ment(i, j, k) * (1. - &
+                    sij(i, j, k))
+          END IF
+        END DO
+      END DO
+    END DO
+
+    DO j = 1, nam1
+      DO k = 1, j - 1
+        DO i = 1, ncum
+          IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
+            epmlmmm(i, j, k) = epm(i, j, k) * elij(i, k, j) * ment(i, k, j)
+          END IF
+        END DO
+      END DO
+    END DO
+
+    ! matrices pour calculer la tendance des concentrations dans cvltr.F90
+    DO j = 1, nam1
+      DO k = 1, nam1
+        DO i = 1, ncum
+          da(i, j) = da(i, j) + (1. - sij(i, k, j)) * ment(i, k, j)
+          phi(i, j, k) = sij(i, k, j) * ment(i, k, j)
+          d1a(i, j) = d1a(i, j) + ment(i, k, j) * ep(i, k) * (1. - sij(i, k, j))
+        END DO
+      END DO
+    END DO
+
+    DO j = 1, nam1
+      DO k = 1, j - 1
+        DO i = 1, ncum
+          dam(i, j) = dam(i, j) + ment(i, k, j) * epm(i, j, k) * (1. - ep(i, k)) * (1. - &
+                  sij(i, k, j))
+          phi2(i, j, k) = phi(i, j, k) * epm(i, j, k)
+        END DO
+      END DO
+    END DO
+
+  END SUBROUTINE cv30_tracer
+  ! RomP <<<
+
+  SUBROUTINE cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
+          vprecip, evap, ep, sig, w0, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, &
+          dnwd0, qcondc, wd, cape, da, phi, mp, phi2, d1a, dam, sij, elij, clw, &
+          epmlmmm, eplamm, wdtraina, wdtrainm, epmax_diag, iflag1, precip1, vprecip1, evap1, &
+          ep1, sig1, w01, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, &
+          dnwd01, qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, &
+          elij1, clw1, epmlmmm1, eplamm1, wdtraina1, wdtrainm1, epmax_diag1) ! epmax_cape
+    IMPLICIT NONE
+
+
+
+    ! inputs:
+    INTEGER len, ncum, nd, ntra, nloc
+    INTEGER idcum(nloc)
+    INTEGER iflag(nloc)
+    INTEGER inb(nloc)
+    REAL precip(nloc)
+    REAL vprecip(nloc, nd + 1), evap(nloc, nd)
+    REAL ep(nloc, nd)
+    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)
+    REAL da(nloc, nd), phi(nloc, nd, nd), mp(nloc, nd)
+    REAL epmax_diag(nloc) ! epmax_cape
+    ! RomP >>>
+    REAL phi2(nloc, nd, nd)
+    REAL d1a(nloc, nd), dam(nloc, nd)
+    REAL wdtraina(nloc, nd), wdtrainm(nloc, nd)
+    REAL sij(nloc, nd, nd)
+    REAL elij(nloc, nd, nd), clw(nloc, nd)
+    REAL epmlmmm(nloc, nd, nd), eplamm(nloc, nd)
+    ! RomP <<<
+
+    ! outputs:
+    INTEGER iflag1(len)
+    INTEGER inb1(len)
+    REAL precip1(len)
+    REAL vprecip1(len, nd + 1), evap1(len, nd) !<<< RomP
+    REAL ep1(len, nd) !<<< RomP
+    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)
+    REAL da1(nloc, nd), phi1(nloc, nd, nd), mp1(nloc, nd)
+    REAL epmax_diag1(len) ! epmax_cape
+    ! RomP >>>
+    REAL phi21(len, nd, nd)
+    REAL d1a1(len, nd), dam1(len, nd)
+    REAL wdtraina1(len, nd), wdtrainm1(len, nd)
+    REAL sij1(len, nd, nd)
+    REAL elij1(len, nd, nd), clw1(len, nd)
+    REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
+    ! RomP <<<
+
+    ! local variables:
+    INTEGER i, k, j
+
+    DO i = 1, ncum
+      precip1(idcum(i)) = precip(i)
+      iflag1(idcum(i)) = iflag(i)
+      wd1(idcum(i)) = wd(i)
+      inb1(idcum(i)) = inb(i)
+      cape1(idcum(i)) = cape(i)
+      epmax_diag1(idcum(i)) = epmax_diag(i) ! epmax_cape
+    END DO
+
+    DO k = 1, nl
       DO i = 1, ncum
-        IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
-          !jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
-          epm(i, j, k) = 1. - (1. - ep(i, j)) * clw(i, j) / max(elij(i, k, j), 1.E-16)
-          !
-          epm(i, j, k) = max(epm(i, j, k), 0.0)
-        END IF
-      END DO
-    END DO
-  END DO
-
-  DO j = 1, nam1
-    DO k = 1, nam1
-      DO i = 1, ncum
-        IF (k>=icb(i) .AND. k<=inb(i)) THEN
-          eplamm(i, j) = eplamm(i, j) + ep(i, j) * clw(i, j) * ment(i, j, k) * (1. - &
-                  sij(i, j, k))
-        END IF
-      END DO
-    END DO
-  END DO
-
-  DO j = 1, nam1
-    DO k = 1, j - 1
-      DO i = 1, ncum
-        IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
-          epmlmmm(i, j, k) = epm(i, j, k) * elij(i, k, j) * ment(i, k, j)
-        END IF
-      END DO
-    END DO
-  END DO
-
-  ! matrices pour calculer la tendance des concentrations dans cvltr.F90
-  DO j = 1, nam1
-    DO k = 1, nam1
-      DO i = 1, ncum
-        da(i, j) = da(i, j) + (1. - sij(i, k, j)) * ment(i, k, j)
-        phi(i, j, k) = sij(i, k, j) * ment(i, k, j)
-        d1a(i, j) = d1a(i, j) + ment(i, k, j) * ep(i, k) * (1. - sij(i, k, j))
-      END DO
-    END DO
-  END DO
-
-  DO j = 1, nam1
-    DO k = 1, j - 1
-      DO i = 1, ncum
-        dam(i, j) = dam(i, j) + ment(i, k, j) * epm(i, j, k) * (1. - ep(i, k)) * (1. - &
-                sij(i, k, j))
-        phi2(i, j, k) = phi(i, j, k) * epm(i, j, k)
-      END DO
-    END DO
-  END DO
-
-END SUBROUTINE cv30_tracer
-! RomP <<<
-
-SUBROUTINE cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
-        vprecip, evap, ep, sig, w0, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, &
-        dnwd0, qcondc, wd, cape, da, phi, mp, phi2, d1a, dam, sij, elij, clw, &
-        epmlmmm, eplamm, wdtraina, wdtrainm, epmax_diag, iflag1, precip1, vprecip1, evap1, &
-        ep1, sig1, w01, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, &
-        dnwd01, qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, &
-        elij1, clw1, epmlmmm1, eplamm1, wdtraina1, wdtrainm1, epmax_diag1) ! epmax_cape
-  IMPLICIT NONE
-
-  include "cv30param.h"
-
-  ! inputs:
-  INTEGER len, ncum, nd, ntra, nloc
-  INTEGER idcum(nloc)
-  INTEGER iflag(nloc)
-  INTEGER inb(nloc)
-  REAL precip(nloc)
-  REAL vprecip(nloc, nd + 1), evap(nloc, nd)
-  REAL ep(nloc, nd)
-  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)
-  REAL da(nloc, nd), phi(nloc, nd, nd), mp(nloc, nd)
-  REAL epmax_diag(nloc) ! epmax_cape
-  ! RomP >>>
-  REAL phi2(nloc, nd, nd)
-  REAL d1a(nloc, nd), dam(nloc, nd)
-  REAL wdtraina(nloc, nd), wdtrainm(nloc, nd)
-  REAL sij(nloc, nd, nd)
-  REAL elij(nloc, nd, nd), clw(nloc, nd)
-  REAL epmlmmm(nloc, nd, nd), eplamm(nloc, nd)
-  ! RomP <<<
-
-  ! outputs:
-  INTEGER iflag1(len)
-  INTEGER inb1(len)
-  REAL precip1(len)
-  REAL vprecip1(len, nd + 1), evap1(len, nd) !<<< RomP
-  REAL ep1(len, nd) !<<< RomP
-  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)
-  REAL da1(nloc, nd), phi1(nloc, nd, nd), mp1(nloc, nd)
-  REAL epmax_diag1(len) ! epmax_cape
-  ! RomP >>>
-  REAL phi21(len, nd, nd)
-  REAL d1a1(len, nd), dam1(len, nd)
-  REAL wdtraina1(len, nd), wdtrainm1(len, nd)
-  REAL sij1(len, nd, nd)
-  REAL elij1(len, nd, nd), clw1(len, nd)
-  REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
-  ! RomP <<<
-
-  ! local variables:
-  INTEGER i, k, j
-
-  DO i = 1, ncum
-    precip1(idcum(i)) = precip(i)
-    iflag1(idcum(i)) = iflag(i)
-    wd1(idcum(i)) = wd(i)
-    inb1(idcum(i)) = inb(i)
-    cape1(idcum(i)) = cape(i)
-    epmax_diag1(idcum(i)) = epmax_diag(i) ! epmax_cape
-  END DO
-
-  DO k = 1, nl
+        vprecip1(idcum(i), k) = vprecip(i, k)
+        evap1(idcum(i), k) = evap(i, k) !<<< RomP
+        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)
+        da1(idcum(i), k) = da(i, k)
+        mp1(idcum(i), k) = mp(i, k)
+        ! RomP >>>
+        ep1(idcum(i), k) = ep(i, k)
+        d1a1(idcum(i), k) = d1a(i, k)
+        dam1(idcum(i), k) = dam(i, k)
+        clw1(idcum(i), k) = clw(i, k)
+        eplamm1(idcum(i), k) = eplamm(i, k)
+        wdtraina1(idcum(i), k) = wdtraina(i, k)
+        wdtrainm1(idcum(i), k) = wdtrainm(i, k)
+        ! RomP <<<
+      END DO
+    END DO
+
     DO i = 1, ncum
-      vprecip1(idcum(i), k) = vprecip(i, k)
-      evap1(idcum(i), k) = evap(i, k) !<<< RomP
-      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)
-      da1(idcum(i), k) = da(i, k)
-      mp1(idcum(i), k) = mp(i, k)
-      ! RomP >>>
-      ep1(idcum(i), k) = ep(i, k)
-      d1a1(idcum(i), k) = d1a(i, k)
-      dam1(idcum(i), k) = dam(i, k)
-      clw1(idcum(i), k) = clw(i, k)
-      eplamm1(idcum(i), k) = eplamm(i, k)
-      wdtraina1(idcum(i), k) = wdtraina(i, k)
-      wdtrainm1(idcum(i), k) = wdtrainm(i, k)
-      ! RomP <<<
-    END DO
-  END DO
-
-  DO i = 1, ncum
-    sig1(idcum(i), nd) = sig(i, nd)
-  END DO
-
-
-  ! do 2100 j=1,ntra
-  ! 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
-  DO j = 1, nd
-    DO k = 1, nd
-      DO i = 1, ncum
-        sij1(idcum(i), k, j) = sij(i, k, j)
-        phi1(idcum(i), k, j) = phi(i, k, j)
-        phi21(idcum(i), k, j) = phi2(i, k, j)
-        elij1(idcum(i), k, j) = elij(i, k, j)
-        epmlmmm1(idcum(i), k, j) = epmlmmm(i, k, j)
-      END DO
-    END DO
-  END DO
-
-END SUBROUTINE cv30_uncompress
-
-SUBROUTINE cv30_epmax_fn_cape(nloc, ncum, nd &
-        , cape, ep, hp, icb, inb, clw, nk, t, h, lv &
-        , epmax_diag)
-  USE lmdz_abort_physic, ONLY: abort_physic
-  USE lmdz_conema3
-
-  IMPLICIT NONE
-
-  ! On fait varier epmax en fn de la cape
-  ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
-  ! qui en dépend
-  ! Toutes les autres variables fn de ep sont calculées plus bas.
-
-  INCLUDE "cvthermo.h"
-  INCLUDE "cv30param.h"
-
-  ! inputs:
-  INTEGER ncum, nd, nloc
-  INTEGER icb(nloc), inb(nloc)
-  REAL cape(nloc)
-  REAL clw(nloc, nd), lv(nloc, nd), t(nloc, nd), h(nloc, nd)
-  INTEGER nk(nloc)
-  ! inouts:
-  REAL ep(nloc, nd)
-  REAL hp(nloc, nd)
-  ! outputs ou local
-  REAL epmax_diag(nloc)
-  ! locals
-  INTEGER i, k
-  REAL hp_bak(nloc, nd)
-  CHARACTER (LEN = 20) :: modname = 'cv30_epmax_fn_cape'
-  CHARACTER (LEN = 80) :: abort_message
-
-  ! on recalcule ep et hp
-
-  IF (coef_epmax_cape>1e-12) THEN
-    do i = 1, ncum
-      epmax_diag(i) = epmax - coef_epmax_cape * sqrt(cape(i))
+      sig1(idcum(i), nd) = sig(i, nd)
+    END DO
+
+
+    ! do 2100 j=1,ntra
+    ! 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
+    DO j = 1, nd
+      DO k = 1, nd
+        DO i = 1, ncum
+          sij1(idcum(i), k, j) = sij(i, k, j)
+          phi1(idcum(i), k, j) = phi(i, k, j)
+          phi21(idcum(i), k, j) = phi2(i, k, j)
+          elij1(idcum(i), k, j) = elij(i, k, j)
+          epmlmmm1(idcum(i), k, j) = epmlmmm(i, k, j)
+        END DO
+      END DO
+    END DO
+
+  END SUBROUTINE cv30_uncompress
+
+  SUBROUTINE cv30_epmax_fn_cape(nloc, ncum, nd &
+          , cape, ep, hp, icb, inb, clw, nk, t, h, lv &
+          , epmax_diag)
+    USE lmdz_abort_physic, ONLY: abort_physic
+    USE lmdz_conema3
+    USE lmdz_cvthermo
+
+    IMPLICIT NONE
+
+    ! On fait varier epmax en fn de la cape
+    ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
+    ! qui en dépend
+    ! Toutes les autres variables fn de ep sont calculées plus bas.
+
+
+
+    ! inputs:
+    INTEGER ncum, nd, nloc
+    INTEGER icb(nloc), inb(nloc)
+    REAL cape(nloc)
+    REAL clw(nloc, nd), lv(nloc, nd), t(nloc, nd), h(nloc, nd)
+    INTEGER nk(nloc)
+    ! inouts:
+    REAL ep(nloc, nd)
+    REAL hp(nloc, nd)
+    ! outputs ou local
+    REAL epmax_diag(nloc)
+    ! locals
+    INTEGER i, k
+    REAL hp_bak(nloc, nd)
+    CHARACTER (LEN = 20) :: modname = 'cv30_epmax_fn_cape'
+    CHARACTER (LEN = 80) :: abort_message
+
+    ! on recalcule ep et hp
+
+    IF (coef_epmax_cape>1e-12) THEN
+      do i = 1, ncum
+        epmax_diag(i) = epmax - coef_epmax_cape * sqrt(cape(i))
+        do k = 1, nl
+          ep(i, k) = ep(i, k) / epmax * epmax_diag(i)
+          ep(i, k) = amax1(ep(i, k), 0.0)
+          ep(i, k) = amin1(ep(i, k), epmax_diag(i))
+        enddo
+      enddo
+
+      ! On recalcule hp:
       do k = 1, nl
-        ep(i, k) = ep(i, k) / epmax * epmax_diag(i)
-        ep(i, k) = amax1(ep(i, k), 0.0)
-        ep(i, k) = amin1(ep(i, k), epmax_diag(i))
+        do i = 1, ncum
+          hp_bak(i, k) = hp(i, k)
+        enddo
       enddo
-    enddo
-
-    ! On recalcule hp:
-    do k = 1, nl
+      do k = 1, nlp
+        do i = 1, ncum
+          hp(i, k) = h(i, k)
+        enddo
+      enddo
+      do k = minorig + 1, nl
+        do i = 1, ncum
+          IF((k>=icb(i)).AND.(k<=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
+        enddo
+      enddo !do k=minorig+1,n
+      !     WRITE(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
       do i = 1, ncum
-        hp_bak(i, k) = hp(i, k)
-      enddo
-    enddo
-    do k = 1, nlp
-      do i = 1, ncum
-        hp(i, k) = h(i, k)
-      enddo
-    enddo
-    do k = minorig + 1, nl
-      do i = 1, ncum
-        IF((k>=icb(i)).AND.(k<=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
-      enddo
-    enddo !do k=minorig+1,n
-    !     WRITE(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
-    do i = 1, ncum
-      do k = 1, nl
-        IF (abs(hp_bak(i, k) - hp(i, k))>0.01) THEN
-          WRITE(*, *) 'i,k=', i, k
-          WRITE(*, *) 'coef_epmax_cape=', coef_epmax_cape
-          WRITE(*, *) 'epmax_diag(i)=', epmax_diag(i)
-          WRITE(*, *) 'ep(i,k)=', ep(i, k)
-          WRITE(*, *) 'hp(i,k)=', hp(i, k)
-          WRITE(*, *) 'hp_bak(i,k)=', hp_bak(i, k)
-          WRITE(*, *) 'h(i,k)=', h(i, k)
-          WRITE(*, *) 'nk(i)=', nk(i)
-          WRITE(*, *) 'h(i,nk(i))=', h(i, nk(i))
-          WRITE(*, *) 'lv(i,k)=', lv(i, k)
-          WRITE(*, *) 't(i,k)=', t(i, k)
-          WRITE(*, *) 'clw(i,k)=', clw(i, k)
-          WRITE(*, *) 'cpd,cpv=', cpd, cpv
-          CALL abort_physic(modname, abort_message, 1)
-        endif
-      enddo !do k=1,nl
-    enddo !do i=1,ncum
-  ENDIF !if (coef_epmax_cape.gt.1e-12) THEN
-END SUBROUTINE  cv30_epmax_fn_cape
-
-
+        do k = 1, nl
+          IF (abs(hp_bak(i, k) - hp(i, k))>0.01) THEN
+            WRITE(*, *) 'i,k=', i, k
+            WRITE(*, *) 'coef_epmax_cape=', coef_epmax_cape
+            WRITE(*, *) 'epmax_diag(i)=', epmax_diag(i)
+            WRITE(*, *) 'ep(i,k)=', ep(i, k)
+            WRITE(*, *) 'hp(i,k)=', hp(i, k)
+            WRITE(*, *) 'hp_bak(i,k)=', hp_bak(i, k)
+            WRITE(*, *) 'h(i,k)=', h(i, k)
+            WRITE(*, *) 'nk(i)=', nk(i)
+            WRITE(*, *) 'h(i,nk(i))=', h(i, nk(i))
+            WRITE(*, *) 'lv(i,k)=', lv(i, k)
+            WRITE(*, *) 't(i,k)=', t(i, k)
+            WRITE(*, *) 'clw(i,k)=', clw(i, k)
+            WRITE(*, *) 'cpd,cpv=', cpd, cpv
+            CALL abort_physic(modname, abort_message, 1)
+          endif
+        enddo !do k=1,nl
+      enddo !do i=1,ncum
+    ENDIF !if (coef_epmax_cape.gt.1e-12) THEN
+  END SUBROUTINE  cv30_epmax_fn_cape
+
+
+END MODULE lmdz_cv30
+
+

LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv3param.f90

@@ -1 @@
-!------------------------------------------------------------
-! Parameters for convectL, iflag_con=3:
-! (includes - microphysical parameters,
-!                       - parameters that control the rate of approach
-!               to quasi-equilibrium)
-!                       - noff & minorig (previously in input of convect1)
-!------------------------------------------------------------
+! Replaces cv3param.h
 
-      INTEGER flag_epKEorig
-      REAL flag_wb
-      INTEGER cv_flag_feed
-      INTEGER noff, minorig, nl, nlp, nlm
-      REAL sigdz, spfac
-      REAL pbcrit, ptcrit
-      REAL elcrit, tlcrit
-      REAL coef_peel
-      REAL omtrain
-      REAL dtovsh, dpbase, dttrig
-      REAL dtcrit, tau, beta, alpha, alpha1
-      REAL T_top_max
-      REAL tau_stop, noconv_stop
-      REAL wbmax
-      REAL delta
-      REAL betad
-      REAL ejectliq
-      REAL ejectice
+MODULE lmdz_cv3param
+  !------------------------------------------------------------
+  ! Parameters for convectL, iflag_con=3:
+  ! (includes - microphysical parameters,
+  !                     - parameters that control the rate of approach
+  !               to quasi-equilibrium)
+  !                     - noff & minorig (previously in input of convect1)
+  !------------------------------------------------------------
+  IMPLICIT NONE; PRIVATE
+  PUBLIC sigdz, spfac, pbcrit, ptcrit, elcrit, tlcrit, coef_peel, omtrain, dtovsh, dpbase, &
+          dttrig, dtcrit, tau, beta, alpha, alpha1, T_top_max, tau_stop, noconv_stop, wbmax, &
+          delta, betad, ejectliq, ejectice, flag_wb, flag_epKEorig, cv_flag_feed, noff, minorig, &
+          nl, nlp, nlm
 
-      COMMON /cv3param/ sigdz, spfac &
-                      ,pbcrit, ptcrit &
-                      ,elcrit, tlcrit &
-                      ,coef_peel &
-                      ,omtrain &
-                      ,dtovsh, dpbase, dttrig &
-                      ,dtcrit, tau, beta, alpha, alpha1 &
-                      ,T_top_max &
-                      ,tau_stop, noconv_stop &
-                      ,wbmax &
-                      ,delta, betad  &
-                      ,ejectliq, ejectice &
-                      ,flag_wb &
-                      ,flag_epKEorig &
-                      ,cv_flag_feed &
-                      ,noff, minorig, nl, nlp, nlm
-!$OMP THREADPRIVATE(/cv3param/)
+  INTEGER flag_epKEorig
+  REAL flag_wb
+  INTEGER cv_flag_feed
+  INTEGER noff, minorig, nl, nlp, nlm
+  REAL sigdz, spfac
+  REAL pbcrit, ptcrit
+  REAL elcrit, tlcrit
+  REAL coef_peel
+  REAL omtrain
+  REAL dtovsh, dpbase, dttrig
+  REAL dtcrit, tau, beta, alpha, alpha1
+  REAL T_top_max
+  REAL tau_stop, noconv_stop
+  REAL wbmax
+  REAL delta
+  REAL betad
+  REAL ejectliq
+  REAL ejectice
 
+  !$OMP THREADPRIVATE(sigdz, spfac, pbcrit, ptcrit, elcrit, tlcrit, coef_peel, omtrain, dtovsh, dpbase, &
+  !$OMP      dttrig, dtcrit, tau, beta, alpha, alpha1, T_top_max, tau_stop, noconv_stop, wbmax, &
+  !$OMP      delta, betad, ejectliq, ejectice, flag_wb, flag_epKEorig, cv_flag_feed, noff, minorig, &
+  !$OMP      nl, nlp, nlm)
+END MODULE lmdz_cv3param
+
+
+
+

LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cvthermo.f90

@@ +1 @@
+! Replaces cvthermo.h
 
-! $Header$
+MODULE lmdz_cvthermo
+  IMPLICIT NONE; PRIVATE
+  PUBLIC cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0, clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl  &
+          , clmci, eps, epsi, epsim1, ginv, hrd, grav
 
-! Thermodynamical constants for convectL:
+  ! Thermodynamical constants for convectL:
+  REAL cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0
+  REAL clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl, clmci
+  REAL eps, epsi, epsim1
+  REAL ginv, hrd
+  REAL grav
 
-      REAL cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0
-      REAL clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl, clmci
-      REAL eps, epsi, epsim1
-      REAL ginv, hrd
-      REAL grav
-
-      COMMON /cvthermo/ cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl &
-                       ,t0, clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl  &
-                       ,clmci, eps, epsi, epsim1, ginv, hrd, grav
-
-!$OMP THREADPRIVATE(/cvthermo/)
+  !$OMP THREADPRIVATE(cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0, clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl  &
+  !$OMP      , clmci, eps, epsi, epsim1, ginv, hrd, grav)
+END MODULE lmdz_cvthermo

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90

@@ -17 +17 @@
   ! modified by :  Filiberti M-A 06/2005 vectorisation          *
   ! **************************************************************
+USE lmdz_cvthermo
 
   IMPLICIT NONE
@@ -29 +30 @@
   ! ===============================================================
 
-  include "cvthermo.h"
   include "YOETHF.h"
   include "YOMCST.h"

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90

@@ -18 +18 @@
   ! modified by :  Filiberti M-A 06/2005 vectorisation              *
   ! ****************************************************************
+USE lmdz_cvthermo
 
   IMPLICIT NONE
@@ -30 +31 @@
   ! ===============================================================
 
-  include "cvthermo.h"
   include "YOETHF.h"
   include "YOMCST.h"

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90

@@ -11 +11 @@
   USE lmdz_conema3
   USE lmdz_cvflag
+  USE lmdz_cv3param
 
   IMPLICIT NONE
@@ -36 +37 @@
 !***                 APPROACH TO QUASI-EQUILIBRIUM           ***
 !***                     IT MUST BE LESS THAN 0              ***
-
-  include "cv3param.h"
 
   INTEGER, INTENT(IN)              :: nd
@@ -184 +183 @@
 SUBROUTINE cv3_incrcount(len, nd, delt, sig)
   USE lmdz_cvflag
+  USE lmdz_cv3param
 
 IMPLICIT NONE
@@ -190 +190 @@
 !  Increment the counter sig(nd)
 ! =====================================================================
-
-  include "cv3param.h"
 
 !inputs:
@@ -224 +222 @@
 SUBROUTINE cv3_prelim(len, nd, ndp1, t, q, p, ph, &
                       lv, lf, cpn, tv, gz, h, hm, th)
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
@@ -246 +247 @@
   REAL tvx, tvy ! convect3
   REAL cpx(len, nd)
-
-  include "cvthermo.h"
-  include "cv3param.h"
-
 
 ! ori      do 110 k=1,nlp
@@ -324 +321 @@
   USE add_phys_tend_mod, ONLY: fl_cor_ebil
   USE lmdz_print_control, ONLY: prt_level
+USE lmdz_cvthermo
+USE lmdz_cv3param
+
   IMPLICIT NONE
 
@@ -340 +340 @@
 ! - A,B explicitely defined (!...)
 ! ================================================================
-
-  include "cv3param.h"
-  include "cvthermo.h"
 
 !inputs:
@@ -699 +696 @@
 #endif
 #endif
+USE lmdz_cvthermo
+USE lmdz_cv3param
+
   IMPLICIT NONE
 
@@ -713 +713 @@
 !    - if icbs=icb, compute also tp(icb+1),tvp(icb+1) & clw(icb+1)
 ! ----------------------------------------------------------------
-
-  include "cvthermo.h"
-  include "cv3param.h"
 
 ! inputs:
@@ -1146 +1143 @@
 SUBROUTINE cv3_trigger(len, nd, icb, plcl, p, th, tv, tvp, thnk, &
                        pbase, buoybase, iflag, sig, w0)
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
@@ -1162 +1161 @@
 ! -> the buoyancy below cloud base not (yet) set to the cloud base buoyancy
 ! -------------------------------------------------------------------
-
-  include "cv3param.h"
 
 ! input:
@@ -1278 +1275 @@
 #endif
 #endif
+
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
 !inputs:
@@ -1487 +1485 @@
 #endif
 USE lmdz_cvflag
+USE lmdz_cvthermo
+USE lmdz_cv3param
+
   IMPLICIT NONE
 
@@ -1507 +1508 @@
 ! ---------------------------------------------------------------------
 
-  include "cvthermo.h"
-  include "cv3param.h"
   include "YOMCST2.h"
 
@@ -2509 +2508 @@
 END SUBROUTINE cv3_undilute2
 
-SUBROUTINE cv3_closure(nloc, ncum, nd, icb, inb, &
-                       pbase, p, ph, tv, buoy, &
+SUBROUTINE cv3_closure(nloc, ncum, nd, icb, inb, pbase, p, ph, tv, buoy, &
                        sig, w0, cape, m, iflag)
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
@@ -2519 +2520 @@
 ! vectorization: S. Bony
 ! ===================================================================
-
-  include "cvthermo.h"
-  include "cv3param.h"
 
 !input:
@@ -2784 +2782 @@
 #endif
 USE lmdz_cvflag
+USE lmdz_cvthermo
+USE lmdz_cv3param
+
   IMPLICIT NONE
 
@@ -2790 +2791 @@
 ! - vectorisation de la partie normalisation des flux (do 789...)
 ! ---------------------------------------------------------------------
-
-  include "cvthermo.h"
-  include "cv3param.h"
 
 !inputs:
@@ -3612 +3610 @@
 #endif
 USE lmdz_cvflag
+USE lmdz_cvthermo
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-
-  include "cvthermo.h"
-  include "cv3param.h"
 
 !inputs:
@@ -4718 +4715 @@
 #endif
 USE lmdz_cvflag
+USE lmdz_cvthermo
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cvthermo.h"
-  include "cv3param.h"
 
 !inputs:
@@ -7274 +7271 @@
                       ep, Vprecip, elij, clw, epmlmMm, eplaMm, &
                       icb, inb)
+  USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
 !inputs:
@@ -7409 +7406 @@
 #endif
 #endif
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
 !inputs:
@@ -7597 +7594 @@
                   USE lmdz_conema3
                   USE lmdz_cvflag
+                  USE lmdz_cvthermo
+                  USE lmdz_cv3param
 
         IMPLICIT NONE
@@ -7605 +7604 @@
         ! qui en depend
         ! Toutes les autres variables fn de ep sont calculees plus bas.
-
-  include "cvthermo.h"
-  include "cv3param.h"  
 
 ! inputs:

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_compress.F90

@@ -41 +41 @@
 #endif
   USE lmdz_abort_physic, ONLY: abort_physic
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
   ! inputs:

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_uncompress.F90

@@ -56 +56 @@
   USE infotrac_phy, ONLY: ntraciso=>ntiso
 #endif
+USE lmdz_cv3param
+
   IMPLICIT NONE
-
-  include "cv3param.h"
 
   ! inputs:

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90

@@ -40 +40 @@
 #endif
 USE lmdz_cvflag
+  USE lmdz_cvthermo
+  USE lmdz_cv3param
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
-  include "cv3param.h"
   include "YOMCST2.h"
 

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_driver.F90

@@ -42 +42 @@
 #endif
 #endif
+USE lmdz_cv30, ONLY: cv30_param, cv30_prelim, cv30_feed, cv30_undilute1, cv30_trigger, cv30_compress, cv30_undilute2, &
+          cv30_closure, cv30_epmax_fn_cape, cv30_mixing, cv30_unsat, cv30_yield, cv30_tracer, cv30_uncompress
+
   IMPLICIT NONE
 
@@ -1261 +1264 @@
 ! ==================================================================
 SUBROUTINE cv_thermo(iflag_con)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -1268 +1273 @@
 
   include "YOMCST.h"
-  include "cvthermo.h"
 
   INTEGER iflag_con

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_routines.F90

@@ -73 +73 @@
 
 SUBROUTINE cv_prelim(len, nd, ndp1, t, q, p, ph, lv, cpn, tv, gz, h, hm)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -91 +93 @@
   REAL cpx(len, nd)
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -249 +250 @@
 SUBROUTINE cv_undilute1(len, nd, t, q, qs, gz, p, nk, icb, icbmax, tp, tvp, &
         clw)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -472 +474 @@
 SUBROUTINE cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
         gz, p, dph, h, tv, lv, inb, inb1, tp, tvp, clw, hp, ep, sigp, frac)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -484 +488 @@
   ! ---------------------------------------------------------------------
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -752 +755 @@
 SUBROUTINE cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
         cpn, iflag, cbmf)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -770 +775 @@
   REAL work(nloc)
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -834 +838 @@
         h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, nent, &
         sij, elij)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -1083 +1088 @@
 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)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
   include "cvparam.h"
 
@@ -1282 +1288 @@
         ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, tprime, &
         precip, cbmf, ft, fq, fu, fv, ma, qcondc)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
-  include "cvthermo.h"
   include "cvparam.h"
 

LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_cv30.F90

@@ +1 @@
+! $Id$
+
+MODULE lmdz_cv30
+  !------------------------------------------------------------
+  ! Parameters for convectL, iflag_con=30:
+  ! (includes - microphysical parameters,
+  !                     - parameters that control the rate of approach
+  !               to quasi-equilibrium)
+  !                     - noff & minorig (previously in input of convect1)
+  !------------------------------------------------------------
+
+  IMPLICIT NONE; PRIVATE
+  PUBLIC sigd, spfac, pbcrit, ptcrit, omtrain, dtovsh, dpbase, dttrig, dtcrit, &
+          tau, beta, alpha, delta, betad, noff, minorig, nl, nlp, nlm, &
+          cv30_param, cv30_prelim, cv30_feed, cv30_undilute1, cv30_trigger, &
+          cv30_compress, cv30_undilute2, cv30_closure, cv30_mixing, cv30_unsat, &
+          cv30_yield, cv30_tracer, cv30_uncompress, cv30_epmax_fn_cape
+
+  INTEGER noff, minorig, nl, nlp, nlm
+  REAL sigd, spfac
+  REAL pbcrit, ptcrit
+  REAL omtrain
+  REAL dtovsh, dpbase, dttrig
+  REAL dtcrit, tau, beta, alpha
+  REAL delta
+  REAL betad
+
+  !$OMP THREADPRIVATE(sigd, spfac, pbcrit, ptcrit, omtrain, dtovsh, dpbase, dttrig, dtcrit, &
+  !$OMP      tau, beta, alpha, delta, betad, noff, minorig, nl, nlp, nlm)
+CONTAINS
+
 
 ! $Id$
@@ -31 +62 @@
   ! ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
   ! ***                     IT MUST BE LESS THAN 0              ***
-
-  include "cv30param.h"
-
+  
   INTEGER nd
   REAL delt ! timestep (seconds)
@@ -86 +115 @@
 SUBROUTINE cv30_prelim(len, nd, ndp1, t, q, p, ph, lv, cpn, tv, gz, h, hm, &
     th)
+
+  USE lmdz_cvthermo
   IMPLICIT NONE
 
@@ -108 +139 @@
   REAL tvx, tvy ! convect3
   REAL cpx(len, nd)
-
-  include "cvthermo.h"
-  include "cv30param.h"
 
 
@@ -184 +212 @@
   ! ================================================================
 
-  include "cv30param.h"
+  
 
   ! inputs:
@@ -389 +417 @@
 #endif
 #endif
+USE lmdz_cvthermo
 
   IMPLICIT NONE
@@ -405 +434 @@
   ! ----------------------------------------------------------------
 
-  include "cvthermo.h"
-  include "cv30param.h"
 
   ! inputs:
@@ -851 +878 @@
   ! -------------------------------------------------------------------
 
-  include "cv30param.h"
+  
 
   ! input:
@@ -961 +988 @@
   IMPLICIT NONE
 
-  include "cv30param.h"
+  
 
   ! inputs:
@@ -1154 +1181 @@
 #endif
 #endif
+USE lmdz_cvthermo
   IMPLICIT NONE
 
@@ -1173 +1201 @@
   ! - no inb1, ONLY inb in output
   ! ---------------------------------------------------------------------
-
-  include "cvthermo.h"
-  include "cv30param.h"
 
   ! inputs:
@@ -1618 +1643 @@
 SUBROUTINE cv30_closure(nloc, ncum, nd, icb, inb, pbase, p, ph, tv, buoy, &
     sig, w0, cape, m)
+  USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -1625 +1652 @@
   ! vectorization: S. Bony
   ! ===================================================================
-
-  include "cvthermo.h"
-  include "cv30param.h"
 
   ! input:
@@ -1854 +1878 @@
 #endif
 #endif
+USE lmdz_cvthermo
+
   IMPLICIT NONE
 
@@ -1861 +1887 @@
   ! - vectorisation de la partie normalisation des flux (do 789...)
   ! ---------------------------------------------------------------------
-
-  include "cvthermo.h"
-  include "cv30param.h"
 
   ! inputs:
@@ -2670 +2693 @@
 #endif
 USE lmdz_cvflag
+USE lmdz_cvthermo
 
   IMPLICIT NONE
-
-
-  include "cvthermo.h"
-  include "cv30param.h"
 
   ! inputs:
@@ -3402 +3422 @@
 #endif
 USE lmdz_cvflag
+USE lmdz_cvthermo
 
   IMPLICIT NONE
-
-  include "cvthermo.h"
-  include "cv30param.h"
-
   ! inputs:
   INTEGER ncum, nd, na, ntra, nloc
@@ -5972 +5989 @@
   IMPLICIT NONE
 
-  include "cv30param.h"
+  
 
   ! inputs:
@@ -6114 +6131 @@
   IMPLICIT NONE
 
-  include "cv30param.h"
+  
 
   ! inputs:
@@ -6338 +6355 @@
         USE lmdz_abort_physic, ONLY: abort_physic
                 USE lmdz_conema3
+        USE lmdz_cvthermo
 
         IMPLICIT NONE
@@ -6345 +6363 @@
         ! qui en depend
         ! Toutes les autres variables fn de ep sont calculees plus bas.
-
- include "cvthermo.h"
- include "cv30param.h"
 
 ! inputs:
@@ -6421 +6436 @@
 
 
+
+
+
+
+END MODULE lmdz_cv30
+
+

LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_cv3param.f90

@@ -1 @@
-link ../phylmd/cv3param.h
+link ../phylmd/lmdz_cv3param.f90

LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_cvthermo.f90

@@ -1 @@
-link ../phylmd/cvthermo.h
+link ../phylmd/lmdz_cvthermo.f90

LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90

@@ -41 +41 @@
 #endif
 #endif
+USE lmdz_cvthermo
+
   IMPLICIT NONE
   ! ============================================================================
@@ -136 +138 @@
 
   include "YOMCST.h"
-  include "cvthermo.h"
 
   ! Arguments en entree