Changeset 2007

Timestamp:

Apr 6, 2014, 2:20:38 PM (10 years ago)

Author:

fhourdin

Message:

Modification pour garantir la conservation des espèces traces.

Modification for tracer conservation

Jean-Yves Grandpeix

Location:

LMDZ5/trunk/libf/phylmd

Files:

• add_phys_tend.F90 (modified) (3 diffs)
• clesphys.h (modified) (3 diffs)
• concvl.F90 (modified) (17 diffs)
• conf_phys_m.F90 (modified) (4 diffs)
• cv3_routines.F90 (modified) (151 diffs)
• cv3p_mixing.F90 (modified) (21 diffs)
• cva_driver.F90 (modified) (30 diffs)
• cvltr.F90 (modified) (5 diffs)
• cvltr_noscav.F90 (added)
• physiq.F90 (modified) (3 diffs)
• phytrac_mod.F90 (modified) (4 diffs)

LMDZ5/trunk/libf/phylmd/add_phys_tend.F90

@@ -18 +18 @@
 use phys_state_var_mod
 IMPLICIT none
-#include "iniprint.h"
-#include "YOMCST.h"
+  include "iniprint.h"
+  include "YOMCST.h"
+  include "clesphys.h"
 
 ! Arguments :
@@ -117 +118 @@
       DO j = 1, jqbad
         i=jqadrs(j)
-        IF (.NOT.done(i)) THEN                  !jyg
           if(prt_level.ge.debug_level) THEN
            print*,'WARNING  : EAU POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
@@ -125 +125 @@
            ENDDO
           endif
+          IF (ok_conserv_q) THEN
 !jyg<20140228 Corrections pour conservation de l'eau
-          DO k = 1, klev
-            zqp(k) = max(q_seri(i,k),1.e-15)
-          ENDDO
-          zq_int  = 0.
-          zqp_int = 0.
-          DO k = 1, klev
-            zq_int  = zq_int  + q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/Rg
-            zqp_int = zqp_int + zqp(k)     *(paprs(i,k)-paprs(i,k+1))/Rg
-          ENDDO
-          if(prt_level.ge.debug_level) THEN
-           print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', &
-                                i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int
-          endif
-          DO k = 1, klev
-            zq_new = zqp(k)*zq_int/zqp_int
-            zdq(i,k) = zdq(i,k) + zq_new - q_seri(i,k)
-            q_seri(i,k) = zq_new
-          ENDDO
-          done(i) = .true.
-        ENDIF !(.NOT.done(i))
-
-!         DO k = 1, klev
-!           zq=q_seri(i,k)+zdq(i,k)
-!           if (zq.lt.1.e-15) then
-!              if (q_seri(i,k).lt.1.e-15) then
-!               if(prt_level.ge.debug_level) THEN
-!                print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
-!               endif
-!               q_seri(i,k)=1.e-15
-!               zdq(i,k)=(1.e-15-q_seri(i,k))
+            IF (.NOT.done(i)) THEN                  !jyg
+              DO k = 1, klev
+                zqp(k) = max(q_seri(i,k),1.e-15)
+              ENDDO
+              zq_int  = 0.
+              zqp_int = 0.
+              DO k = 1, klev
+                zq_int  = zq_int  + q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/Rg
+                zqp_int = zqp_int + zqp(k)     *(paprs(i,k)-paprs(i,k+1))/Rg
+              ENDDO
+              if(prt_level.ge.debug_level) THEN
+               print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', &
+                                    i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int
+              endif
+              DO k = 1, klev
+                zq_new = zqp(k)*zq_int/zqp_int
+                zdq(i,k) = zdq(i,k) + zq_new - q_seri(i,k)
+                q_seri(i,k) = zq_new
+              ENDDO
+              done(i) = .true.
+            ENDIF !(.NOT.done(i))
+          ELSE 
+!jyg>
+            DO k = 1, klev
+              zq=q_seri(i,k)+zdq(i,k)
+              if (zq.lt.1.e-15) then
+                 if (q_seri(i,k).lt.1.e-15) then
+                  if(prt_level.ge.debug_level) THEN
+                   print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
+                  endif
+                  q_seri(i,k)=1.e-15
+                  zdq(i,k)=(1.e-15-q_seri(i,k))
+                 endif
+              endif
+!              zq=q_seri(i,k)+zdq(i,k)
+!              if (zq.lt.1.e-15) then
+!                 zdq(i,k)=(1.e-15-q_seri(i,k))
 !              endif
-!           endif
-!!           zq=q_seri(i,k)+zdq(i,k)
-!!           if (zq.lt.1.e-15) then
-!!              zdq(i,k)=(1.e-15-q_seri(i,k))
-!!           endif
-!         ENDDO
+            ENDDO
+!jyg<20140228
+          ENDIF   !  (ok_conserv_q)
 !jyg>
-      ENDDO
+      ENDDO ! j = 1, jqbad
 ENDIF
 !

LMDZ5/trunk/libf/phylmd/clesphys.h

@@ -18 +18 @@
        REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
 !IM ajout CFMIP2/CMIP5
-       REAL co2_ppm_per
        LOGICAL ok_4xCO2atm
        REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per
@@ -77 +76 @@
        LOGICAL :: ok_strato
        LOGICAL :: ok_hines, ok_gwd_rando
+       LOGICAL :: ok_conserv_q
 
        COMMON/clesphys/                                                 &
 ! REAL FIRST
-     &       co2_ppm, co2_ppm_per, solaire                              &
+     &       co2_ppm, solaire                                           &
      &     , RCO2, RCH4, RN2O, RCFC11, RCFC12                           &
      &     , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act       &
@@ -114 +114 @@
      &     , ok_lic_melt,           aer_type                            &
      &     , iflag_rrtm, ok_strato,ok_hines                             &
-     &     , iflag_ice_thermo, ok_gwd_rando, NSW
+     &     , iflag_ice_thermo, ok_gwd_rando, NSW                        &
+     &     , ok_conserv_q
      
        save /clesphys/

LMDZ5/trunk/libf/phylmd/concvl.F90

@@ -1 @@
-SUBROUTINE concvl(iflag_clos, dtime, paprs, pplay, t, q, t_wake, q_wake, &
-    s_wake, u, v, tra, ntra, ale, alp, sig1, w01, d_t, d_q, d_u, d_v, d_tra, &
-    rain, snow, kbas, ktop, sigd, cbmf, plcl, plfc, wbeff, upwd, dnwd, &
-    dnwdbis, ma, mip, vprecip, cape, cin, tvp, tconv, iflag, pbase, bbase, &
-    dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, & ! RomP
-                                                                      ! >>>
-  ! !     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
-    da, phi, mp, phi2, d1a, dam, sij, clw, elij, & ! RomP
-    dd_t, dd_q, lalim_conv, wght_th, & ! RomP
-    evap, ep, epmlmmm, eplamm, &   ! RomP
-    wdtraina, wdtrainm) ! RomP
-  ! RomP <<<
-  ! **************************************************************
-  ! *
-  ! CONCVL                                                      *
-  ! *
-  ! *
-  ! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
-  ! modified by :                                               *
-  ! **************************************************************
+SUBROUTINE concvl(iflag_clos, &
+                  dtime, paprs, pplay, &
+                  t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
+                  Ale, Alp, sig1, w01, &
+                  d_t, d_q, d_u, d_v, d_tra, &
+                  rain, snow, kbas, ktop, sigd, &
+                  cbmf, plcl, plfc, wbeff, upwd, dnwd, dnwdbis, &
+                  Ma, mip, Vprecip, &
+                  cape, cin, tvp, Tconv, iflag, &
+                  pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
+                  qcondc, wd, pmflxr, pmflxs, &
+!RomP >>>
+!!     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
+                  da, phi, mp, phi2, d1a, dam, sij, clw, elij, &     ! RomP
+                  dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
+                  evap, ep, epmlmMm, eplaMm, &                       ! RomP
+                  wdtrainA, wdtrainM, wght)                          ! RomP+RL
+!RomP <<<
+! **************************************************************
+! *
+! CONCVL                                                      *
+! *
+! *
+! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
+! modified by :                                               *
+! **************************************************************
 
 
@@ -24 +30 @@
   USE infotrac, ONLY: nbtr
   IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
-  ! Objet: schema de convection de Emanuel (1991) interface
-  ! ======================================================================
-  ! Arguments:
-  ! dtime--input-R-pas d'integration (s)
-  ! s-------input-R-la valeur "s" pour chaque couche
-  ! sigs----input-R-la valeur "sigma" de chaque couche
-  ! sig-----input-R-la valeur de "sigma" pour chaque niveau
-  ! psolpa--input-R-la pression au sol (en Pa)
-  ! pskapa--input-R-exponentiel kappa de psolpa
-  ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
-  ! q-------input-R-vapeur d'eau (en kg/kg)
-
-  ! work*: input et output: deux variables de travail,
-  ! on peut les mettre a 0 au debut
-  ! ALE-----input-R-energie disponible pour soulevement
-  ! ALP-----input-R-puissance disponible pour soulevement
-
-  ! d_h-----output-R-increment de l'enthalpie potentielle (h)
-  ! d_q-----output-R-increment de la vapeur d'eau
-  ! rain----output-R-la pluie (mm/s)
-  ! snow----output-R-la neige (mm/s)
-  ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
-  ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
-  ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
-  ! Ma------output-R-adiabatic ascent mass flux (kg/m2/s)
-  ! mip-----output-R-mass flux shed by adiabatic ascent (kg/m2/s)
-  ! Vprecip-output-R-vertical profile of precipitations (kg/m2/s)
-  ! Tconv---output-R-environment temperature seen by convective scheme (K)
-  ! Cape----output-R-CAPE (J/kg)
-  ! Cin ----output-R-CIN  (J/kg)
-  ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
-  ! adiabatiquement a partir du niveau 1 (K)
-  ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
-  ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
-  ! dd_t-----output-R-increment de la temperature du aux descentes
-  ! precipitantes
-  ! dd_q-----output-R-increment de la vapeur d'eau du aux desc precip
-  ! ======================================================================
+! ======================================================================
+! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
+! Objet: schema de convection de Emanuel (1991) interface
+! ======================================================================
+! Arguments:
+! dtime--input-R-pas d'integration (s)
+! s-------input-R-la vAleur "s" pour chaque couche
+! sigs----input-R-la vAleur "sigma" de chaque couche
+! sig-----input-R-la vAleur de "sigma" pour chaque niveau
+! psolpa--input-R-la pression au sol (en Pa)
+! pskapa--input-R-exponentiel kappa de psolpa
+! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa)
+! q-------input-R-vapeur d'eau (en kg/kg)
+
+! work*: input et output: deux variables de travail,
+! on peut les mettre a 0 au debut
+! ALE--------input-R-energie disponible pour soulevement
+! ALP--------input-R-puissance disponible pour soulevement
+
+! d_h--------output-R-increment de l'enthAlpie potentielle (h)
+! d_q--------output-R-increment de la vapeur d'eau
+! rain-------output-R-la pluie (mm/s)
+! snow-------output-R-la neige (mm/s)
+! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
+! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
+! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
+! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
+! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
+! Vprecip----output-R-vertical profile of precipitations (kg/m2/s)
+! Tconv------output-R-environment temperature seen by convective scheme (K)
+! Cape-------output-R-CAPE (J/kg)
+! Cin -------output-R-CIN  (J/kg)
+! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
+! adiabatiquement a partir du niveau 1 (K)
+! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
+! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
+! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
+! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
+! lalim_conv-
+! wght_th----
+! evap-------output-R
+! ep---------output-R
+! epmlmMm----output-R
+! eplaMm-----output-R
+! wdtrainA---output-R
+! wdtrainM---output-R
+! wght-------output-R
+! ======================================================================
 
 
@@ -79 +93 @@
   REAL sig1(klon, klev), w01(klon, klev), ptop2(klon)
   REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
-  REAL ale(klon), alp(klon)
+  REAL Ale(klon), Alp(klon)
 
   REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev)
@@ -90 +104 @@
   REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
 
-  ! !       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)     !jyg
-  REAL ma(klon, klev), mip(klon, klev), vprecip(klon, klev+1) !jyg
+!!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)     !jyg
+  REAL Ma(klon, klev), mip(klon, klev), Vprecip(klon, klev+1)      !jyg
+  REAL wght(klon, klev)                                            !RL
 
   REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
-  ! RomP >>>
+! RomP >>>
   REAL phi2(klon, klev, klev)
   REAL d1a(klon, klev), dam(klon, klev)
   REAL sij(klon, klev, klev), clw(klon, klev), elij(klon, klev, klev)
-  REAL wdtraina(klon, klev), wdtrainm(klon, klev)
+  REAL wdtrainA(klon, klev), wdtrainM(klon, klev)
   REAL evap(klon, klev), ep(klon, klev)
-  REAL epmlmmm(klon, klev, klev), eplamm(klon, klev)
-  ! RomP <<<
+  REAL epmlmMm(klon, klev, klev), eplaMm(klon, klev)
+! RomP <<<
   REAL cape(klon), cin(klon), tvp(klon, klev)
-  REAL tconv(klon, klev)
-
-  ! CR:test: on passe lentr et alim_star des thermiques
+  REAL Tconv(klon, klev)
+
+!CR:test: on passe lentr et alim_star des thermiques
   INTEGER lalim_conv(klon)
   REAL wght_th(klon, klev)
@@ -111 +126 @@
   REAL em_sig2feed ! sigma at upper bound of feeding layer
   REAL em_wght(klev) ! weight density determining the feeding mixture
-  ! on enleve le save
-  ! SAVE em_sig1feed,em_sig2feed,em_wght
+!on enleve le save
+! SAVE em_sig1feed,em_sig2feed,em_wght
 
   INTEGER iflag(klon)
@@ -127 +142 @@
   REAL zx_t, zdelta, zx_qs, zcor
 
-  ! INTEGER iflag_mix
-  ! SAVE iflag_mix
+!   INTEGER iflag_mix
+!   SAVE iflag_mix
   INTEGER noff, minorig
   INTEGER i, k, itra
   REAL qs(klon, klev), qs_wake(klon, klev)
   REAL cbmf(klon), plcl(klon), plfc(klon), wbeff(klon)
-  ! LF       SAVE cbmf
-  ! IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
-  ! cc$OMP THREADPRIVATE(cbmf)!
+!LF          SAVE cbmf
+!IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
+!!!$OMP THREADPRIVATE(cbmf)!
   REAL cbmflast(klon)
   INTEGER ifrst
   SAVE ifrst
   DATA ifrst/0/
-  !$OMP THREADPRIVATE(ifrst)
-
-
-  ! Variables supplementaires liees au bilan d'energie
-  ! Real paire(klon)
-  ! LF      Real ql(klon,klev)
-  ! Save paire
-  ! LF      Save ql
-  ! LF      Real t1(klon,klev),q1(klon,klev)
-  ! LF      Save t1,q1
-  ! Data paire /1./
+!$OMP THREADPRIVATE(ifrst)
+
+
+! Variables supplementaires liees au bilan d'energie
+! Real paire(klon)
+!LF      Real ql(klon,klev)
+! Save paire
+!LF      Save ql
+!LF      Real t1(klon,klev),q1(klon,klev)
+!LF      Save t1,q1
+! Data paire /1./
   REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
-  !$OMP THREADPRIVATE(ql, q1, t1)
-
-  ! Variables liees au bilan d'energie et d'enthalpi
+!$OMP THREADPRIVATE(ql, q1, t1)
+
+! Variables liees au bilan d'energie et d'enthAlpi
   REAL ztsol(klon)
-  REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, h_qs_tot, qw_tot, ql_tot, &
-    qs_tot, ec_tot
-  SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, h_qs_tot, qw_tot, ql_tot, &
-    qs_tot, ec_tot
-  !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
-  !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
-  REAL d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
-  REAL d_h_vcol_phy
-  REAL fs_bound, fq_bound
-  SAVE d_h_vcol_phy
-  !$OMP THREADPRIVATE(d_h_vcol_phy)
-  REAL zero_v(klon)
+  REAL        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
+              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
+  SAVE        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
+              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
+!$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
+!$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
+  REAL        d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
+  REAL        d_h_vcol_phy
+  REAL        fs_bound, fq_bound
+  SAVE        d_h_vcol_phy
+!$OMP THREADPRIVATE(d_h_vcol_phy)
+  REAL        zero_v(klon)
   CHARACTER *15 ztit
-  INTEGER ip_ebil ! PRINT level for energy conserv. diag.
-  SAVE ip_ebil
-  DATA ip_ebil/2/
-  !$OMP THREADPRIVATE(ip_ebil)
-  INTEGER if_ebil ! level for energy conserv. dignostics
-  SAVE if_ebil
-  DATA if_ebil/2/
-  !$OMP THREADPRIVATE(if_ebil)
-  ! +jld ec_conser
+  INTEGER     ip_ebil ! PRINT level for energy conserv. diag.
+  SAVE        ip_ebil
+  DATA        ip_ebil/2/
+!$OMP THREADPRIVATE(ip_ebil)
+  INTEGER     if_ebil ! level for energy conserv. dignostics
+  SAVE        if_ebil
+  DATA        if_ebil/2/
+!$OMP THREADPRIVATE(if_ebil)
+!+jld ec_conser
   REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
   REAL zrcpd
-  ! -jld ec_conser
-  ! LF
+!-jld ec_conser
+!LF
   INTEGER nloc
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-  INTEGER, SAVE :: itap, igout
-  !$OMP THREADPRIVATE(itap, igout)
+  LOGICAL, SAVE            :: first = .TRUE.
+!$OMP THREADPRIVATE(first)
+  INTEGER, SAVE            :: itap, igout
+!$OMP THREADPRIVATE(itap, igout)
 
   include "YOMCST.h"
@@ -195 +210 @@
 
   IF (first) THEN
-    ! Allocate some variables LF 04/2008
-
-    ! IM/JYG allocate(cbmf(klon))
+! Allocate some variables LF 04/2008
+
+!IM/JYG allocate(cbmf(klon))
     ALLOCATE (ql(klon,klev))
     ALLOCATE (t1(klon,klev))
@@ -204 +219 @@
     igout = klon/2 + 1/klon
   END IF
-  ! Incrementer le compteur de la physique
+! Incrementer le compteur de la physique
   itap = itap + 1
 
-  ! Copy T into Tconv
+! Copy T into Tconv
   DO k = 1, klev
     DO i = 1, klon
-      tconv(i, k) = t(i, k)
+      Tconv(i, k) = t(i, k)
     END DO
   END DO
@@ -224 +239 @@
   END IF
 
-  ! ym
+! ym
   snow(:) = 0
 
-  ! IF (ifrst .EQ. 0) THEN
-  ! ifrst = 1
+! IF (ifrst .EQ. 0) THEN
+! ifrst = 1
   IF (first) THEN
     first = .FALSE.
 
-    ! ===========================================================================
-    ! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
-    ! ===========================================================================
+! ===========================================================================
+! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
+! ===========================================================================
 
     IF (iflag_con==3) THEN
-      ! CALL cv3_inicp()
+!      CALL cv3_inicp()
       CALL cv3_inip()
     END IF
 
-    ! ===========================================================================
-    ! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
-    ! ===========================================================================
-
-    ! c$$$         open (56,file='supcrit.data')
-    ! c$$$         read (56,*) Supcrit1, Supcrit2
-    ! c$$$         close (56)
-
-    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, &
-      supcrit2
-
-    ! ===========================================================================
-    ! Initialisation pour les bilans d'eau et d'energie
-    ! ===========================================================================
+! ===========================================================================
+! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
+! ===========================================================================
+
+! c$$$         open (56,file='supcrit.data')
+! c$$$         read (56,*) Supcrit1, Supcrit2
+! c$$$         close (56)
+
+    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
+
+! ===========================================================================
+! Initialisation pour les bilans d'eau et d'energie
+! ===========================================================================
     IF (if_ebil>=1) d_h_vcol_phy = 0.
 
     DO i = 1, klon
       cbmf(i) = 0.
-      ! !          plcl(i) = 0.
+!!          plcl(i) = 0.
       sigd(i) = 0.
     END DO
   END IF !(ifrst .EQ. 0)
 
-  ! Initialisation a chaque pas de temps
+! Initialisation a chaque pas de temps
   plfc(:) = 0.
   wbeff(:) = 100.
@@ -284 +298 @@
 
 
-  ! Feeding layer
+! Feeding layer
 
   em_sig1feed = 1.
   em_sig2feed = 0.97
-  ! em_sig2feed = 0.8
-  ! Relative Weight densities
+! em_sig2feed = 0.8
+! Relative Weight densities
   DO k = 1, klev
     em_wght(k) = 1.
   END DO
-  ! CRtest: couche alim des tehrmiques ponderee par a*
-  ! DO i = 1, klon
-  ! do k=1,lalim_conv(i)
-  ! em_wght(k)=wght_th(i,k)
-  ! print*,'em_wght=',em_wght(k),wght_th(i,k)
-  ! end do
-  ! END DO
+!CRtest: couche alim des tehrmiques ponderee par a*
+! DO i = 1, klon
+! do k=1,lalim_conv(i)
+! em_wght(k)=wght_th(i,k)
+! print*,'em_wght=',em_wght(k),wght_th(i,k)
+! end do
+! END DO
 
   IF (iflag_con==4) THEN
@@ -318 +332 @@
       END DO
     END DO
-  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la
-    ! convergence numerique)
+  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
     DO k = 1, klev
       DO i = 1, klon
@@ -342 +355 @@
   END IF ! iflag_con
 
-  ! ------------------------------------------------------------------
-
-  ! Main driver for convection:
-  ! iflag_con=3 -> nvlle version de KE (JYG)
-  ! iflag_con = 30  -> equivalent to convect3
-  ! iflag_con = 4  -> equivalent to convect1/2
+! ------------------------------------------------------------------
+
+! Main driver for convection:
+!                   iflag_con=3 -> nvlle version de KE (JYG)
+!                   iflag_con = 30  -> equivAlent to convect3
+!                   iflag_con = 4  -> equivAlent to convect1/2
 
 
   IF (iflag_con==30) THEN
 
-    ! print *, '-> cv_driver'      !jyg
-    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, t, q, qs, u, v, tra, &
-      em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain, vprecip, cbmf, &
-      sig1, w01, &                 !jyg
-      kbas, ktop, dtime, ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, da, phi, &
-      mp, phi2, d1a, dam, sij, clw, elij, & !RomP
-      evap, ep, epmlmmm, eplamm, & !RomP
-      wdtraina, wdtrainm) !RomP
-    ! print *, 'cv_driver ->'      !jyg
-
-    DO i = 1, klon
-      cbmf(i) = ma(i, kbas(i))
-    END DO
+! print *, '-> cv_driver'      !jyg
+    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
+                   t, q, qs, u, v, tra, &
+                   em_p, em_ph, iflag, &
+                   d_t, d_q, d_u, d_v, d_tra, rain, &
+                   Vprecip, cbmf, sig1, w01, & !jyg
+                   kbas, ktop, &
+                   dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
+                   da, phi, mp, phi2, d1a, dam, sij, clw, elij, &       !RomP
+                   evap, ep, epmlmMm, eplaMm, &                         !RomP
+                   wdtrainA, wdtrainM)                                  !RomP
+!           print *, 'cv_driver ->'      !jyg
+
+    DO i = 1, klon
+      cbmf(i) = Ma(i, kbas(i))
+    END DO
+
+!RL
+    wght(:, :) = 0.
+    DO i = 1, klon
+      wght(i, 1) = 1.
+    END DO
+!RL
 
   ELSE
 
-    ! LF   necessary for gathered fields
+!LF   necessary for gathered fields
     nloc = klon
-    CALL cva_driver(klon, klev, klev+1, ntra, nloc, iflag_con, iflag_mix, &
-      iflag_ice_thermo, iflag_clos, dtime, t, q, qs, t_wake, q_wake, qs_wake, &
-      s_wake, u, v, tra, em_p, em_ph, ale, alp, em_sig1feed, em_sig2feed, &
-      em_wght, iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, cbmf, &
-      plcl, plfc, wbeff, sig1, w01, ptop2, sigd, ma, mip, vprecip, upwd, &
-      dnwd, dnwdbis, qcondc, wd, cape, cin, tvp, dd_t, dd_q, plim1, plim2, &
-      asupmax, supmax0, asupmaxmin, lalim_conv, & ! AC!+!RomP+jyg
-      da, phi, mp, phi2, d1a, dam, sij, clw, elij, & ! RomP
-      evap, ep, epmlmmm, eplamm, & ! RomP
-      wdtraina, wdtrainm) ! RomP
-    ! AC!+!RomP+jyg
+    CALL cva_driver(klon, klev, klev+1, ntra, nloc, &
+                    iflag_con, iflag_mix, iflag_ice_thermo, &
+                    iflag_clos, ok_conserv_q, dtime, &
+                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
+                    em_p, em_ph, &
+                    Ale, Alp, &
+                    em_sig1feed, em_sig2feed, em_wght, &
+                    iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, &
+                    cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
+                    Ma, mip, Vprecip, upwd, dnwd, dnwdbis, qcondc, wd, &
+                    cape, cin, tvp, &
+                    dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
+                    asupmaxmin, lalim_conv, &
+!AC!+!RomP+jyg
+!!                   da,phi,mp,phi2,d1a,dam,sij,clw,elij, &               ! RomP
+!!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
+                    da, phi, mp, phi2, d1a, dam, sij, wght, &           ! RomP+RL
+                    clw, elij, evap, ep, epmlmMm, eplaMm, &             ! RomP+RL
+                    wdtrainA, wdtrainM)                                 ! RomP
+!AC!+!RomP+jyg
   END IF
-  ! ------------------------------------------------------------------
-  IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff ' &
-    , cbmf(1), plcl(1), plfc(1), wbeff(1)
+! ------------------------------------------------------------------
+  IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff ', &
+                                         cbmf(1), plcl(1), plfc(1), wbeff(1)
 
   DO i = 1, klon
@@ -404 +436 @@
       DO k = 1, klev
         DO i = 1, klon
-          d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
+!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
+          d_tra(i, k, itra) = 0.
         END DO
       END DO
@@ -410 +443 @@
   END IF
 
-  ! !AC!
+!!AC!
   IF (iflag_con==3) THEN
     DO itra = 1, ntra
       DO k = 1, klev
         DO i = 1, klon
-          d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
+!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
+          d_tra(i, k, itra) = 0.
         END DO
       END DO
     END DO
   END IF
-  ! !AC!
+!!AC!
 
   DO k = 1, klev
@@ -428 +462 @@
     END DO
   END DO
-  ! !jyg
-  ! --Separation neige/pluie (pour diagnostics)       !jyg
-  DO k = 1, klev !jyg
-    DO i = 1, klon !jyg
-      IF (t1(i,k)<rtt) THEN !jyg
-        pmflxs(i, k) = vprecip(i, k) !jyg
-      ELSE !jyg
-        pmflxr(i, k) = vprecip(i, k) !jyg
-      END IF !jyg
-    END DO !jyg
-  END DO !jyg
-
-  ! c      IF (if_ebil.ge.2) THEN
-  ! c        ztit='after convect'
-  ! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
-  ! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
-  ! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-  ! c         call diagphy(paire,ztit,ip_ebil
-  ! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
-  ! c     e      , zero_v, rain, zero_v, ztsol
-  ! c     e      , d_h_vcol, d_qt, d_ec
-  ! c     s      , fs_bound, fq_bound )
-  ! c      END IF
-
-
-  ! les traceurs ne sont pas mis dans cette version de convect4:
+!                                                   !jyg
+! --Separation neige/pluie (pour diagnostics)       !jyg
+  DO k = 1, klev                                    !jyg
+    DO i = 1, klon                                  !jyg
+      IF (t1(i,k)<rtt) THEN                         !jyg
+        pmflxs(i, k) = Vprecip(i, k)                !jyg
+      ELSE                                          !jyg
+        pmflxr(i, k) = Vprecip(i, k)                !jyg
+      END IF                                        !jyg
+    END DO                                          !jyg
+  END DO                                            !jyg
+
+! c      IF (if_ebil.ge.2) THEN
+! c        ztit='after convect'
+! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
+! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
+! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+! c         call diagphy(paire,ztit,ip_ebil
+! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+! c     e      , zero_v, rain, zero_v, ztsol
+! c     e      , d_h_vcol, d_qt, d_ec
+! c     s      , fs_bound, fq_bound )
+! c      END IF
+
+
+! les traceurs ne sont pas mis dans cette version de convect4:
   IF (iflag_con==4) THEN
     DO itra = 1, ntra
@@ -463 +497 @@
     END DO
   END IF
-  ! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
+! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
 
   DO k = 1, klev
@@ -478 +512 @@
   IF (prt_level>=20) THEN
     DO k = 1, klev
-      ! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout
-      ! .,k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k),
-      ! .d_q_con(igout,k),dql0(igout,k)
-      ! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q'
-      ! .,itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout),
-      ! . t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
-      ! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip'
-      ! .,itap,rain_con(igout),snow_con(igout),ema_work1(igout,k),
-      ! .ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
-      ! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv '
-      ! .,itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout),
-      ! .tvp(igout,k),Tconv(igout,k)
-      ! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc'
-      ! .,itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout),
-      ! .dplcldr(igout),qcondc(igout,k)
-      ! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1'
-      ! .,itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k)
-      ! .,pmflxs(igout,k+1)
-      ! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth',
-      ! .itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k),
-      ! . fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
+! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
+!         k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
+!         d_q_con(igout,k),dql0(igout,k)
+! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
+!         itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
+!         t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
+! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
+!         itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
+!         ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
+! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
+!         itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
+!         tvp(igout,k),Tconv(igout,k)
+! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
+!         itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
+!         dplcldr(igout),qcondc(igout,k)
+! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
+!         itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
+!         pmflxs(igout,k+1)
+! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
+!         itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
+!         fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
     END DO
   END IF !(prt_level.EQ.20) THEN

LMDZ5/trunk/libf/phylmd/conf_phys_m.F90

@@ -182 +182 @@
     INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
     INTEGER, SAVE :: iflag_ener_conserv_omp
+    LOGICAL, SAVE :: ok_conserv_q_omp
     INTEGER, SAVE :: iflag_fisrtilp_qsat_omp
     LOGICAL,SAVE :: ok_strato_omp
@@ -696 +697 @@
     iflag_ener_conserv_omp = -1
     CALL getin('iflag_ener_conserv',iflag_ener_conserv_omp)
+
+    !Config  Key  = ok_conserv_q
+    !Config  Desc = Switch des corrections de conservation de l'eau
+    !Config  Def  = y
+    !Config  Help = Switch des corrections de conservation de l'eau
+    !Config         y -> corrections activees
+    !Config         n -> conformite avec versions anterieures au 1/4/2014
+    ok_conserv_q_omp = .TRUE.
+    CALL getin('ok_conserv_q',ok_conserv_q_omp)
 
     !Config  Key  = iflag_fisrtilp_qsat
@@ -1758 +1768 @@
     iflag_con = iflag_con_omp
     iflag_ener_conserv = iflag_ener_conserv_omp
+    ok_conserv_q = ok_conserv_q_omp
     iflag_fisrtilp_qsat = iflag_fisrtilp_qsat_omp
 
@@ -1984 +1995 @@
     write(lunout,*)'iflag_con=',iflag_con
     write(lunout,*)'iflag_ener_conserv=',iflag_ener_conserv
+    write(lunout,*)'ok_conserv_q=',ok_conserv_q
     write(lunout,*)'iflag_fisrtilp_qsat=',iflag_fisrtilp_qsat
     write(lunout,*)' epmax = ', epmax

LMDZ5/trunk/libf/phylmd/cv3_routines.F90

@@ -7 +7 @@
   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              ***
+!------------------------------------------------------------
+!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"
@@ -41 +41 @@
 
   LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-
-  ! noff: integer limit for convection (nd-noff)
-  ! minorig: First level of convection
-
-  ! -- limit levels for convection:
+!$OMP THREADPRIVATE(first)
+
+!glb  noff: integer limit for convection (nd-noff)
+! minorig: First level of convection
+
+! -- limit levels for convection:
 
   noff = 1
@@ -56 +56 @@
   IF (first) THEN
 
-    ! -- "microphysical" parameters:
+!$OMP MASTER
+! -- "microphysical" parameters:
     sigdz = 0.01
     spfac = 0.15
     pbcrit = 150.0
     ptcrit = 500.0
-    ! IM beg: ajout fis. reglage ep
+! IM beg: ajout fis. reglage ep
     flag_epkeorig = 1
     elcrit = 0.0003
     tlcrit = -55.0
-    ! IM lu dans physiq.def via conf_phys.F90     epmax  = 0.993
+! 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
     dpbase = -40. ! definition cloud base (400m above LCL)
-    ! cc      dttrig = 5.   ! (loose) condition for triggering
+! cc      dttrig = 5.   ! (loose) condition for triggering
     dttrig = 10. ! (loose) condition for triggering
     flag_wb = 1
     wbmax = 6. ! (m/s) adiab updraught speed at LFC (used in cv3p1_closure)
 
-    ! -- rate of approach to quasi-equilibrium:
+! -- rate of approach to quasi-equilibrium:
 
     dtcrit = -2.0
     tau = 8000.
 
-    ! -- interface cloud parameterization:
+! -- 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)
 
-    OPEN (99, FILE='conv_param.data', STATUS='old', FORM='formatted', &
-      ERR=9999)
+    OPEN (99, FILE='conv_param.data', STATUS='old', FORM='formatted', ERR=9999)
     READ (99, *, END=9998) dpbase
     READ (99, *, END=9998) pbcrit
@@ -113 +113 @@
     WRITE (*, *) 'wbmax =', wbmax
 
-    ! IM Lecture du fichier ep_param.data
+! IM Lecture du fichier ep_param.data
     OPEN (79, FILE='ep_param.data', STATUS='old', FORM='formatted', ERR=7999)
     READ (79, *, END=7998) flag_epkeorig
@@ -124 +124 @@
     WRITE (*, *) 'elcrit=', elcrit
     WRITE (*, *) 'tlcrit=', tlcrit
-    ! IM end: ajout fis. reglage ep
+! IM end: ajout fis. reglage ep
 
     first = .FALSE.
-  END IF
+!$OMP END MASTER
+
+  END IF ! (first)
 
   beta = 1.0 - delt/tau
   alpha1 = 1.5E-3
-  ! jyg    Correction bug alpha
+!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
+!JYG    Bug
+! cc increase alpha to compensate W decrease:
+! c      alpha  = alpha*1.5
 
   RETURN
 END SUBROUTINE cv3_param
 
-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)
   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
@@ -170 +172 @@
 
 
-  ! 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)
+! 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)
       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)
+! 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)
@@ -187 +189 @@
   END DO
 
-  ! gz = phi at the full levels (same as p).
+! 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
+! 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
@@ -221 +223 @@
 END SUBROUTINE cv3_prelim
 
-SUBROUTINE cv3_feed(len, nd, t, q, u, v, p, ph, hm, gz, p1feed, p2feed, wght, &
-    wghti, tnk, thnk, qnk, qsnk, unk, vnk, cpnk, hnk, nk, icb, icbmax, iflag, &
-    gznk, plcl)
+SUBROUTINE cv3_feed(len, nd, ok_conserv_q, &
+                    t, q, u, v, p, ph, hm, gz, &
+                    p1feed, p2feed, wght, &
+                    wghti, tnk, thnk, qnk, qsnk, unk, vnk, &
+                    cpnk, hnk, nk, icb, icbmax, iflag, 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 (!...)
-  ! ================================================================
+! ================================================================
+! 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 "cv3param.h"
   include "cvthermo.h"
 
-  ! inputs:
+!inputs:
   INTEGER len, nd
+  LOGICAL ok_conserv_q
   REAL t(len, nd), q(len, nd), p(len, nd)
   REAL u(len, nd), v(len, nd)
@@ -250 +255 @@
   REAL ph(len, nd+1)
   REAL p1feed(len)
-  ! ,  wght(len)
+! ,  wght(len)
   REAL wght(nd)
-  ! input-output
+!input-output
   REAL p2feed(len)
-  ! outputs:
+!outputs:
   INTEGER iflag(len), nk(len), icb(len), icbmax
-  ! real   wghti(len)
+!   real   wghti(len)
   REAL wghti(len, nd)
   REAL tnk(len), thnk(len), qnk(len), qsnk(len)
@@ -263 +268 @@
   REAL plcl(len)
 
-  ! local variables:
+!local variables:
   INTEGER i, k, iter, niter
   INTEGER ihmin(len)
@@ -269 +274 @@
   REAL pup(len), plo(len), pfeed(len)
   REAL plclup(len), plcllo(len), plclfeed(len)
+  REAL pfeedmin(len)
   REAL posit(len)
   LOGICAL nocond(len)
 
-  ! -------------------------------------------------------------------
-  ! --- Origin level of ascending parcels for convect3:
-  ! -------------------------------------------------------------------
+!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)
+  DATA first/.TRUE./
+  DATA dp_lcl_feed/2./
+
+  IF (first) THEN
+!$OMP MASTER
+    ok_new_feed = ok_conserv_q
+    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
+      CLOSE (98)
+    END IF
+    PRINT *, ' ok_new_feed: ', ok_new_feed
+    first = .FALSE.
+!$OMP END MASTER
+  END IF
+!jyg>
+! -------------------------------------------------------------------
+! --- Origin level of ascending parcels for convect3:
+! -------------------------------------------------------------------
 
   DO i = 1, len
@@ -281 +310 @@
   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 to 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
-  CALL cv3_vertmix(len, nd, iflag, p1feed, pup, p, ph, t, q, u, v, wght, &
-    wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
-  ! 1.b- LCL associated to ph(nk+1)
+  CALL cv3_vertmix(len, nd, iflag, p1feed, pup, p, ph, &
+                   t, q, u, v, wght, &
+                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+! 1.b- LCL associated with ph(nk+1)
   DO i = 1, len
     plo(i) = ph(i, nk(i)+1)
   END DO
-  CALL cv3_vertmix(len, nd, iflag, p1feed, plo, p, ph, t, q, u, v, wght, &
-    wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
-  ! 2- Iterations
+  CALL cv3_vertmix(len, nd, iflag, p1feed, plo, p, ph, &
+                   t, q, u, v, wght, &
+                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+! 2- Iterations
   niter = 5
   DO iter = 1, niter
@@ -314 +345 @@
         pfeed(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))
+!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))
+        ELSE
+          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>
       END IF
     END DO
-    CALL cv3_vertmix(len, nd, iflag, p1feed, pfeed, p, ph, t, q, u, v, wght, &
-      wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+!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 k = minorig, nd
+          DO i = 1, len
+            IF (ph(i,k)>=plclfeed(i)) pfeedmin(i) = ph(i, k)
+          END DO
+        END DO
+        DO i = 1, len
+          pfeed(i) = max(pfeedmin(i), pfeed(i))
+        END DO
+      END IF
+    END IF
+!jyg>
+
+    CALL cv3_vertmix(len, nd, iflag, p1feed, pfeed, p, ph, &
+                   t, q, u, v, wght, &
+                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+!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.
+      END DO
+    ELSE
+      DO i = 1, len
+        posit(i) = (sign(1.,plclfeed(i)-pfeed(i))+1.)*0.5
+        IF (plclfeed(i)==pfeed(i)) posit(i) = 1.
+      END DO
+    END IF
+!jyg>
     DO i = 1, len
-      posit(i) = (sign(1.,plclfeed(i)-pfeed(i))+1.)*0.5
-      IF (plclfeed(i)==pfeed(i)) posit(i) = 1.
-      ! - 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
+! - 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)
@@ -343 +412 @@
   END DO
 
-  ! -------------------------------------------------------------------
-  ! --- Check whether parcel level temperature and specific humidity
-  ! --- are reasonable
-  ! -------------------------------------------------------------------
+! -------------------------------------------------------------------
+! --- Check whether parcel level temperature and specific humidity
+! --- are reasonable
+! -------------------------------------------------------------------
   DO i = 1, len
     IF (((tnk(i)<250.0) .OR. (qnk(i)<=0.0)) .AND. (iflag(i)==0)) iflag(i) = 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
+! -------------------------------------------------------------------
+! --- 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
@@ -374 +443 @@
   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
@@ -384 +453 @@
 
 
-  ! print*,'icb dans cv3_feed '
-  ! write(*,'(64i2)') icb(2:len-1)
-  ! call dump2d(64,43,'plcl dans cv3_feed ',plcl(2:len-1))
+! 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
@@ -397 +466 @@
   END DO
 
-  ! Compute icbmax.
+! Compute icbmax.
 
   icbmax = 2
   DO i = 1, len
-    ! !        icbmax=max(icbmax,icb(i))
-    IF (iflag(i)<7) icbmax = max(icbmax, icb(i)) ! sb Jun7th02
+!!        icbmax=max(icbmax,icb(i))
+    IF (iflag(i)<7) icbmax = max(icbmax, icb(i))     ! sb Jun7th02
   END DO
 
@@ -409 +478 @@
 
 SUBROUTINE cv3_undilute1(len, nd, t, qs, gz, plcl, p, icb, tnk, qnk, gznk, &
-    tp, tvp, clw, icbs)
+                         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)
-  ! ----------------------------------------------------------------
+! ----------------------------------------------------------------
+! 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:
+! inputs:
   INTEGER len, nd
   INTEGER icb(len)
@@ -436 +505 @@
   REAL plcl(len) ! convect3
 
-  ! outputs:
+! outputs:
   REAL tp(len, nd), tvp(len, nd), clw(len, nd)
 
-  ! local variables:
+! local variables:
   INTEGER i, k
   INTEGER icb1(len), icbs(len), icbsmax2 ! convect3
@@ -448 +517 @@
   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)
+    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   ***
+! ***   Calculate lifted parcel quantities below cloud base   ***
+
+  DO i = 1, len                                           !convect3
+    icb1(i) = max(icb(i), 2)                              !convect3
+    icb1(i) = min(icb(i), nl)                             !convect3
+! 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
-    icb1(i) = max(icb(i), 2) !convect3
-    icb1(i) = min(icb(i), nl) !convect3
-    ! 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
+    ticb(i) = t(i, icbs(i))                               !convect3
+    gzicb(i) = gz(i, icbs(i))                             !convect3
+    qsicb(i) = qs(i, icbs(i))                             !convect3
   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:
+
+! 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    ***
+      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)
+! 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
+! 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)
+! 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          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
+! 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))
+! 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)
+! 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          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
+    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))
+! 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:
+! 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         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)
+! 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)
 
 
@@ -615 +683 @@
     tg = ticb(i)
     qg = qsicb(i) ! convect3
-    ! debug         alv=lv0-clmcpv*(ticb(i)-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
+! 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
+! 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          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
+    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))
+! 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
+! 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          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
+    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))
+! 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:
+! 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)))
+! 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
+! 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
@@ -685 +753 @@
 END SUBROUTINE cv3_undilute1
 
-SUBROUTINE cv3_trigger(len, nd, icb, plcl, p, th, tv, tvp, thnk, pbase, &
-    buoybase, iflag, sig, w0)
+SUBROUTINE cv3_trigger(len, nd, icb, plcl, p, th, tv, tvp, thnk, &
+                       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
-  ! -------------------------------------------------------------------
+! -------------------------------------------------------------------
+! --- 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 "cv3param.h"
 
-  ! input:
+! input:
   INTEGER len, nd
   INTEGER icb(len)
@@ -713 +781 @@
   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
@@ -779 +845 @@
         w0(i, k) = beta*w0(i, k)
         iflag(i) = 4 ! pour version vectorisee
-        ! convect3         iflag(i)=0
+! convect3         iflag(i)=0
       END IF
 
@@ -785 +851 @@
   END DO
 
-  ! fin oct3 --
+! fin oct3 --
 
   RETURN
 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)
+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)
   IMPLICIT NONE
 
@@ -800 +874 @@
   include 'iniprint.h'
 
-  ! inputs:
+!inputs:
   INTEGER len, ncum, nd, ntra, nloc
   INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len)
@@ -813 +887 @@
   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)
@@ -826 +900 @@
   REAL tra(nloc, nd, ntra)
 
-  ! local variables:
+!local variables:
   INTEGER i, k, nn, j
 
@@ -859 +933 @@
   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
@@ -902 +976 @@
 
 
-  ! JAM--------------------------------------------------------------------
-  ! Calcul de la quantité d'eau sous forme de glace
-  ! --------------------------------------------------------------------
+!JAM--------------------------------------------------------------------
+! Calcul de la quantité d'eau sous forme de glace
+! --------------------------------------------------------------------
   REAL qi(len, nl)
   REAL t(len, nl), clw(len, nl)
@@ -922 +996 @@
         END IF
       END IF
-      ! print*,t(i,k),qi(i,k),'temp,testglace'
+! print*,t(i,k),qi(i,k),'temp,testglace'
     END DO
   END DO
@@ -930 +1004 @@
 END SUBROUTINE icefrac
 
-SUBROUTINE cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, tnk, qnk, gznk, hnk, &
-    t, q, qs, gz, p, h, tv, lv, lf, pbase, buoybase, plcl, inb, tp, tvp, clw, &
-    hp, ep, sigp, buoy, frac)
+SUBROUTINE cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, &
+                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
+                         p, h, tv, lv, lf, pbase, buoybase, plcl, &
+                         inb, tp, tvp, clw, hp, ep, sigp, buoy, frac)
   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
-  ! ---------------------------------------------------------------------
+! ---------------------------------------------------------------------
+! 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"
@@ -958 +1033 @@
   include "cvflag.h"
 
-  ! inputs:
+!inputs:
   INTEGER ncum, nd, nloc, j
   INTEGER icb(nloc), icbs(nloc), nk(nloc)
@@ -968 +1043 @@
   REAL pbase(nloc), buoybase(nloc), plcl(nloc)
 
-  ! outputs:
+!outputs:
   INTEGER inb(nloc)
   REAL tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd)
@@ -974 +1049 @@
   REAL buoy(nloc, nd)
 
-  ! local variables:
+!local variables:
   INTEGER i, k
   REAL tg, qg, ahg, alv, alf, s, tc, es, esi, denom, rg, tca, elacrit
@@ -986 +1061 @@
   REAL fracg
 
-  ! =====================================================================
-  ! --- SOME INITIALIZATIONS
-  ! =====================================================================
+! =====================================================================
+! --- SOME INITIALIZATIONS
+! =====================================================================
 
   DO k = 1, nl
@@ -998 +1073 @@
   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   ***
+! =====================================================================
+! --- 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    ***
+    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
+! 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)
+! 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
+! 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)
+! 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
+! 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
+        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          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)
+! 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
+! 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
+        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          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)
+! 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:
+! 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)))
@@ -1087 +1161 @@
         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):
+! 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
@@ -1099 +1173 @@
 
       IF (cvflag_ice) THEN
-        ! CR:attention boucle en klon dans Icefrac
-        ! Call Icefrac(t,clw,qi,nl,nloc)
+!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.
@@ -1111 +1185 @@
           END IF
         END IF
-        ! CR: fin test
+!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
+!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)
@@ -1145 +1219 @@
             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 = 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'
+! 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
+!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'
+! print*,tvp(i,k),'tvp'
         END IF
         IF (clw(i,k)<1.E-11) THEN
@@ -1170 +1245 @@
   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)
-  ! =====================================================================
+! =====================================================================
+! --- 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)
+! =====================================================================
 
   IF (flag_epkeorig/=1) THEN
@@ -1205 +1280 @@
     END DO
   END IF
-  ! =====================================================================
-  ! --- 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:
+! =====================================================================
+! --- 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
@@ -1245 +1320 @@
   END DO
 
-  ! set buoyancy=buoybase for all levels below base
-  ! for safety, set buoy(icb)=buoybase
+! set buoyancy=buoybase for all levels below base
+! for safety, set buoy(icb)=buoybase
 
   DO i = 1, ncum
@@ -1254 +1329 @@
       END IF
     END DO
-    ! 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
@@ -1273 +1348 @@
 
 
-  ! --    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
@@ -1296 +1371 @@
   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)
-  ! 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
-
-  ! =====================================================================
-  ! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
-  ! =====================================================================
+! -- 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
+
+! =====================================================================
+! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
+! =====================================================================
 
   DO k = 1, nd
@@ -1405 +1480 @@
           frac(i, k) = 1. - (t(i,k)-243.15)/(263.15-243.15)
           frac(i, k) = min(max(frac(i,k),0.0), 1.0)
-          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)
+          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)
 
         ELSE
@@ -1419 +1494 @@
 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)
   IMPLICIT NONE
 
-  ! ===================================================================
-  ! ---  CLOSURE OF CONVECT3
-
-  ! vectorization: S. Bony
-  ! ===================================================================
+! ===================================================================
+! ---  CLOSURE OF CONVECT3
+!
+! vectorization: S. Bony
+! ===================================================================
 
   include "cvthermo.h"
   include "cv3param.h"
 
-  ! input:
+!input:
   INTEGER ncum, nd, nloc
   INTEGER icb(nloc), inb(nloc)
@@ -1439 +1515 @@
   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
@@ -1454 +1530 @@
 
 
-  ! -------------------------------------------------------
-  ! -- Initialization
-  ! -------------------------------------------------------
+! -------------------------------------------------------
+! -- Initialization
+! -------------------------------------------------------
 
   DO k = 1, nl
@@ -1464 +1540 @@
   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) = 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)
@@ -1481 +1557 @@
   END DO
 
-  ! compute icbmax:
+! compute icbmax:
 
   icbmax = 2
@@ -1488 +1564 @@
   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) = 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)
@@ -1500 +1577 @@
   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
@@ -1529 +1606 @@
   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
@@ -1539 +1616 @@
   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
@@ -1550 +1627 @@
     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
+        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
@@ -1558 +1634 @@
   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
@@ -1570 +1646 @@
         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
+! 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))
@@ -1590 +1666 @@
   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))
+    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)
+! 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)
 
   RETURN
 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)
+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)
   IMPLICIT NONE
 
-  ! ---------------------------------------------------------------------
-  ! a faire:
-  ! - vectorisation de la partie normalisation des flux (do 789...)
-  ! ---------------------------------------------------------------------
+! ---------------------------------------------------------------------
+! a faire:
+! - vectorisation de la partie normalisation des flux (do 789...)
+! ---------------------------------------------------------------------
 
   include "cvthermo.h"
@@ -1676 +1750 @@
   include "cvflag.h"
 
-  ! inputs:
+!inputs:
   INTEGER ncum, nd, na, ntra, nloc
   INTEGER icb(nloc), inb(nloc), nk(nloc)
@@ -1690 +1764 @@
   REAL m(nloc, na) ! input of convect3
 
-  ! outputs:
+!outputs:
   REAL ment(nloc, na, na), qent(nloc, na, na)
   REAL uent(nloc, na, na), vent(nloc, na, na)
@@ -1699 +1773 @@
   INTEGER nent(nloc, nd)
 
-  ! local variables:
+!local variables:
   INTEGER i, j, k, il, im, jm
   INTEGER num1, num2
@@ -1710 +1784 @@
   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
@@ -1732 +1806 @@
         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
@@ -1763 +1837 @@
     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
+        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)
@@ -1771 +1844 @@
 
           IF (cvflag_ice) THEN
-            ! print*,cvflag_ice,'cvflag_ice dans do 700'
+! 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)
+              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
@@ -1791 +1864 @@
 
             IF (cvflag_ice) THEN
-              anum = anum - (lv(il,j)+frac(il,j)*lf(il,j))*(rti-rs(il,j)-cwat &
-                *bf2)
+              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
@@ -1801 +1873 @@
             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 = 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
+            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))
@@ -1826 +1895 @@
     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(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)
@@ -1855 +1922 @@
         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
@@ -1861 +1928 @@
   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
@@ -1882 +1947 @@
     END DO
   END DO
-  ! @      enddo
-
-  ! @170   continue
-
-  ! =====================================================================
-  ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
-  ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
-  ! =====================================================================
+! @      enddo
+
+! @170   continue
+
+! =====================================================================
+! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
+! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
+! =====================================================================
 
   CALL zilch(asum, nloc*nd)
@@ -1915 +1980 @@
         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))
+                       (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)
+                       (cpd-cpv)*t(il, i)*(rr(il,i)-qp)
         END IF
 
@@ -1940 +2005 @@
       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
+        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 (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
@@ -1988 +2055 @@
     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
+        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
@@ -1997 +2064 @@
     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
+        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)
@@ -2015 +2082 @@
     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
+        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
@@ -2024 +2091 @@
     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
+        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
@@ -2040 +2107 @@
         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
+!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
+! MAF: renormalisation de MENT
   CALL zilch(zm, nloc*na)
   DO jm = 1, nd
@@ -2087 +2154 @@
 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, m, ment, elij, &
-    delt, plcl, coef_clos, mp, rp, up, vp, trap, wt, water, evap, fondue, &
-    ice, faci, b, sigd, wdtraina, wdtrainm) ! RomP
+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, &
+                     m, ment, elij, delt, plcl, coef_clos, &
+                     mp, rp, up, vp, trap, wt, water, evap, fondue, ice, &
+                     faci, b, sigd, &
+                     wdtrainA, wdtrainM)                                      ! RomP
   IMPLICIT NONE
 
@@ -2098 +2168 @@
   include "cvflag.h"
 
-  ! inputs:
+!inputs:
   INTEGER ncum, nd, na, ntra, nloc
   INTEGER icb(nloc), inb(nloc)
@@ -2112 +2182 @@
   REAL coef_clos(nloc)
 
-  ! input/output
+!input/output
   INTEGER iflag(nloc)
 
-  ! outputs:
+!outputs:
   REAL mp(nloc, na), rp(nloc, na), up(nloc, na), vp(nloc, na)
   REAL water(nloc, na), evap(nloc, na), wt(nloc, na)
@@ -2121 +2191 @@
   REAL trap(nloc, na, ntra)
   REAL b(nloc, na), sigd(nloc)
-  ! 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
+! 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 wdtrainA(nloc, na), wdtrainM(nloc, na)
+
+!local variables
   INTEGER i, j, k, il, num1, ndp1
   REAL tinv, delti, coef
@@ -2143 +2213 @@
 
 
-  ! ------------------------------------------------------
+! ------------------------------------------------------
 
   delti = 1./delt
@@ -2170 +2240 @@
     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
-  ! ! RomP >>>
+!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
+!! 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                      ***
+      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)).lt.0.0001)lwork(il)=.FALSE.
+!!          lwork(il)=.TRUE.
+!!          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
     lwork(il) = ep(il, inb(il)) >= 0.0001
   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)
@@ -2202 +2272 @@
 
 
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-  ! ***                    begin downdraft loop                    ***
-
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!
+! ***                    begin downdraft loop                    ***
+!
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
   DO i = nl + 1, 1, -1
@@ -2219 +2289 @@
 
 
-    ! ***  integrate liquid water equation to find condensed water   ***
-    ! ***                and condensed water flux                    ***
-
-
-    ! ***              calculate detrained precipitation             ***
+! ***  integrate liquid water equation to find condensed water   ***
+! ***                and condensed water flux                    ***
+!
+!
+! ***              calculate detrained precipitation             ***
 
     DO il = 1, ncum
@@ -2229 +2299 @@
         IF (cvflag_grav) THEN
           wdtrain(il) = grav*ep(il, i)*m(il, i)*clw(il, i)
-          wdtraina(il, i) = wdtrain(il)/grav !   Pa   RomP
+          wdtrainA(il, i) = wdtrain(il)/grav                        !   Pa   RomP
         ELSE
           wdtrain(il) = 10.0*ep(il, i)*m(il, i)*clw(il, i)
-          wdtraina(il, i) = wdtrain(il)/10. !   Pa   RomP
+          wdtrainA(il, i) = wdtrain(il)/10.                         !   Pa   RomP
         END IF
       END IF
@@ -2245 +2315 @@
             IF (cvflag_grav) THEN
               wdtrain(il) = wdtrain(il) + grav*awat*ment(il, j, i)
-              wdtrainm(il, i) = wdtrain(il)/grav - wdtraina(il, i) !   Pm  RomP
+              wdtrainM(il, i) = wdtrain(il)/grav - wdtrainA(il, i)  !   Pm  RomP
             ELSE
               wdtrain(il) = wdtrain(il) + 10.0*awat*ment(il, j, i)
-              wdtrainm(il, i) = wdtrain(il)/10. - wdtraina(il, i) !   Pm  RomP
+              wdtrainM(il, i) = wdtrain(il)/10. - wdtrainA(il, i)   !   Pm  RomP
             END IF
           END IF
@@ -2256 +2326 @@
 
 
-    ! ***    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)             ***
 
 
@@ -2283 +2353 @@
           END IF
 
-          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) = 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
@@ -2296 +2366 @@
           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) = 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))
+          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
@@ -2315 +2381 @@
         bfac = 1./(sigd(il)*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.
+!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))
@@ -2330 +2396 @@
         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
-        ! c        print *,' i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il)
-        ! ',
-        ! c     $            i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il)
-        ! c---end jyg---
-
-        ! --------retour à la formulation originale d'Emanuel.
+!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*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
+! 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))
@@ -2372 +2437 @@
           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.
-          ! endif
-
-          ! 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.)
-
-          d6 = bfac*wdtrain(il) - 100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))* &
-            evap(il, i)
+! 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.
+! endif
+
+!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.)
+
+          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)
@@ -2415 +2476 @@
           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)
+          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))
@@ -2439 +2500 @@
             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
@@ -2459 +2520 @@
         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
@@ -2473 +2538 @@
           IF (cvflag_grav) THEN
             mp(il, i) = 100.*ginv*lvcp(il, i)*sigd(il)*tevap(il)* &
-              (p(il,i-1)-p(il,i))/delth
+                                                (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
+                                                (p(il,i-1)-p(il,i))/delth
           END IF
 
@@ -2483 +2548 @@
       END IF !(i.le.inb(il) .and. lwork(il) .and. i.ne.1)
     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
@@ -2493 +2558 @@
 
         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))
+                         (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))
+          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)))
+                 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)
+                                           50.*(p(il,i-1)-p(il,i))*xf*tevap(il)
           END IF
 
@@ -2522 +2586 @@
             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
+                                           fac*(abs(0.5*bf-sru))**tinv
           ELSE
             d = atan(2.*sqrt(-ur)/(bf+1.0E-28))
@@ -2532 +2596 @@
           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
@@ -2564 +2632 @@
         END IF !(amp2.gt.(0.1*amfac))
 
-        ! ***         limit magnitude of mp(i) to meet cfl condition      ***
+! ***         limit magnitude of mp(i) to meet cfl condition      ***
 
         ampmax = 2.0*(ph(il,i)-ph(il,i+1))*delti
@@ -2571 +2639 @@
         mp(il, i) = min(mp(il,i), ampmax)
 
-        ! ***      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
+! ***      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))
@@ -2585 +2652 @@
       END IF ! (i.le.inb(il) .and. lwork(il) .and. i.ne.1)
     END DO
-    ! ----------------------------------------------------------------
-
-    ! ***       find mixing ratio of precipitating downdraft     ***
+! ----------------------------------------------------------------
+
+! ***       find mixing ratio of precipitating downdraft     ***
 
     DO il = 1, ncum
@@ -2603 +2670 @@
 
           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+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+1)*mp(il, i+1) + v(il, i)*(mp(il,i)-mp(il,i+1))
           vp(il, i) = vp(il, i)/mp(il, i)
 
@@ -2623 +2686 @@
           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)
@@ -2639 +2702 @@
       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
+! ----------------------------------------------------------------
+
+! ***       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 of downdraft loop                    ***
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 
@@ -2672 +2735 @@
 END SUBROUTINE cv3_unsat
 
-SUBROUTINE cv3_yield(nloc, ncum, nd, na, ntra, 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, 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, ft, fr, fu, fv, ftra, cbmf, &
-    upwd, dnwd, dnwd0, ma, mip, tls, tps, qcondc, wd, ftd, fqd)
+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, 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, ft, fr, fu, fv, ftra, &
+                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
+                     tls, tps, qcondc, wd, &
+                     ftd, fqd)
 
   IMPLICIT NONE
@@ -2686 +2756 @@
   include "conema3.h"
 
-  ! inputs:
-  ! print*,'cv3_yield apres include'
-  INTEGER iflag_mix
-  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 t_wake(nloc, nd), rr_wake(nloc, nd)
-  REAL s_wake(nloc)
-  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 lf(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), sigd(nloc)
-  REAL fondue(nloc, na), faci(nloc, na), ice(nloc, na)
-  REAL ment(nloc, na, na), qent(nloc, na, na), uent(nloc, na, na)
-  REAL hent(nloc, na, na)
-  ! IM bug   real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
-  REAL vent(nloc, na, na), elij(nloc, na, na)
-  INTEGER nent(nloc, nd)
-  REAL traent(nloc, na, na, ntra)
-  REAL tv(nloc, nd), tvp(nloc, nd), wghti(nloc, nd)
-  ! print*,'cv3_yield declarations 1'
-  ! input/output:
-  INTEGER iflag(nloc)
-
-  ! outputs:
-  REAL precip(nloc)
-  REAL ft(nloc, nd), fr(nloc, nd), fu(nloc, nd), fv(nloc, nd)
-  REAL ftd(nloc, nd), fqd(nloc, nd)
-  REAL ftra(nloc, nd, ntra)
-  REAL upwd(nloc, nd), dnwd(nloc, nd), ma(nloc, nd)
-  REAL dnwd0(nloc, nd), mip(nloc, nd)
-  REAL vprecip(nloc, nd+1)
-  REAL tls(nloc, nd), tps(nloc, nd)
-  REAL qcondc(nloc, nd) ! cld
-  REAL wd(nloc) ! gust
-  REAL cbmf(nloc)
-  ! print*,'cv3_yield declarations 2'
-  ! local variables:
-  INTEGER i, k, il, n, j, num1
-  REAL rat, delti
-  REAL ax, bx, cx, dx, ex
-  REAL cpinv, rdcp, dpinv
-  REAL awat(nloc)
-  REAL lvcp(nloc, na), lfcp(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 esum(nloc), fsum(nloc), gsum(nloc), hsum(nloc)
-  REAL th_wake(nloc, nd)
-  REAL alpha_qpos(nloc), alpha_qpos1(nloc)
-  REAL qcond(nloc, nd), nqcond(nloc, nd), wa(nloc, nd) ! cld
-  REAL siga(nloc, nd), sax(nloc, nd), mac(nloc, nd) ! cld
-
-  ! print*,'cv3_yield declarations 3'
-  ! -------------------------------------------------------------
-
-  ! initialization:
+!inputs:
+      INTEGER iflag_mix
+      INTEGER ncum, nd, na, ntra, nloc
+      LOGICAL ok_conserv_q
+      INTEGER icb(nloc), inb(nloc)
+      REAL delt
+      REAL t(nloc, nd), rr(nloc, nd), u(nloc, nd), v(nloc, nd)
+      REAL t_wake(nloc, nd), rr_wake(nloc, nd)
+      REAL s_wake(nloc)
+      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 lf(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), sigd(nloc)
+      REAL fondue(nloc, na), faci(nloc, na), ice(nloc, na)
+      REAL ment(nloc, na, na), qent(nloc, na, na), uent(nloc, na, na)
+      REAL hent(nloc, na, na)
+!IM bug   real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
+      REAL vent(nloc, na, na), elij(nloc, na, na)
+      INTEGER nent(nloc, nd)
+      REAL traent(nloc, na, na, ntra)
+      REAL tv(nloc, nd), tvp(nloc, nd), wghti(nloc, nd)
+!
+!input/output:
+      INTEGER iflag(nloc)
+!
+!outputs:
+      REAL precip(nloc)
+      REAL ft(nloc, nd), fr(nloc, nd), fu(nloc, nd), fv(nloc, nd)
+      REAL ftd(nloc, nd), fqd(nloc, nd)
+      REAL ftra(nloc, nd, ntra)
+      REAL upwd(nloc, nd), dnwd(nloc, nd), ma(nloc, nd)
+      REAL dnwd0(nloc, nd), mip(nloc, nd)
+      REAL Vprecip(nloc, nd+1)
+      REAL tls(nloc, nd), tps(nloc, nd)
+      REAL qcondc(nloc, nd) ! cld
+      REAL wd(nloc) ! gust
+      REAL cbmf(nloc)
+!
+!local variables:
+      INTEGER i, k, il, n, j, num1
+      REAL rat, delti
+      REAL ax, bx, cx, dx, ex
+      REAL cpinv, rdcp, dpinv
+      REAL awat(nloc)
+      REAL lvcp(nloc, na), lfcp(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 esum(nloc), fsum(nloc), gsum(nloc), hsum(nloc)
+      REAL th_wake(nloc, nd)
+      REAL alpha_qpos(nloc), alpha_qpos1(nloc)
+      REAL qcond(nloc, nd), nqcond(nloc, nd), wa(nloc, nd) ! cld
+      REAL siga(nloc, nd), sax(nloc, nd), mac(nloc, nd) ! cld
+
+      REAL sumdq !jyg
+! 
+! -------------------------------------------------------------
+
+! initialization:
 
   delti = 1.0/delt
-  ! print*,'cv3_yield initialisation delt', delt
-  ! precip,Vprecip,ft,fr,fu,fv,ftra
-  ! :                    ,cbmf,upwd,dnwd,dnwd0,ma,mip
-  ! :                    ,tls,tps,qcondc,wd
-  ! :                    ,ftd,fqd  )
+! print*,'cv3_yield initialisation delt', delt
+!
   DO il = 1, ncum
     precip(il) = 0.0
-    vprecip(il, nd+1) = 0.0
+    Vprecip(il, nd+1) = 0.0
     wd(il) = 0.0 ! gust
   END DO
@@ -2764 +2832 @@
   DO i = 1, nd
     DO il = 1, ncum
-      vprecip(il, i) = 0.0
+      Vprecip(il, i) = 0.0
       ft(il, i) = 0.0
       fr(il, i) = 0.0
@@ -2780 +2848 @@
     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
@@ -2798 +2866 @@
 
 
-  ! ***  calculate surface precipitation in mm/day     ***
+! ***  calculate surface precipitation in mm/day     ***
 
   DO il = 1, ncum
     IF (ep(il,inb(il))>=0.0001 .AND. iflag(il)<=1) THEN
       IF (cvflag_ice) THEN
-        IF (cvflag_grav) THEN
-          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)+ice(il,1))*8640.
-        END IF
+        precip(il) = wt(il, 1)*sigd(il)*(water(il,1)+ice(il,1)) &
+                              *86400.*1000./(rowl*grav)
       ELSE
-        IF (cvflag_grav) THEN
-          precip(il) = wt(il, 1)*sigd(il)*water(il, 1)*86400.*1000./ &
-            (rowl*grav)
-        ELSE
-          precip(il) = wt(il, 1)*sigd(il)*water(il, 1)*8640.
-        END IF
+        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
@@ -2828 +2888 @@
       IF (ep(il,inb(il))>=0.0001 .AND. i<=inb(il) .AND. iflag(il)<=1) THEN
         IF (cvflag_ice) THEN
-          IF (cvflag_grav) THEN
-            vprecip(il, i) = wt(il, i)*sigd(il)*(water(il,i)+ice(il,i))/grav
-          ELSE
-            vprecip(il, i) = wt(il, i)*sigd(il)*(water(il,i)+ice(il,i))/10.
-          END IF
+          Vprecip(il, i) = wt(il, i)*sigd(il)*(water(il,i)+ice(il,i))/grav
         ELSE
-          IF (cvflag_grav) THEN
-            vprecip(il, i) = wt(il, i)*sigd(il)*water(il, i)/grav
-          ELSE
-            vprecip(il, i) = wt(il, i)*sigd(il)*water(il, i)/10.
-          END IF
+          Vprecip(il, i) = wt(il, i)*sigd(il)*water(il, i)/grav
         END IF
       END IF
@@ -2845 +2897 @@
 
 
-  ! ***  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
@@ -2870 +2922 @@
   END DO
 
-  ! print*,'cv3_yield avant ft'
-  ! AM is the part of cbmf taken from the first level
+!    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)
@@ -2878 +2930 @@
   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
+                     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)
       END IF
 
-      IF (cvflag_grav) THEN
-        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)
       ELSE
-        ft(il, 1) = ft(il, 1) - 0.09*sigd(il)*mp(il, 2)*t_wake(il, 1)*b(il, 1 &
-          )*work(il)
+        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
 
-      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)
-      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)
-      END IF
-
-      ftd(il, 1) = ft(il, 1) ! fin precip
-
-      IF (cvflag_grav) THEN !sature
-        IF ((0.01*grav*work(il)*am(il))>=delti) iflag(il) = 1 !consist vect
-        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))
-      ELSE
-        IF ((0.1*work(il)*am(il))>=delti) iflag(il) = 1 !consistency vect
-        ft(il, 1) = 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
+      ftd(il, 1) = ft(il, 1)                                                  ! fin precip
+
+      IF ((0.01*grav*work(il)*am(il))>=delti) iflag(il) = 1 !consist vect
+      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))
     END IF ! iflag
   END DO
@@ -2927 +2966 @@
     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
-          IF (cvflag_grav) 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
-          ELSE
-            ft(il, 1) = ft(il, 1) + 0.1*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 ! cvflag_grav
+          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
-      IF (cvflag_grav) 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)
-        ! cc     :          +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)))
-      ELSE ! cvflag_grav
-        fr(il, 1) = 0.1*mp(il, 2)*(rp(il,2)-rr_wake(il,1))*work(il) + &
-          sigd(il)*evap(il, 1)
-        ! cc     :          +sigd(il)*0.5*(evap(il,1)+evap(il,2))
-        fqd(il, 1) = fr(il, 1) !precip
-        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
+!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)))
     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
-        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)) ! fin sature
-        END IF ! cvflag_grav
+        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))
       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'
-
-  ! ***  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                          ***
+!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'
+
+! ***  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                          ***
 
 
@@ -3060 +3068 @@
           END IF
         ELSE
-          ! AMP1 is the part of cbmf taken from layers I and lower
+! 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)
@@ -3093 +3101 @@
         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
-
-          ! precip
-        ! cc       ft(il,i)=
-        ! -0.5*sigd(il)*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
+! 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)))
+                       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)
@@ -3114 +3116 @@
         rat = cpn(il, i-1)*cpinv
 
-        IF (cvflag_grav) THEN
-          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
-          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
-          END IF
-
-          ftd(il, i) = ft(il, i)
-            ! fin precip
-
-            ! sature
-          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))
-
-
-          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
-          END IF
-
-        ELSE ! cvflag_grav
-          ft(il, i) = ft(il, i) - 0.09*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
-          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
-          END IF
-
-          ftd(il, i) = ft(il, i)
-            ! fin precip
-
-            ! sature
-          ft(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))
-
-
-          IF (iflag_mix==0) THEN
-            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
-        END IF ! cvflag_grav
-
-
-        IF (cvflag_grav) THEN
-          ! 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
-        ELSE ! cvflag_grav
-          ! cc         fr(il,i)=0.5*sigd(il)*(evap(il,i)+evap(il,i+1))
-          fr(il, i) = sigd(il)*evap(il, i) + 0.1*(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.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) = 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
-
-
-        IF (cvflag_grav) THEN
-          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)))
-        ELSE ! cvflag_grav
-          fr(il, i) = 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
+        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
+        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
+        END IF
+
+        ftd(il, i) = ft(il, i)
+! fin precip
+
+! sature
+        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))
+
+
+        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
+        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
+        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)))
 
       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
@@ -3246 +3199 @@
             dpinv = 1.0/(ph(il,i)-ph(il,i+1))
             cpinv = 1.0/cpn(il, i)
-            IF (cvflag_grav) THEN
-              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
-
-
-
-            ELSE
-              ft(il, i) = ft(il, i) + 0.1*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 !cvflag_grav
+            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
         END DO
@@ -3266 +3211 @@
           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)-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))
-          ELSE ! cvflag_grav
-            fr(il, i) = fr(il, i) + 0.1*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.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(il)) ! cld
+          fr(il, i) = fr(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
           nqcond(il, i) = nqcond(il, i) + 1. ! cld
         END IF ! i
@@ -3289 +3223 @@
     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
+!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
 
     DO k = i, nl + 1
@@ -3314 +3248 @@
             dpinv = 1.0/(ph(il,i)-ph(il,i+1))
             cpinv = 1.0/cpn(il, i)
-            IF (cvflag_grav) THEN
-              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
-
-
-            ELSE
-              ft(il, i) = ft(il, i) + 0.1*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 !cvflag_grav
+            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
         END DO
@@ -3333 +3261 @@
           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
+          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
-          qcond(il, i) = qcond(il, i) + elij(il, k, i) ! cld
+        IF (k<=inb(il) .AND. i<=inb(il) .AND. iflag(il)<=1) 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
@@ -3383 +3299 @@
     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 .AND. iflag(il)<=1) 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 .AND. iflag(il)<=1) THEN ! cld
-        qcond(il, i) = qcond(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
+! (particular case: no detraining level is found)                              ! cld
+    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
+        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 .AND. iflag(il)<=1) THEN            ! cld
+        qcond(il, i) = qcond(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
 
-
-  ! ***   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
+!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
-      IF (cvflag_grav) 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)))
-        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))
-        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))
-        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))
-        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)))
-      ELSE
-        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 IF
+      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))
+      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))
+      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))
+      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 IF !iflag
   END DO
 
-  ! 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    ***
 
 
@@ -3522 +3425 @@
   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
+!jyg  Saturated part : use T profile
         asum(il) = asum(il) + (ft(il,i)-ftd(il,i))*(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))
+!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))
+
+        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))
+        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
+!jyg  Unsaturated part : use T_wake profile
         esum(il) = esum(il) + ftd(il, i)*(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))
-        hsum(il) = hsum(il) + t_wake(il, i)*(ph(il,i)-ph(il,i+1))/th_wake(il, &
-          i)
+!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))
+        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))
+        ENDIF ! (ok_conserv_q)
+!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
   DO i = 1, nl
     DO il = 1, ncum
@@ -3562 +3481 @@
   END DO
 
-
-  ! ***   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)))
+        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
@@ -3578 +3505 @@
       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 (alpha_qpos1(il)>=alpha_qpos(il)) alpha_qpos(il) &
-            = alpha_qpos1(il)
+          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
       END IF
@@ -3608 +3533 @@
         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)
+        Vprecip(il, i) = vprecip(il, i)/alpha_qpos(il)
       END IF
     END DO
@@ -3622 +3547 @@
   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           ***
+!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           ***
 
   DO il = 1, ncum
@@ -3702 +3627 @@
           END IF
         END IF
-        ! c        print *,'cbmf',il,i,k,cbmf(il),wghti(il,k)
+! c        print *,'cbmf',il,i,k,cbmf(il),wghti(il,k)
       END DO
     END DO
@@ -3710 +3635 @@
     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
+! 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)
+! c         print *,'upwd',il,i,k,inb(il),upwd(il,i),m(il,k),up1(il,k,i)
       END DO
     END DO
@@ -3723 +3646 @@
 
 
-  ! !!!      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 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
+
+! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! determination de la variation de flux ascendant entre
+! deux niveau non dilue mip
+! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
   DO i = 1, nl
@@ -3787 +3710 @@
   END DO
 
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  ! icb represente de niveau ou se trouve la
-  ! base du nuage , et inb le top du nuage
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! icb represente de niveau ou se trouve la
+! base du nuage , et inb le top du nuage
+! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
   DO i = 1, nd
@@ -3800 +3723 @@
   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)
+      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)
@@ -3808 +3730 @@
 
 
-  ! *** 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
-
-  DO i = minorig, nl ! cld
-    DO k = i + 1, nl + 1 ! cld
-      DO il = 1, ncum ! cld
+! *** 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
+                                                                     
+  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
-          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) .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
-    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 .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 ! cld
-    DO il = 1, ncum ! cld
-      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) & ! 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
-  ! print*,'cv3_yield fin'
-    ! 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) .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
+    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 .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                                                       ! cld
+    DO il = 1, ncum                                                  ! cld
+      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) &                         ! 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                                         ! cld
+        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                                    ! cld
+        qcondc(il, i) = qcond(il, i)                                 ! cld
+      END IF                                                         ! cld
+
+    END DO                                                           ! cld
+  END DO
+! print*,'cv3_yield fin'
+
   RETURN
 END SUBROUTINE cv3_yield
 
-! 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)
+!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)
   IMPLICIT NONE
 
   include "cv3param.h"
 
-  ! inputs:
+!inputs:
   INTEGER ncum, nd, na, nloc, len
   REAL ment(nloc, na, na), sigij(nloc, na, na)
@@ -3886 +3810 @@
   REAL ep(nloc, na)
   INTEGER icb(nloc), inb(nloc)
-  REAL vprecip(nloc, nd+1)
-  ! ouputs:
+  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:
+  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
   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.
@@ -3910 +3834 @@
   dam(:, :) = 0.
   epm(:, :, :) = 0.
-  eplamm(:, :) = 0.
-  epmlmmm(:, :, :) = 0.
+  eplaMm(:, :) = 0.
+  epmlmMm(:, :, :) = 0.
   phi(:, :, :) = 0.
   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, na
     DO k = 1, na
       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)
+        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
@@ -3937 +3861 @@
       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.- &
-            sigij(i,j,k))
+          eplaMm(i, j) = eplamm(i, j) + &
+                         ep(i, j)*clw(i, j)*ment(i, j, k)*(1.-sigij(i,j,k))
         END IF
       END DO
@@ -3948 +3872 @@
       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
@@ -3954 +3878 @@
   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, na
     DO k = 1, na
@@ -3962 +3886 @@
         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))
-
+          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
@@ -3973 +3895 @@
   RETURN
 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, &
-    iflag1, precip1, sig1, w01, ft1, fq1, fu1, fv1, ftra1, ma1, upwd1, dnwd1, &
-    dnwd01, qcondc1, wd1, cape1)
+!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, &
+                          iflag1, &
+                          precip1, sig1, w01, &
+                          ft1, fq1, fu1, fv1, ftra1, &
+                          Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1)
   IMPLICIT NONE
 
   include "cv3param.h"
 
-  ! inputs:
+!inputs:
   INTEGER len, ncum, nd, ntra, nloc
   INTEGER idcum(nloc)
@@ -3996 +3923 @@
   REAL wd(nloc), cape(nloc)
 
-  ! outputs:
+!outputs:
   INTEGER iflag1(len)
   REAL precip1(len)
@@ -4007 +3934 @@
   REAL wd1(nloc), cape1(nloc)
 
-  ! local variables:
+!local variables:
   INTEGER i, k, j
 
@@ -4038 +3965 @@
 
 
-  ! 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
+!
   RETURN
 END SUBROUTINE cv3_uncompress

LMDZ5/trunk/libf/phylmd/cv3p_mixing.F90

@@ -1 @@
-SUBROUTINE cv3p_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, ph, t, rr, rs, &
-    u, v, tra, h, lv, qnk, unk, vnk, hp, tv, tvp, ep, clw, sig, ment, qent, &
-    hent, uent, vent, nent, sigij, elij, supmax, ments, qents, traent)
-  ! **************************************************************
-  ! *
-  ! CV3P_MIXING : compute mixed draught properties and,         *
-  ! within a scaling factor, mixed draught        *
-  ! mass fluxes.                                  *
-  ! written by  : VTJ Philips,JY Grandpeix, 21/05/2003, 09.14.15*
-  ! modified by :                                               *
-  ! **************************************************************
+SUBROUTINE cv3p_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, &
+                       ph, t, rr, rs, u, v, tra, h, lv, qnk, &
+                       unk, vnk, hp, tv, tvp, ep, clw, sig, &
+                       Ment, Qent, hent, uent, vent, nent, &
+                       Sigij, elij, supmax, Ments, Qents, traent)
+! **************************************************************
+! *
+! CV3P_MIXING : compute mixed draught properties and,         *
+! within a scaling factor, mixed draught        *
+! mass fluxes.                                  *
+! written by  : VTJ Philips,JY Grandpeix, 21/05/2003, 09.14.15*
+! modified by :                                               *
+! **************************************************************
 
   IMPLICIT NONE
@@ -17 +19 @@
   include "YOMCST2.h"
 
-  ! inputs:
-  INTEGER ncum, nd, na, ntra, nloc
-  INTEGER icb(nloc), inb(nloc), nk(nloc)
-  REAL sig(nloc, nd)
-  REAL qnk(nloc), unk(nloc), vnk(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)
-  REAL h(nloc, na) !liquid water static energy of environment
-  REAL hp(nloc, na) !liquid water static energy of air shed from adiab. asc.
-  REAL tv(nloc, na), tvp(nloc, na), ep(nloc, na), clw(nloc, na)
-
-  ! outputs:
-  REAL ment(nloc, na, na), qent(nloc, na, na)
-  REAL uent(nloc, na, na), vent(nloc, na, na)
-  REAL sigij(nloc, na, na), elij(nloc, na, na)
-  REAL supmax(nloc, na) ! Highest mixing fraction of mixed updraughts
-    ! with the sign of (h-hp)
-  REAL traent(nloc, nd, nd, ntra)
-  REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
-  REAL hent(nloc, nd, nd)
-  INTEGER nent(nloc, nd)
-
-  ! local variables:
+!inputs:
+  INTEGER, INTENT (IN)                               :: ncum, nd, na
+  INTEGER, INTENT (IN)                               :: 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
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: h  !liquid water static energy of environMent
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: hp !liquid water static energy of air shed from adiab. asc.
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: tv, tvp
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: ep, clw
+
+!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)       :: Sigij, elij
+  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: supmax(nloc, na) ! Highest mixing fraction of mixed
+                                                                         ! updraughts with the sign of (h-hp)
+  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent
+  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT)       :: Ments, Qents
+  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT)       :: hent
+  INTEGER, DIMENSION (nloc, nd), INTENT (OUT)        :: nent
+
+!local variables:
   INTEGER i, j, k, il, im, jm
   INTEGER num1, num2
-  REAL rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
-  REAL alt, delp, delm
-  REAL qmixmax(nloc), rmixmax(nloc), sqmrmax(nloc)
-  REAL qmixmin(nloc), rmixmin(nloc), sqmrmin(nloc)
-  REAL signhpmh(nloc)
-  REAL sx(nloc), scrit2
-  REAL smid(nloc), sjmin(nloc), sjmax(nloc)
-  REAL sbef(nloc), sup(nloc), smin(nloc)
-  REAL asij(nloc), smax(nloc), scrit(nloc)
-  REAL sij(nloc, nd, nd)
-  REAL csum(nloc, nd)
-  REAL awat
-  LOGICAL lwork(nloc)
+  REAL                               :: rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
+  REAL                               :: alt, delp, delm
+  REAL, DIMENSION (nloc)             :: Qmixmax, Rmixmax, sqmrmax
+  REAL, DIMENSION (nloc)             :: Qmixmin, Rmixmin, sqmrmin
+  REAL, DIMENSION (nloc)             :: signhpmh
+  REAL, DIMENSION (nloc)             :: Sx
+  REAL                               :: Scrit2
+  REAL, DIMENSION (nloc)             :: Smid, Sjmin, Sjmax
+  REAL, DIMENSION (nloc)             :: Sbef, sup, smin
+  REAL, DIMENSION (nloc)             :: ASij, smax, Scrit
+  REAL, DIMENSION (nloc, nd, nd)     :: Sij
+  REAL, DIMENSION (nloc, nd)         :: csum
+  REAL                               :: awat
+  LOGICAL, DIMENSION (nloc)          :: lwork
 
   REAL amxupcrit, df, ff
   INTEGER nstep
 
-  ! --   Mixing probability distribution functions
-
-  REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
-
-  qcoef1(f) = tanh(f/gammas)
-  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
-  qff(f) = max(min(f,1.), 0.)
-  qfff(f) = min(qff(f), scut)
-  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
-  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
-    qcoef2max
-  qmix2(f) = -log(1.-qfff(f))/scut
-  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
-  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
-  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
+! --   Mixing probability distribution functions
+
+  REAL Qcoef1, Qcoef2, QFF, QFFF, Qmix, Rmix, Qmix1, Rmix1, Qmix2, Rmix2, F
+
+  Qcoef1(F) = tanh(F/gammas)
+  Qcoef2(F) = (tanh(F/gammas)+gammas*log(cosh((1.-F)/gammas)/cosh(F/gammas)))
+  QFF(F) = max(min(F,1.), 0.)
+  QFFf(F) = min(QFF(F), scut)
+  Qmix1(F) = (tanh((QFF(F)-Fmax)/gammas)+Qcoef1max)/Qcoef2max
+  Rmix1(F) = (gammas*log(cosh((QFF(F)-Fmax)/gammas))+QFF(F)*Qcoef1max)/Qcoef2max
+  Qmix2(F) = -log(1.-QFFf(F))/scut
+  Rmix2(F) = (QFFf(F)+(1.-QFF(F))*log(1.-QFFf(F)))/scut
+  Qmix(F) = qqa1*Qmix1(F) + qqa2*Qmix2(F)
+  Rmix(F) = qqa1*Rmix1(F) + qqa2*Rmix2(F)
 
   INTEGER, SAVE :: ifrst
   DATA ifrst/0/
-  !$OMP THREADPRIVATE(ifrst)
-
-
-  ! =====================================================================
-  ! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-  ! =====================================================================
-
-  ! -- Initialize mixing PDF coefficients
+!$OMP THREADPRIVATE(ifrst)
+
+
+! =====================================================================
+! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
+! =====================================================================
+
+! -- Initialize mixing PDF coefficients
   IF (ifrst==0) THEN
     ifrst = 1
-    qcoef1max = qcoef1(fmax)
-    qcoef2max = qcoef2(fmax)
+    Qcoef1max = Qcoef1(Fmax)
+    Qcoef2max = Qcoef2(Fmax)
 
   END IF
 
 
-  ! ori        do 360 i=1,ncum*nlp
+! 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
       DO i = 1, ncum
-        qent(i, k, j) = rr(i, j)
+        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
         hent(i, k, j) = 0.0
-        ! AC!            ment(i,k,j)=0.0
-        ! AC!            sij(i,k,j)=0.0
-      END DO
-    END DO
-  END DO
-
-  ! AC!
-  ment(1:ncum, 1:nd, 1:nd) = 0.0
-  sij(1:ncum, 1:nd, 1:nd) = 0.0
-  ! AC!
+!AC!            Ment(i,k,j)=0.0
+!AC!            Sij(i,k,j)=0.0
+      END DO
+    END DO
+  END DO
+
+!AC!
+  Ment(1:ncum, 1:nd, 1:nd) = 0.0
+  Sij(1:ncum, 1:nd, 1:nd) = 0.0
+!AC!
 
   DO k = 1, ntra
@@ -136 +140 @@
   END DO
 
-  ! =====================================================================
-  ! --- 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
@@ -146 +150 @@
     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
+        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)
@@ -155 +159 @@
           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)
+          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)
+          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)
+            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) THEN
-            ! cc                 ment(il,i,j)=m(il,i)
-            ment(il, i, j) = 1.
+          IF (Sij(il,i,j)>0.0) THEN
+!!!                 Ment(il,i,j)=m(il,i)
+            Ment(il, i, j) = 1.
             elij(il, i, j) = altem
             elij(il, i, j) = amax1(0.0, elij(il,i,j))
@@ -178 +181 @@
           END IF
 
-          sij(il, i, j) = amax1(0.0, sij(il,i,j))
-          sij(il, i, j) = amin1(1.0, sij(il,i,j))
+          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
@@ -185 +188 @@
 
 
-    ! ***   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)
+! ***   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
-        ! cc      ment(il,i,i)=m(il,i)
-        ment(il, i, i) = 1.
-        qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
+! @      if(nent(il,i).eq.0)then
+!!!       Ment(il,i,i)=m(il,i)
+        Ment(il, i, i) = 1.
+        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)*(1.-ep(il,i))
-        sij(il, i, i) = 0.0
+        Sij(il, i, i) = 0.0
       END IF
     END DO
@@ -220 +221 @@
     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
-  ! =====================================================================
+        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
+! =====================================================================
 
   CALL zilch(csum, nloc*nd)
@@ -242 +243 @@
   END DO
 
-  ! ---------------------------------------------------------------
-  DO i = minorig + 1, nl !Loop on origin level "i"
-    ! ---------------------------------------------------------------
+! ---------------------------------------------------------------
+  DO i = minorig + 1, nl      !Loop on origin level "i"
+! ---------------------------------------------------------------
 
     num1 = 0
@@ -253 +254 @@
 
 
-    ! jyg1    Find maximum of SIJ for J>I, if any.
-
-    sx(:) = 0.
+!JYG1    Find maximum of SIJ for J>I, if any.
+
+    Sx(:) = 0.
 
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il)) THEN
         signhpmh(il) = sign(1., hp(il,i)-h(il,i))
-        sbef(il) = max(0., signhpmh(il))
+        Sbef(il) = max(0., signhpmh(il))
       END IF
     END DO
@@ -267 +268 @@
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. j<=inb(il)) THEN
-          IF (sbef(il)<sij(il,i,j)) THEN
-            sx(il) = max(sij(il,i,j), sx(il))
-          END IF
-          sbef(il) = sij(il, i, j)
+          IF (Sbef(il)<Sij(il,i,j)) THEN
+            Sx(il) = max(Sij(il,i,j), Sx(il))
+          END IF
+          Sbef(il) = Sij(il, i, j)
         END IF
       END DO
@@ -279 +280 @@
       IF (i>=icb(il) .AND. i<=inb(il)) THEN
         lwork(il) = (nent(il,i)/=0)
-        qp = qnk(il) - 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)
+        rti = qnk(il) - ep(il, i)*clw(il, i)
+        anum = h(il, i) - hp(il, i) - lv(il, i)*(rti-rs(il,i)) + &
+               (cpv-cpd)*t(il, i)*(rti-rr(il,i))
+        denom = h(il, i) - hp(il, i) + lv(il, i)*(rr(il,i)-rti) + &
+                (cpd-cpv)*t(il, i)*(rr(il,i)-rti)
         IF (abs(denom)<0.01) denom = 0.01
-        scrit(il) = min(anum/denom, 1.)
-        alt = qp - rs(il, i) + scrit(il)*(rr(il,i)-qp)
-
-        ! jyg1    Find new critical value Scrit2
-        ! such that : Sij > Scrit2  => mixed draught will detrain at J<I
-        ! Sij < Scrit2  => mixed draught will detrain at J>I
-
-        scrit2 = min(scrit(il), sx(il))*max(0., -signhpmh(il)) + &
-          scrit(il)*max(0., signhpmh(il))
-
-        scrit(il) = scrit2
-
-        ! jyg    Correction pour la nouvelle logique; la correction pour ALT
-        ! est un peu au hazard
-        IF (scrit(il)<=0.0) scrit(il) = 0.0
-        IF (alt<=0.0) scrit(il) = 1.0
+        Scrit(il) = min(anum/denom, 1.)
+        alt = rti - rs(il, i) + Scrit(il)*(rr(il,i)-rti)
+
+!JYG1    Find new critical value Scrit2
+!         such that : Sij > Scrit2  => mixed draught will detrain at J<I
+!                     Sij < Scrit2  => mixed draught will detrain at J>I
+
+        Scrit2 = min(Scrit(il), Sx(il))*max(0., -signhpmh(il)) + &
+                 Scrit(il)*max(0., signhpmh(il))
+
+        Scrit(il) = Scrit2
+
+!JYG    Correction pour la nouvelle logique; la correction pour ALT
+! est un peu au hazard
+        IF (Scrit(il)<=0.0) Scrit(il) = 0.0
+        IF (alt<=0.0) Scrit(il) = 1.0
 
         smax(il) = 0.0
-        asij(il) = 0.0
-        sup(il) = 0. ! upper S-value reached by descending draughts
-      END IF
-    END DO
-
-    ! ---------------------------------------------------------------
-    DO j = minorig, nl !Loop on destination level "j"
-      ! ---------------------------------------------------------------
+        ASij(il) = 0.0
+        sup(il) = 0.      ! upper S-value reached by descending draughts
+      END IF
+    END DO
+
+! ---------------------------------------------------------------
+    DO j = minorig, nl         !Loop on destination level "j"
+! ---------------------------------------------------------------
 
       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
+        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 (j>i) THEN
-        ! -----------------------------------------------
+! -----------------------------------------------
         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)>0.0) THEN
-              smid(il) = min(sij(il,i,j), scrit(il))
-              sjmax(il) = smid(il)
-              sjmin(il) = smid(il)
-              IF (smid(il)<smin(il) .AND. sij(il,i,j+1)<smid(il)) THEN
-                smin(il) = smid(il)
-                sjmax(il) = min((sij(il,i,j+1)+sij(il,i, &
-                  j))/2., sij(il,i,j), scrit(il))
-                sjmin(il) = max((sbef(il)+sij(il,i,j))/2., sij(il,i,j))
-                sjmin(il) = min(sjmin(il), scrit(il))
-                sbef(il) = sij(il, i, j)
+          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)>0.0) THEN
+              Smid(il) = min(Sij(il,i,j), Scrit(il))
+              Sjmax(il) = Smid(il)
+              Sjmin(il) = Smid(il)
+              IF (Smid(il)<smin(il) .AND. Sij(il,i,j+1)<Smid(il)) THEN
+                smin(il) = Smid(il)
+                Sjmax(il) = min((Sij(il,i,j+1)+Sij(il,i,j))/2., Sij(il,i,j), Scrit(il))
+                Sjmin(il) = max((Sbef(il)+Sij(il,i,j))/2., Sij(il,i,j))
+                Sjmin(il) = min(Sjmin(il), Scrit(il))
+                Sbef(il) = Sij(il, i, j)
               END IF
             END IF
           END IF
         END DO
-        ! -----------------------------------------------
+! -----------------------------------------------
       ELSE IF (j==i) THEN
-        ! -----------------------------------------------
+! -----------------------------------------------
         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)>0.0) THEN
-              smid(il) = 1.
-              sjmin(il) = max((sij(il,i,j-1)+smid(il))/2., scrit(il))*max(0., &
-                -signhpmh(il)) + min((sij(il,i,j+1)+smid(il))/2., scrit(il))* &
-                max(0., signhpmh(il))
-              sjmin(il) = max(sjmin(il), sup(il))
-              sjmax(il) = 1.
-
-              ! -           preparation des variables Scrit, Smin et Sbef
-              ! pour la partie j>i
-              scrit(il) = min(sjmin(il), sjmax(il), scrit(il))
+          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)>0.0) THEN
+              Smid(il) = 1.
+              Sjmin(il) = max((Sij(il,i,j-1)+Smid(il))/2., Scrit(il))*max(0., -signhpmh(il)) + &
+                          min((Sij(il,i,j+1)+Smid(il))/2., Scrit(il))*max(0., signhpmh(il))
+              Sjmin(il) = max(Sjmin(il), sup(il))
+              Sjmax(il) = 1.
+
+! -             preparation des variables Scrit, Smin et Sbef pour la partie j>i
+              Scrit(il) = min(Sjmin(il), Sjmax(il), Scrit(il))
 
               smin(il) = 1.
-              sbef(il) = max(0., signhpmh(il))
-              supmax(il, i) = sign(scrit(il), -signhpmh(il))
-            END IF
-          END IF
-        END DO
-        ! -----------------------------------------------
+              Sbef(il) = max(0., signhpmh(il))
+              supmax(il, i) = sign(Scrit(il), -signhpmh(il))
+            END IF
+          END IF
+        END DO
+! -----------------------------------------------
       ELSE IF (j<i) THEN
-        ! -----------------------------------------------
+! -----------------------------------------------
         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)>0.0) THEN
-              smid(il) = max(sij(il,i,j), scrit(il))
-              sjmax(il) = smid(il)
-              sjmin(il) = smid(il)
-              IF (smid(il)>smax(il) .AND. sij(il,i,j+1)>smid(il)) THEN
-                smax(il) = smid(il)
-                sjmax(il) = max((sij(il,i,j+1)+sij(il,i,j))/2., sij(il,i,j))
-                sjmax(il) = max(sjmax(il), scrit(il))
-                sjmin(il) = min((sbef(il)+sij(il,i,j))/2., sij(il,i,j))
-                sjmin(il) = max(sjmin(il), scrit(il))
-                sbef(il) = sij(il, i, j)
+          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)>0.0) THEN
+              Smid(il) = max(Sij(il,i,j), Scrit(il))
+              Sjmax(il) = Smid(il)
+              Sjmin(il) = Smid(il)
+              IF (Smid(il)>smax(il) .AND. Sij(il,i,j+1)>Smid(il)) THEN
+                smax(il) = Smid(il)
+                Sjmax(il) = max((Sij(il,i,j+1)+Sij(il,i,j))/2., Sij(il,i,j))
+                Sjmax(il) = max(Sjmax(il), Scrit(il))
+                Sjmin(il) = min((Sbef(il)+Sij(il,i,j))/2., Sij(il,i,j))
+                Sjmin(il) = max(Sjmin(il), Scrit(il))
+                Sbef(il) = Sij(il, i, j)
               END IF
-              IF (abs(sjmin(il)-sjmax(il))>1.E-10) sup(il) = max(sjmin(il), &
-                sjmax(il), sup(il))
-            END IF
-          END IF
-        END DO
-        ! -----------------------------------------------
-      END IF
-      ! -----------------------------------------------
-
-
-      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)>0.0) THEN
+              IF (abs(Sjmin(il)-Sjmax(il))>1.E-10) &
+                             sup(il) = max(Sjmin(il), Sjmax(il), sup(il))
+            END IF
+          END IF
+        END DO
+! -----------------------------------------------
+      END IF
+! -----------------------------------------------
+
+
+      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)>0.0) THEN
             rti = qnk(il) - ep(il, i)*clw(il, i)
-            qmixmax(il) = qmix(sjmax(il))
-            qmixmin(il) = qmix(sjmin(il))
-            rmixmax(il) = rmix(sjmax(il))
-            rmixmin(il) = rmix(sjmin(il))
-            sqmrmax(il) = sjmax(il)*qmix(sjmax(il)) - rmix(sjmax(il))
-            sqmrmin(il) = sjmin(il)*qmix(sjmin(il)) - rmix(sjmin(il))
-
-            ment(il, i, j) = abs(qmixmax(il)-qmixmin(il))*ment(il, i, j)
-
-            ! Sigij(i,j) is the 'true' mixing fraction of mixture Ment(i,j)
-            IF (abs(qmixmax(il)-qmixmin(il))>1.E-10) THEN
-              sigij(il, i, j) = (sqmrmax(il)-sqmrmin(il))/ &
-                (qmixmax(il)-qmixmin(il))
+            Qmixmax(il) = Qmix(Sjmax(il))
+            Qmixmin(il) = Qmix(Sjmin(il))
+            Rmixmax(il) = Rmix(Sjmax(il))
+            Rmixmin(il) = Rmix(Sjmin(il))
+            sqmrmax(il) = Sjmax(il)*Qmix(Sjmax(il)) - Rmix(Sjmax(il))
+            sqmrmin(il) = Sjmin(il)*Qmix(Sjmin(il)) - Rmix(Sjmin(il))
+
+            Ment(il, i, j) = abs(Qmixmax(il)-Qmixmin(il))*Ment(il, i, j)
+
+! Sigij(i,j) is the 'true' mixing fraction of mixture Ment(i,j)
+            IF (abs(Qmixmax(il)-Qmixmin(il))>1.E-10) THEN
+              Sigij(il, i, j) = (sqmrmax(il)-sqmrmin(il))/(Qmixmax(il)-Qmixmin(il))
             ELSE
-              sigij(il, i, j) = 0.
-            END IF
-
-            ! --    Compute Qent, uent, vent according to the true mixing
-            ! fraction
-            qent(il, i, j) = (1.-sigij(il,i,j))*rti + &
-              sigij(il, i, j)*rr(il, i)
-            uent(il, i, j) = (1.-sigij(il,i,j))*unk(il) + &
-              sigij(il, i, j)*u(il, i)
-            vent(il, i, j) = (1.-sigij(il,i,j))*vnk(il) + &
-              sigij(il, i, j)*v(il, i)
-
-            ! --     Compute liquid water static energy of mixed draughts
-            ! IF (j .GT. i) THEN
-            ! awat=elij(il,i,j)-(1.-ep(il,j))*clw(il,j)
-            ! awat=amax1(awat,0.0)
-            ! ELSE
-            ! awat = 0.
-            ! ENDIF
-            ! Hent(il,i,j) = (1.-Sigij(il,i,j))*HP(il,i)
-            ! :         + Sigij(il,i,j)*H(il,i)
-            ! :         + (LV(il,j)+(cpd-cpv)*t(il,j))*awat
-            ! IM 301008 beg
-            hent(il, i, j) = (1.-sigij(il,i,j))*hp(il, i) + &
-              sigij(il, i, j)*h(il, i)
-
-            elij(il, i, j) = qent(il, i, j) - rs(il, j)
-            elij(il, i, j) = elij(il, i, j) + ((h(il,j)-hent(il,i, &
-              j))*rs(il,j)*lv(il,j)/((cpd*(1.-qent(il,i,j))+ &
-              qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
-            elij(il, i, j) = elij(il, i, j)/(1.+lv(il,j)*lv(il,j)*rs(il,j)/(( &
-              cpd*(1.-qent(il,i,j))+qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
+              Sigij(il, i, j) = 0.
+            END IF
+
+! --    Compute Qent, uent, vent according to the true mixing fraction
+            Qent(il, i, j) = (1.-Sigij(il,i,j))*rti     + Sigij(il, i, j)*rr(il, i)
+            uent(il, i, j) = (1.-Sigij(il,i,j))*unk(il) + Sigij(il, i, j)*u(il, i)
+            vent(il, i, j) = (1.-Sigij(il,i,j))*vnk(il) + Sigij(il, i, j)*v(il, i)
+
+! --     Compute liquid water static energy of mixed draughts
+!    IF (j .GT. i) THEN
+!      awat=elij(il,i,j)-(1.-ep(il,j))*clw(il,j)
+!      awat=amax1(awat,0.0)
+!    ELSE
+!      awat = 0.
+!    ENDIF
+!    Hent(il,i,j) = (1.-Sigij(il,i,j))*HP(il,i)
+!    :         + Sigij(il,i,j)*H(il,i)
+!    :         + (LV(il,j)+(cpd-cpv)*t(il,j))*awat
+!IM 301008 beg
+            hent(il, i, j) = (1.-Sigij(il,i,j))*hp(il, i) + Sigij(il, i, j)*h(il, i)
+
+            elij(il, i, j) = Qent(il, i, j) - rs(il, j)
+            elij(il, i, j) = elij(il, i, j) + &
+                             ((h(il,j)-hent(il,i,j))*rs(il,j)*lv(il,j) / &
+                              ((cpd*(1.-Qent(il,i,j))+Qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
+            elij(il, i, j) = elij(il, i, j) / &
+                             (1.+lv(il,j)*lv(il,j)*rs(il,j) / &
+                              ((cpd*(1.-Qent(il,i,j))+Qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
 
             elij(il, i, j) = max(elij(il,i,j), 0.)
 
-            elij(il, i, j) = min(elij(il,i,j), qent(il,i,j))
+            elij(il, i, j) = min(elij(il,i,j), Qent(il,i,j))
 
             IF (j>i) THEN
@@ -455 +453 @@
             END IF
 
-            ! print
-            ! *,h(il,j)-hent(il,i,j),LV(il,j)*rs(il,j)/(cpd*rrv*t(il,j)*
-            ! :         t(il,j))
-
-            hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))* &
-              awat
-            ! IM 301008 end
-
-            ! print *,'mix : i,j,hent(il,i,j),sigij(il,i,j) ',
-            ! :               i,j,hent(il,i,j),sigij(il,i,j)
-
-            ! --      ASij is the integral of P(F) over the relevant F
-            ! interval
-            asij(il) = asij(il) + abs(qmixmax(il)*(1.-sjmax(il))+rmixmax(il)- &
-              qmixmin(il)*(1.-sjmin(il))-rmixmin(il))
+! print *,h(il,j)-hent(il,i,j),LV(il,j)*rs(il,j)/(cpd*rrv*t(il,j)*
+! :         t(il,j))
+
+            hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))*awat
+!IM 301008 end
+
+! print *,'mix : i,j,hent(il,i,j),Sigij(il,i,j) ',
+! :               i,j,hent(il,i,j),Sigij(il,i,j)
+
+! --      ASij is the integral of P(F) over the relevant F interval
+            ASij(il) = ASij(il) + abs(Qmixmax(il)*(1.-Sjmax(il))+Rmixmax(il) - &
+                                      Qmixmin(il)*(1.-Sjmin(il))-Rmixmin(il))
 
           END IF
@@ -476 +471 @@
       DO k = 1, ntra
         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)>0.0) THEN
-              traent(il, i, j, k) = sigij(il, i, j)*tra(il, i, k) + &
-                (1.-sigij(il,i,j))*tra(il, nk(il), k)
-            END IF
-          END IF
-        END DO
-      END DO
-
-      ! --    If I=J (detrainement and entrainement at the same level), then
-      ! only the
-      ! --    adiabatic ascent part of the mixture is considered
+          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)>0.0) THEN
+              traent(il, i, j, k) = Sigij(il, i, j)*tra(il, i, k) + &
+                                    (1.-Sigij(il,i,j))*tra(il, nk(il), k)
+            END IF
+          END IF
+        END DO
+      END DO
+
+! --    If I=J (detrainement and entrainement at the same level), then only the
+! --    adiabatic ascent part of the mixture is considered
       IF (i==j) THEN
         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)>0.0) THEN
+          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)>0.0) THEN
               rti = qnk(il) - ep(il, i)*clw(il, i)
-              ! cc          Ment(il,i,i) =
-              ! m(il,i)*abs(Qmixmax(il)*(1.-Sjmax(il))
-              ment(il, i, i) = abs(qmixmax(il)*(1.-sjmax( &
-                il))+rmixmax(il)-qmixmin(il)*(1.-sjmin(il))-rmixmin(il))
-              qent(il, i, i) = rti
+!!!             Ment(il,i,i) = m(il,i)*abs(Qmixmax(il)*(1.-Sjmax(il))
+              Ment(il, i, i) = abs(Qmixmax(il)*(1.-Sjmax(il))+Rmixmax(il) - &
+                                   Qmixmin(il)*(1.-Sjmin(il))-Rmixmin(il))
+              Qent(il, i, i) = rti
               uent(il, i, i) = unk(il)
               vent(il, i, i) = vnk(il)
               hent(il, i, i) = hp(il, i)
               elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
-              sigij(il, i, i) = 0.
+              Sigij(il, i, i) = 0.
             END IF
           END IF
@@ -510 +505 @@
         DO k = 1, ntra
           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)>0.0) THEN
+            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)>0.0) THEN
                 traent(il, i, i, k) = tra(il, nk(il), k)
               END IF
@@ -521 +517 @@
       END IF
 
-175 END DO
+! ---------------------------------------------------------------
+175 END DO        ! End loop on destination level "j"
+! ---------------------------------------------------------------
 
     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)
+        ASij(il) = amax1(1.0E-16, ASij(il))
+        ASij(il) = 1.0/ASij(il)
         csum(il, i) = 0.0
       END IF
@@ -533 +531 @@
     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)
+        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
@@ -542 +540 @@
     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)
+        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
@@ -550 +548 @@
 
     DO il = 1, ncum
-      IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) &
-          THEN
-        ! cc     :     .and. csum(il,i).lt.m(il,i) ) then
+      IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
+! cc     :     .and. csum(il,i).lt.m(il,i) ) then
         nent(il, i) = 0
-        ! cc        ment(il,i,i)=m(il,i)
-        ment(il, i, i) = 1.
-        qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
+! cc        Ment(il,i,i)=m(il,i)
+        Ment(il, i, i) = 1.
+        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)*(1.-ep(il,i))
-        sij(il, i, i) = 0.0
+        Sij(il, i, i) = 0.0
       END IF
     END DO ! il
@@ -566 +563 @@
     DO j = 1, ntra
       DO il = 1, ncum
-        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) &
-            THEN
-          ! cc     :     .and. csum(il,i).lt.m(il,i) ) then
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
+! cc     :     .and. csum(il,i).lt.m(il,i) ) then
           traent(il, i, i, j) = tra(il, nk(il), j)
         END IF
@@ -574 +570 @@
     END DO
 
-789 END DO
+! ---------------------------------------------------------------
+789 END DO              ! End loop on origin level "i"
+! ---------------------------------------------------------------
+
 
   RETURN

LMDZ5/trunk/libf/phylmd/cva_driver.F90

@@ -2 +2 @@
 ! $Id$
 
-SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, iflag_con, iflag_mix, &
-    iflag_ice_thermo, iflag_clos, delt, t1, q1, qs1, t1_wake, q1_wake, &
-    qs1_wake, s1_wake, u1, v1, tra1, p1, ph1, ale1, alp1, sig1feed1, &
-    sig2feed1, wght1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, kbas1, &
-    ktop1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, & !input/output
-    ptop21, sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, qcondc1, wd1, &
-    cape1, cin1, tvp1, ftd1, fqd1, plim11, plim21, asupmax1, supmax01, &
-    asupmaxmin1, lalim_conv, da1, phi1, mp1, phi21, d1a1, dam1, sigij1, clw1, & ! RomP
-    elij1, evap1, ep1, epmlmmm1, eplamm1, & ! RomP
-    wdtraina1, wdtrainm1) ! RomP
-  ! **************************************************************
-  ! *
-  ! CV_DRIVER                                                   *
-  ! *
-  ! *
-  ! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
-  ! modified by :                                               *
-  ! **************************************************************
-  ! **************************************************************
+SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, &
+                      iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
+                      delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
+                      u1, v1, tra1, &
+                      p1, ph1, &
+                      Ale1, Alp1, &
+                      sig1feed1, sig2feed1, wght1, &
+                      iflag1, ft1, fq1, fu1, fv1, ftra1, &
+                      precip1, kbas1, ktop1, &
+                      cbmf1, plcl1, plfc1, wbeff1, &
+                      sig1, w01, & !input/output
+                      ptop21, sigd1, &
+                      ma1, mip1, Vprecip1, upwd1, dnwd1, dnwd01, &
+                      qcondc1, wd1, &
+                      cape1, cin1, tvp1, &
+                      ftd1, fqd1, &
+                      Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
+                      lalim_conv, & 
+!!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
+!!                      elij1,evap1,ep1,epmlmMm1,eplaMm1, &                ! RomP
+                      da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
+                      clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &        ! RomP, RL
+                      wdtrainA1, wdtrainM1)                                ! RomP
+! **************************************************************
+! *
+! CV_DRIVER                                                   *
+! *
+! *
+! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
+! modified by :                                               *
+! **************************************************************
+! **************************************************************
 
   USE dimphy
   IMPLICIT NONE
 
-  ! .............................START PROLOGUE............................
-
-
-  ! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
-  ! "1" appended.
-  ! The "1" is removed for the corresponding compressed variables.
-  ! PARAMETERS:
-  ! Name            Type         Usage            Description
-  ! ----------      ----------     -------  ----------------------------
-
-  ! len           Integer        Input        first (i) dimension
-  ! nd            Integer        Input        vertical (k) dimension
-  ! ndp1          Integer        Input        nd + 1
-  ! ntra          Integer        Input        number of tracors
-  ! iflag_con     Integer        Input        version of convect (3/4)
-  ! iflag_mix     Integer        Input        version of mixing  (0/1/2)
-  ! iflag_ice_thermo Integer        Input        accounting for ice
-  ! thermodynamics (0/1)
-  ! iflag_clos    Integer        Input        version of closure (0/1)
-  ! delt          Real           Input        time step
-  ! t1            Real           Input        temperature (sat draught envt)
-  ! q1            Real           Input        specific hum (sat draught envt)
-  ! qs1           Real           Input        sat specific hum (sat draught
-  ! envt)
-  ! t1_wake       Real           Input        temperature (unsat draught
-  ! envt)
-  ! q1_wake       Real           Input        specific hum(unsat draught
-  ! envt)
-  ! qs1_wake      Real           Input        sat specific hum(unsat draughts
-  ! envt)
-  ! s1_wake       Real           Input        fractionnal area covered by
-  ! wakes
-  ! u1            Real           Input        u-wind
-  ! v1            Real           Input        v-wind
-  ! tra1          Real           Input        tracors
-  ! p1            Real           Input        full level pressure
-  ! ph1           Real           Input        half level pressure
-  ! ALE1          Real           Input        Available lifting Energy
-  ! ALP1          Real           Input        Available lifting Power
-  ! sig1feed1     Real           Input        sigma coord at lower bound of
-  ! feeding layer
-  ! sig2feed1     Real           Input        sigma coord at upper bound of
-  ! feeding layer
-  ! wght1         Real           Input        weight density determining the
-  ! feeding mixture
-  ! iflag1        Integer        Output       flag for Emanuel conditions
-  ! ft1           Real           Output       temp tend
-  ! fq1           Real           Output       spec hum tend
-  ! fu1           Real           Output       u-wind tend
-  ! fv1           Real           Output       v-wind tend
-  ! ftra1         Real           Output       tracor tend
-  ! precip1       Real           Output       precipitation
-  ! kbas1         Integer        Output       cloud base level
-  ! ktop1         Integer        Output       cloud top level
-  ! cbmf1         Real           Output       cloud base mass flux
-  ! sig1          Real           In/Out       section adiabatic updraft
-  ! w01           Real           In/Out       vertical velocity within adiab
-  ! updraft
-  ! ptop21        Real           In/Out       top of entraining zone
-  ! Ma1           Real           Output       mass flux adiabatic updraft
-  ! mip1          Real           Output       mass flux shed by the adiabatic
-  ! updraft
-  ! Vprecip1      Real           Output       vertical profile of
-  ! precipitations
-  ! upwd1         Real           Output       total upward mass flux
-  ! (adiab+mixed)
-  ! dnwd1         Real           Output       saturated downward mass flux
-  ! (mixed)
-  ! dnwd01        Real           Output       unsaturated downward mass flux
-  ! qcondc1       Real           Output       in-cld mixing ratio of
-  ! condensed water
-  ! wd1           Real           Output       downdraft velocity scale for
-  ! sfc fluxes
-  ! cape1         Real           Output       CAPE
-  ! cin1          Real           Output       CIN
-  ! tvp1          Real           Output       adiab lifted parcell virt temp
-  ! ftd1          Real           Output       precip temp tend
-  ! fqt1          Real           Output       precip spec hum tend
-  ! Plim11        Real           Output
-  ! Plim21        Real           Output
-  ! asupmax1      Real           Output
-  ! supmax01      Real           Output
-  ! asupmaxmin1   Real           Output
-
-  ! ftd1          Real           Output  Array of temperature tendency due to
-  ! precipitations (K/s) of dimension ND,
-  ! defined at same grid levels as T, Q, QS and P.
-
-  ! fqd1          Real           Output  Array of specific humidity
-  ! tendencies due to precipitations ((gm/gm)/s)
-  ! of dimension ND, defined at same grid levels as T, Q, QS and P.
-
-  ! wdtrainA1     Real           Output   precipitation detrained from
-  ! adiabatic draught;
-  ! used in tracer transport (cvltr)
-  ! wdtrainM1     Real           Output   precipitation detrained from mixed
-  ! draughts;
-  ! used in tracer transport (cvltr)
-  ! da1           Real           Output   used in tracer transport (cvltr)
-  ! phi1          Real           Output   used in tracer transport (cvltr)
-  ! mp1           Real           Output   used in tracer transport (cvltr)
-
-  ! phi21         Real           Output   used in tracer transport (cvltr)
-
-  ! d1a1          Real           Output   used in tracer transport (cvltr)
-  ! dam1          Real           Output   used in tracer transport (cvltr)
-
-  ! epmlmMm1      Real           Output   used in tracer transport (cvltr)
-  ! eplaMm1       Real           Output   used in tracer transport (cvltr)
-
-  ! evap1         Real           Output
-  ! ep1           Real           Output
-  ! sigij1        Real           Output
-  ! elij1         Real           Output
-
-
-  ! S. Bony, Mar 2002:
-  ! * Several modules corresponding to different physical processes
-  ! * Several versions of convect may be used:
-  ! - iflag_con=3: version lmd  (previously named convect3)
-  ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
-  ! + tard:     - iflag_con=5: version lmd with ice (previously named convectg)
-  ! S. Bony, Oct 2002:
-  ! * Vectorization of convect3 (ie version lmd)
-
-  ! ..............................END PROLOGUE.............................
+! .............................START PROLOGUE............................
+
+
+! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
+! The "1" is removed for the corresponding compressed variables.
+! PARAMETERS:
+! Name            Type         Usage            Description
+! ----------      ----------     -------  ----------------------------
+
+! len           Integer        Input        first (i) dimension
+! nd            Integer        Input        vertical (k) dimension
+! ndp1          Integer        Input        nd + 1
+! ntra          Integer        Input        number of tracors
+! iflag_con     Integer        Input        version of convect (3/4)
+! iflag_mix     Integer        Input        version of mixing  (0/1/2)
+! iflag_ice_thermo Integer        Input        accounting for ice thermodynamics (0/1)
+! iflag_clos    Integer        Input        version of closure (0/1)
+! ok_conserv_q  Logical        Input        when true corrections for water conservation are swtiched on
+! delt          Real           Input        time step
+! t1            Real           Input        temperature (sat draught envt)
+! q1            Real           Input        specific hum (sat draught envt)
+! qs1           Real           Input        sat specific hum (sat draught envt)
+! t1_wake       Real           Input        temperature (unsat draught envt)
+! q1_wake       Real           Input        specific hum(unsat draught envt)
+! qs1_wake      Real           Input        sat specific hum(unsat draughts envt)
+! s1_wake       Real           Input        fractionnal area covered by wakes
+! u1            Real           Input        u-wind
+! v1            Real           Input        v-wind
+! tra1          Real           Input        tracors
+! p1            Real           Input        full level pressure
+! ph1           Real           Input        half level pressure
+! ALE1          Real           Input        Available lifting Energy
+! ALP1          Real           Input        Available lifting Power
+! sig1feed1     Real           Input        sigma coord at lower bound of feeding layer
+! sig2feed1     Real           Input        sigma coord at upper bound of feeding layer
+! wght1         Real           Input        weight density determining the feeding mixture
+! iflag1        Integer        Output       flag for Emanuel conditions
+! ft1           Real           Output       temp tend
+! fq1           Real           Output       spec hum tend
+! fu1           Real           Output       u-wind tend
+! fv1           Real           Output       v-wind tend
+! ftra1         Real           Output       tracor tend
+! precip1       Real           Output       precipitation
+! kbas1         Integer        Output       cloud base level
+! ktop1         Integer        Output       cloud top level
+! cbmf1         Real           Output       cloud base mass flux
+! sig1          Real           In/Out       section adiabatic updraft
+! w01           Real           In/Out       vertical velocity within adiab updraft
+! ptop21        Real           In/Out       top of entraining zone
+! Ma1           Real           Output       mass flux adiabatic updraft
+! mip1          Real           Output       mass flux shed by the adiabatic updraft
+! Vprecip1      Real           Output       vertical profile of precipitations
+! upwd1         Real           Output       total upward mass flux (adiab+mixed)
+! dnwd1         Real           Output       saturated downward mass flux (mixed)
+! dnwd01        Real           Output       unsaturated downward mass flux
+! qcondc1       Real           Output       in-cld mixing ratio of condensed water
+! wd1           Real           Output       downdraft velocity scale for sfc fluxes
+! cape1         Real           Output       CAPE
+! cin1          Real           Output       CIN
+! tvp1          Real           Output       adiab lifted parcell virt temp
+! ftd1          Real           Output       precip temp tend
+! fqt1          Real           Output       precip spec hum tend
+! Plim11        Real           Output
+! Plim21        Real           Output
+! asupmax1      Real           Output
+! supmax01      Real           Output
+! asupmaxmin1   Real           Output
+
+! ftd1          Real           Output  Array of temperature tendency due to precipitations (K/s) of dimension ND,
+!                                      defined at same grid levels as T, Q, QS and P.
+
+! fqd1          Real           Output  Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
+!                                      of dimension ND, defined at same grid levels as T, Q, QS and P.
+
+! wdtrainA1     Real           Output   precipitation detrained from adiabatic draught;
+!                                         used in tracer transport (cvltr)
+! wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
+!                                         used in tracer transport (cvltr)
+! da1           Real           Output     used in tracer transport (cvltr)
+! phi1          Real           Output     used in tracer transport (cvltr)
+! mp1           Real           Output     used in tracer transport (cvltr)
+                                         
+! phi21         Real           Output     used in tracer transport (cvltr)
+                                         
+! d1a1          Real           Output     used in tracer transport (cvltr)
+! dam1          Real           Output     used in tracer transport (cvltr)
+                                         
+! epmlmMm1      Real           Output     used in tracer transport (cvltr)
+! eplaMm1       Real           Output     used in tracer transport (cvltr)
+                                         
+! evap1         Real           Output    
+! ep1           Real           Output    
+! sigij1        Real           Output     used in tracer transport (cvltr)
+! elij1         Real           Output
+! wghti1        Real           Output   final weight of the feeding layers,
+!                                         used in tracer transport (cvltr)
+
+
+! S. Bony, Mar 2002:
+! * Several modules corresponding to different physical processes
+! * Several versions of convect may be used:
+!         - iflag_con=3: version lmd  (previously named convect3)
+!         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
+! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
+! S. Bony, Oct 2002:
+! * Vectorization of convect3 (ie version lmd)
+
+! ..............................END PROLOGUE.............................
 
 
   include "dimensions.h"
-  ! cccc#include "dimphy.h"
+!!!!!#include "dimphy.h"
   include 'iniprint.h'
 
 
-  ! Input
+! Input
   INTEGER len
   INTEGER nd
@@ -167 +162 @@
   INTEGER iflag_ice_thermo
   INTEGER iflag_clos
+  LOGICAL ok_conserv_q
   REAL delt
   REAL t1(len, nd)
@@ -180 +176 @@
   REAL p1(len, nd)
   REAL ph1(len, ndp1)
-  REAL ale1(len)
-  REAL alp1(len)
+  REAL Ale1(len)
+  REAL Alp1(len)
   REAL sig1feed1 ! pressure at lower bound of feeding layer
   REAL sig2feed1 ! pressure at upper bound of feeding layer
   REAL wght1(nd) ! weight density determining the feeding mixture
 
-  ! Output
+! Output
   INTEGER iflag1(len)
   REAL ft1(len, nd)
@@ -206 +202 @@
   REAL ma1(len, nd)
   REAL mip1(len, nd)
-  ! real Vprecip1(len,nd)
+! real Vprecip1(len,nd)
   REAL vprecip1(len, nd+1)
   REAL upwd1(len, nd)
@@ -217 +213 @@
   REAL tvp1(len, nd)
 
-  ! AC!
-  ! !      real da1(len,nd),phi1(len,nd,nd)
-  ! !      real da(len,nd),phi(len,nd,nd)
-  ! AC!
+!AC!
+!!      real da1(len,nd),phi1(len,nd,nd)
+!!      real da(len,nd),phi(len,nd,nd)
+!AC!
   REAL ftd1(len, nd)
   REAL fqd1(len, nd)
-  REAL plim11(len)
-  REAL plim21(len)
+  REAL Plim11(len)
+  REAL Plim21(len)
   REAL asupmax1(len, nd)
   REAL supmax01(len)
   REAL asupmaxmin1(len)
   INTEGER lalim_conv(len)
-  ! RomP >>>
-  REAL wdtraina1(len, nd), wdtrainm1(len, nd)
+! RomP >>>
+  REAL wdtrainA1(len, nd), wdtrainM1(len, nd)
   REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
-  REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
+  REAL epmlmMm1(len, nd, nd), eplaMm1(len, nd)
   REAL evap1(len, nd), ep1(len, nd)
   REAL sigij1(len, nd, nd), elij1(len, nd, nd)
+!JYG,RL
+  REAL wghti1(len, nd) ! final weight of the feeding layers
+!JYG,RL
   REAL phi21(len, nd, nd)
   REAL d1a1(len, nd), dam1(len, nd)
-  ! RomP <<<
-
-  ! -------------------------------------------------------------------
-  ! Prolog by Kerry Emanuel.
-  ! -------------------------------------------------------------------
-  ! --- ARGUMENTS
-  ! -------------------------------------------------------------------
-  ! --- On input:
-
-  ! t:   Array of absolute temperature (K) of dimension ND, with first
-  ! index corresponding to lowest model level. Note that this array
-  ! will be altered by the subroutine if dry convective adjustment
-  ! occurs and if IPBL is not equal to 0.
-
-  ! q:   Array of specific humidity (gm/gm) of dimension ND, with first
-  ! index corresponding to lowest model level. Must be defined
-  ! at same grid levels as T. Note that this array will be altered
-  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! qs:  Array of saturation specific humidity of dimension ND, with first
-  ! index corresponding to lowest model level. Must be defined
-  ! at same grid levels as T. Note that this array will be altered
-  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
-  ! of dimension ND, with first index corresponding to lowest model level.
-
-  ! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
-  ! of dimension ND, with first index corresponding to lowest model level.
-  ! Must be defined at same grid levels as T.
-
-  ! qs_wake: Array of saturation specific humidity, seen by unsaturated
-  ! draughts,
-  ! of dimension ND, with first index corresponding to lowest model level.
-  ! Must be defined at same grid levels as T.
-
-  ! s_wake: Array of fractionnal area occupied by the wakes.
-
-  ! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
-  ! index corresponding with the lowest model level. Defined at
-  ! same levels as T. Note that this array will be altered if
-  ! dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! v:   Same as u but for meridional velocity.
-
-  ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
-  ! where NTRA is the number of different tracers. If no
-  ! convective tracer transport is needed, define a dummy
-  ! input array of dimension (ND,1). Tracers are defined at
-  ! same vertical levels as T. Note that this array will be altered
-  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! p:   Array of pressure (mb) of dimension ND, with first
-  ! index corresponding to lowest model level. Must be defined
-  ! at same grid levels as T.
-
-  ! ph:  Array of pressure (mb) of dimension ND+1, with first index
-  ! corresponding to lowest level. These pressures are defined at
-  ! levels intermediate between those of P, T, Q and QS. The first
-  ! value of PH should be greater than (i.e. at a lower level than)
-  ! the first value of the array P.
-
-  ! ALE:  Available lifting Energy
-
-  ! ALP:  Available lifting Power
-
-  ! nl:  The maximum number of levels to which convection can penetrate, plus
-  ! 1.
-  ! NL MUST be less than or equal to ND-1.
-
-  ! delt: The model time step (sec) between calls to CONVECT
-
-  ! ----------------------------------------------------------------------------
-  ! ---   On Output:
-
-  ! iflag: An output integer whose value denotes the following:
-  ! VALUE   INTERPRETATION
-  ! -----   --------------
-  ! 0     Moist convection occurs.
-  ! 1     Moist convection occurs, but a CFL condition
-  ! on the subsidence warming is violated. This
-  ! does not cause the scheme to terminate.
-  ! 2     Moist convection, but no precip because ep(inb) lt 0.0001
-  ! 3     No moist convection because new cbmf is 0 and old cbmf is 0.
-  ! 4     No moist convection; atmosphere is not
-  ! unstable
-  ! 6     No moist convection because ihmin le minorig.
-  ! 7     No moist convection because unreasonable
-  ! parcel level temperature or specific humidity.
-  ! 8     No moist convection: lifted condensation
-  ! level is above the 200 mb level.
-  ! 9     No moist convection: cloud base is higher
-  ! then the level NL-1.
-
-  ! ft:   Array of temperature tendency (K/s) of dimension ND, defined at
-  ! same
-  ! grid levels as T, Q, QS and P.
-
-  ! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
-  ! defined at same grid levels as T, Q, QS and P.
-
-  ! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
-  ! defined at same grid levels as T.
-
-  ! fv:   Same as FU, but for forcing of meridional velocity.
-
-  ! ftra: Array of forcing of tracer content, in tracer mixing ratio per
-  ! second, defined at same levels as T. Dimensioned (ND,NTRA).
-
-  ! precip: Scalar convective precipitation rate (mm/day).
-
-  ! wd:   A convective downdraft velocity scale. For use in surface
-  ! flux parameterizations. See convect.ps file for details.
-
-  ! tprime: A convective downdraft temperature perturbation scale (K).
-  ! For use in surface flux parameterizations. See convect.ps
-  ! file for details.
-
-  ! qprime: A convective downdraft specific humidity
-  ! perturbation scale (gm/gm).
-  ! For use in surface flux parameterizations. See convect.ps
-  ! file for details.
-
-  ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
-  ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
-  ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
-  ! by the calling program between calls to CONVECT.
-
-  ! det:   Array of detrainment mass flux of dimension ND.
-  ! -------------------------------------------------------------------
-
-  ! Local arrays
+! RomP <<<
+
+! -------------------------------------------------------------------
+! Prolog by Kerry Emanuel.
+! -------------------------------------------------------------------
+! --- ARGUMENTS
+! -------------------------------------------------------------------
+! --- On input:
+
+! t:   Array of absolute temperature (K) of dimension ND, with first
+! index corresponding to lowest model level. Note that this array
+! will be altered by the subroutine if dry convective adjustment
+! occurs and if IPBL is not equal to 0.
+
+! q:   Array of specific humidity (gm/gm) of dimension ND, with first
+! index corresponding to lowest model level. Must be defined
+! at same grid levels as T. Note that this array will be altered
+! if dry convective adjustment occurs and if IPBL is not equal to 0.
+
+! qs:  Array of saturation specific humidity of dimension ND, with first
+! index corresponding to lowest model level. Must be defined
+! at same grid levels as T. Note that this array will be altered
+! if dry convective adjustment occurs and if IPBL is not equal to 0.
+
+! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
+! of dimension ND, with first index corresponding to lowest model level.
+
+! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
+! of dimension ND, with first index corresponding to lowest model level.
+! Must be defined at same grid levels as T.
+
+! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
+! of dimension ND, with first index corresponding to lowest model level.
+! Must be defined at same grid levels as T.
+
+! s_wake: Array of fractionnal area occupied by the wakes.
+
+! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
+! index corresponding with the lowest model level. Defined at
+! same levels as T. Note that this array will be altered if
+! dry convective adjustment occurs and if IPBL is not equal to 0.
+
+! v:   Same as u but for meridional velocity.
+
+! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
+! where NTRA is the number of different tracers. If no
+! convective tracer transport is needed, define a dummy
+! input array of dimension (ND,1). Tracers are defined at
+! same vertical levels as T. Note that this array will be altered
+! if dry convective adjustment occurs and if IPBL is not equal to 0.
+
+! p:   Array of pressure (mb) of dimension ND, with first
+! index corresponding to lowest model level. Must be defined
+! at same grid levels as T.
+
+! ph:  Array of pressure (mb) of dimension ND+1, with first index
+! corresponding to lowest level. These pressures are defined at
+! levels intermediate between those of P, T, Q and QS. The first
+! value of PH should be greater than (i.e. at a lower level than)
+! the first value of the array P.
+
+! ALE:  Available lifting Energy
+
+! ALP:  Available lifting Power
+
+! nl:  The maximum number of levels to which convection can penetrate, plus 1.
+!       NL MUST be less than or equal to ND-1.
+
+! delt: The model time step (sec) between calls to CONVECT
+
+! ----------------------------------------------------------------------------
+! ---   On Output:
+
+! iflag: An output integer whose value denotes the following:
+!       VALUE   INTERPRETATION
+!       -----   --------------
+!         0     Moist convection occurs.
+!         1     Moist convection occurs, but a CFL condition
+!               on the subsidence warming is violated. This
+!               does not cause the scheme to terminate.
+!         2     Moist convection, but no precip because ep(inb) lt 0.0001
+!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
+!         4     No moist convection; atmosphere is not
+!               unstable
+!         6     No moist convection because ihmin le minorig.
+!         7     No moist convection because unreasonable
+!               parcel level temperature or specific humidity.
+!         8     No moist convection: lifted condensation
+!               level is above the 200 mb level.
+!         9     No moist convection: cloud base is higher
+!               then the level NL-1.
+
+! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
+!       grid levels as T, Q, QS and P.
+
+! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
+!       defined at same grid levels as T, Q, QS and P.
+
+! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
+!      defined at same grid levels as T.
+
+! fv:   Same as FU, but for forcing of meridional velocity.
+
+! ftra: Array of forcing of tracer content, in tracer mixing ratio per
+!       second, defined at same levels as T. Dimensioned (ND,NTRA).
+
+! precip: Scalar convective precipitation rate (mm/day).
+
+! wd:   A convective downdraft velocity scale. For use in surface
+!       flux parameterizations. See convect.ps file for details.
+
+! tprime: A convective downdraft temperature perturbation scale (K).
+!         For use in surface flux parameterizations. See convect.ps
+!         file for details.
+
+! qprime: A convective downdraft specific humidity
+!         perturbation scale (gm/gm).
+!         For use in surface flux parameterizations. See convect.ps
+!         file for details.
+
+! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
+!       BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
+!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
+!       by the calling program between calls to CONVECT.
+
+! det:   Array of detrainment mass flux of dimension ND.
+! -------------------------------------------------------------------
+
+! Local (non compressed) arrays
 
 
@@ -380 +376 @@
   LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
   LOGICAL, SAVE :: debut = .TRUE.
-  !$OMP THREADPRIVATE(debut)
+!$OMP THREADPRIVATE(debut)
 
   REAL tnk1(klon)
@@ -414 +410 @@
   REAL p1feed1(len) ! pressure at lower bound of feeding layer
   REAL p2feed1(len) ! pressure at upper bound of feeding layer
-  REAL wghti1(len, nd) ! weights of the feeding layers
-
-  ! (local) compressed fields:
+!JYG,RL
+!!      real wghti1(len,nd) ! weights of the feeding layers
+!JYG,RL
+
+! (local) compressed fields:
 
   INTEGER nloc
-  ! parameter (nloc=klon) ! pour l'instant
+! parameter (nloc=klon) ! pour l'instant
 
   INTEGER idcum(nloc)
@@ -456 +454 @@
   REAL elij(nloc, klev, klev)
   REAL supmax(nloc, klev)
-  REAL ale(nloc), alp(nloc), coef_clos(nloc)
+  REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
   REAL sigd(nloc)
-  ! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
-  ! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
-  ! real b(nloc,klev), sigd(nloc)
-  ! save mp,qp,up,vp,wt,water,evap,b
+! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
+! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
+! real b(nloc,klev), sigd(nloc)
+! save mp,qp,up,vp,wt,water,evap,b
   REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
   REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
   REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
   REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
-  !$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
+!$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
   REAL ft(nloc, klev), fq(nloc, klev)
   REAL ftd(nloc, klev), fqd(nloc, klev)
@@ -474 +472 @@
   REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
   REAL precip(nloc)
-  ! real Vprecip(nloc,klev)
+! real Vprecip(nloc,klev)
   REAL vprecip(nloc, klev+1)
   REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
   REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
-  REAL qcondc(nloc, klev) ! cld
-  REAL wd(nloc) ! gust
-  REAL plim1(nloc), plim2(nloc)
+  REAL qcondc(nloc, klev)      ! cld
+  REAL wd(nloc)                ! gust
+  REAL Plim1(nloc), plim2(nloc)
   REAL asupmax(nloc, klev)
   REAL supmax0(nloc)
@@ -489 +487 @@
   REAL hnk(nloc), unk(nloc), vnk(nloc)
 
-  ! RomP >>>
-  REAL wdtraina(nloc, klev), wdtrainm(nloc, klev)
+! RomP >>>
+  REAL wdtrainA(nloc, klev), wdtrainM(nloc, klev)
   REAL da(len, nd), phi(len, nd, nd)
-  REAL epmlmmm(nloc, klev, klev), eplamm(nloc, klev)
+  REAL epmlmMm(nloc, klev, klev), eplaMm(nloc, klev)
   REAL phi2(len, nd, nd)
   REAL d1a(len, nd), dam(len, nd)
-  ! RomP <<<
+! RomP <<<
 
   LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
+!$OMP THREADPRIVATE(first)
   CHARACTER (LEN=20) :: modname = 'cva_driver'
   CHARACTER (LEN=80) :: abort_message
 
 
-  ! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
-  ! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
-
-  ! -------------------------------------------------------------------
-  ! --- SET CONSTANTS AND PARAMETERS
-  ! -------------------------------------------------------------------
+! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
+! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
+
+! -------------------------------------------------------------------
+! --- SET CONSTANTS AND PARAMETERS
+! -------------------------------------------------------------------
 
   IF (first) THEN
@@ -518 +516 @@
     first = .FALSE.
   END IF
-  ! -- set simulation flags:
-  ! (common cvflag)
+! -- set simulation flags:
+! (common cvflag)
 
   CALL cv_flag(iflag_ice_thermo)
 
-  ! -- set thermodynamical constants:
-  ! (common cvthermo)
+! -- set thermodynamical constants:
+! (common cvthermo)
 
   CALL cv_thermo(iflag_con)
 
-  ! -- set convect parameters
-
-  ! includes microphysical parameters and parameters that
-  ! control the rate of approach to quasi-equilibrium)
-  ! (common cvparam)
+! -- set convect parameters
+
+! includes microphysical parameters and parameters that
+! control the rate of approach to quasi-equilibrium)
+! (common cvparam)
 
   IF (iflag_con==3) THEN
@@ -543 +541 @@
   END IF
 
-  ! ---------------------------------------------------------------------
-  ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
-  ! ---------------------------------------------------------------------
+! ---------------------------------------------------------------------
+! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
+! ---------------------------------------------------------------------
   nword1 = len
   nword2 = len*nd
@@ -576 +574 @@
   ftd1(:, :) = 0.
   fqd1(:, :) = 0.
-  plim11(:) = 0.
-  plim21(:) = 0.
+  Plim11(:) = 0.
+  Plim21(:) = 0.
   asupmax1(:, :) = 0.
   supmax01(:) = 0.
@@ -594 +592 @@
   END IF
 
-  ! RomP >>>
-  wdtraina1(:, :) = 0.
-  wdtrainm1(:, :) = 0.
+! RomP >>>
+  wdtrainA1(:, :) = 0.
+  wdtrainM1(:, :) = 0.
   da1(:, :) = 0.
   phi1(:, :, :) = 0.
-  epmlmmm1(:, :, :) = 0.
-  eplamm1(:, :) = 0.
+  epmlmMm1(:, :, :) = 0.
+  eplaMm1(:, :) = 0.
   mp1(:, :) = 0.
   evap1(:, :) = 0.
@@ -609 +607 @@
   d1a1(:, :) = 0.
   dam1(:, :) = 0.
-  ! RomP <<<
-  ! ---------------------------------------------------------------------
-  ! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
-  ! ---------------------------------------------------------------------
+! RomP <<<
+! ---------------------------------------------------------------------
+! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
+! ---------------------------------------------------------------------
 
   DO il = 1, nloc
@@ -618 +616 @@
   END DO
 
-  ! --------------------------------------------------------------------
-  ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
-  ! --------------------------------------------------------------------
+! --------------------------------------------------------------------
+! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+! --------------------------------------------------------------------
 
   IF (iflag_con==3) THEN
@@ -627 +625 @@
       PRINT *, 'Emanuel version 3 nouvelle'
     END IF
-    ! print*,'t1, q1 ',t1,q1
-    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
-      , lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
-
-
-    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1 & !
-                                                               ! nd->na
-      , lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, h1_wake, bid, &
-      th1_wake)
+! print*,'t1, q1 ',t1,q1
+    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
+                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
+
+
+    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
+                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
+                    h1_wake, bid, th1_wake)
 
   END IF
@@ -641 +638 @@
   IF (iflag_con==4) THEN
     PRINT *, 'Emanuel version 4 '
-    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
-      hm1)
-  END IF
-
-  ! --------------------------------------------------------------------
-  ! --- CONVECTIVE FEED
-  ! --------------------------------------------------------------------
-
-  ! compute feeding layer potential temperature and mixing ratio :
-
-  ! get bounds of feeding layer
-
-  ! test niveaux couche alimentation KE
+    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
+                   lv1, cpn1, tv1, gz1, h1, hm1)
+  END IF
+
+! --------------------------------------------------------------------
+! --- CONVECTIVE FEED
+! --------------------------------------------------------------------
+
+! compute feeding layer potential temperature and mixing ratio :
+
+! get bounds of feeding layer
+
+! test niveaux couche alimentation KE
   IF (sig1feed1==sig2feed1) THEN
     WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
@@ -664 +661 @@
     p1feed1(i) = sig1feed1*ph1(i, 1)
     p2feed1(i) = sig2feed1*ph1(i, 1)
-    ! test maf
-    ! p1feed1(i)=ph1(i,1)
-    ! p2feed1(i)=ph1(i,2)
-    ! p2feed1(i)=ph1(i,3)
-    ! testCR: on prend la couche alim des thermiques
-    ! p2feed1(i)=ph1(i,lalim_conv(i)+1)
-    ! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
+!test maf
+!   p1feed1(i)=ph1(i,1)
+!   p2feed1(i)=ph1(i,2)
+!   p2feed1(i)=ph1(i,3)
+!testCR: on prend la couche alim des thermiques
+!   p2feed1(i)=ph1(i,lalim_conv(i)+1)
+!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
   END DO
 
@@ -676 +673 @@
   END IF
   DO i = 1, len
-    ! print*,'avant cv3_feed plim',p1feed1(i),p2feed1(i)
+! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
   END DO
   IF (iflag_con==3) THEN
 
-    ! print*, 'IFLAG1 avant cv3_feed'
-    ! print*,'len,nd',len,nd
-    ! write(*,'(64i1)') iflag1(2:klon-1)
-
-    CALL cv3_feed(len, nd, t1, q1, u1, v1, p1, ph1, hm1, gz1 & !
-                                                               ! nd->na
-      , p1feed1, p2feed1, wght1, wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, &
-      vnk1, cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
-  END IF
-
-  ! print*, 'IFLAG1 apres cv3_feed'
-  ! print*,'len,nd',len,nd
-  ! write(*,'(64i1)') iflag1(2:klon-1)
+! print*, 'IFLAG1 avant cv3_feed'
+! print*,'len,nd',len,nd
+! write(*,'(64i1)') iflag1(2:klon-1)
+
+    CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
+                  t1, q1, u1, v1, p1, ph1, hm1, gz1, & 
+                  p1feed1, p2feed1, wght1, &
+                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
+                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
+  END IF
+
+! print*, 'IFLAG1 apres cv3_feed'
+! print*,'len,nd',len,nd
+! write(*,'(64i1)') iflag1(2:klon-1)
 
   IF (iflag_con==4) THEN
-    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
-      iflag1, tnk1, qnk1, gznk1, plcl1)
-  END IF
-
-  ! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
-
-  ! --------------------------------------------------------------------
-  ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
-  ! (up through ICB for convect4, up through ICB+1 for convect3)
-  ! Calculates the lifted parcel virtual temperature at nk, the
-  ! actual temperature, and the adiabatic liquid water content.
-  ! --------------------------------------------------------------------
+    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
+                 nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
+  END IF
+
+! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
+
+! --------------------------------------------------------------------
+! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
+! (up through ICB for convect4, up through ICB+1 for convect3)
+! Calculates the lifted parcel virtual temperature at nk, the
+! actual temperature, and the adiabatic liquid water content.
+! --------------------------------------------------------------------
 
   IF (iflag_con==3) THEN
 
-    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1 & ! nd->na
-      , gznk1, tp1, tvp1, clw1, icbs1)
+    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
+                       gznk1, tp1, tvp1, clw1, icbs1)
   END IF
 
 
   IF (iflag_con==4) THEN
-    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
-      tvp1, clw1)
-  END IF
-
-  ! -------------------------------------------------------------------
-  ! --- TRIGGERING
-  ! -------------------------------------------------------------------
-
-  ! print *,' avant triggering, iflag_con ',iflag_con
+    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
+                      tp1, tvp1, clw1)
+  END IF
+
+! -------------------------------------------------------------------
+! --- TRIGGERING
+! -------------------------------------------------------------------
+
+! print *,' avant triggering, iflag_con ',iflag_con
 
   IF (iflag_con==3) THEN
 
-    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1 & !
-                                                                       ! nd->na
-      , pbase1, buoybase1, iflag1, sig1, w01)
-
-
-    ! print*, 'IFLAG1 apres cv3_triger'
-    ! print*,'len,nd',len,nd
-    ! write(*,'(64i1)') iflag1(2:klon-1)
-
-    ! call dump2d(iim,jjm-1,sig1(2)
+    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
+                      pbase1, buoybase1, iflag1, sig1, w01)
+
+
+! print*, 'IFLAG1 apres cv3_triger'
+! print*,'len,nd',len,nd
+! write(*,'(64i1)') iflag1(2:klon-1)
+
+! call dump2d(iim,jjm-1,sig1(2)
   END IF
 
@@ -745 +742 @@
 
 
-  ! =====================================================================
-  ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
-  ! =====================================================================
+! =====================================================================
+! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
+! =====================================================================
 
   ncum = 0
@@ -757 +754 @@
   END DO
 
-  ! print*,'klon, ncum = ',len,ncum
+! print*,'klon, ncum = ',len,ncum
 
   IF (ncum>0) THEN
 
-    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-    ! --- COMPRESS THE FIELDS
-    ! (-> vectorization over convective gridpoints)
-    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! --- COMPRESS THE FIELDS
+!       (-> vectorization over convective gridpoints)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
     IF (iflag_con==3) THEN
-      ! print*,'ncum tv1 ',ncum,tv1
-      ! print*,'tvp1 ',tvp1
-      CALL cv3a_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
-        plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, &
-        buoybase1, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, &
-        gz1, th1, th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, &
-        tvp1, clw1, h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, &
-        w01, ptop21, ale1, alp1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, &
-        hnk, unk, vnk, wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, &
-        qs_wake, s_wake, u, v, gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, &
-        tv, tp, tvp, clw, h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, sig, &
-        w0, ptop2, ale, alp)
-
-      ! print*,'tv ',tv
-      ! print*,'tvp ',tvp
+! print*,'ncum tv1 ',ncum,tv1
+! print*,'tvp1 ',tvp1
+      CALL cv3a_compress(len, nloc, ncum, nd, ntra, &
+                         iflag1, nk1, icb1, icbs1, &
+                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
+                         wghti1, pbase1, buoybase1, &
+                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
+                         u1, v1, gz1, th1, th1_wake, &
+                         tra1, &
+                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
+                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
+                         sig1, w01, ptop21, &
+                         Ale1, Alp1, &
+                         iflag, nk, icb, icbs, &
+                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
+                         wghti, pbase, buoybase, &
+                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
+                         u, v, gz, th, th_wake, &
+                         tra, &
+                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
+                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
+                         sig, w0, ptop2, &
+                         Ale, Alp)
+
+! print*,'tv ',tv
+! print*,'tvp ',tvp
 
     END IF
 
     IF (iflag_con==4) THEN
-      CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
-        tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
-        tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
-        q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
-    END IF
-
-    ! -------------------------------------------------------------------
-    ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
-    ! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-    ! ---   &
-    ! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
-    ! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
-    ! ---   &
-    ! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
-    ! -------------------------------------------------------------------
+      CALL cv_compress(len, nloc, ncum, nd, &
+                       iflag1, nk1, icb1, &
+                       cbmf1, plcl1, tnk1, qnk1, gznk1, &
+                       t1, q1, qs1, u1, v1, gz1, &
+                       h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
+                       iflag, nk, icb, &
+                       cbmf, plcl, tnk, qnk, gznk, &
+                       t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
+                       dph)
+    END IF
+
+! -------------------------------------------------------------------
+! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
+! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+! ---   &
+! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
+! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+! ---   &
+! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
+! -------------------------------------------------------------------
 
     IF (iflag_con==3) THEN
-      CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
-        , tnk, qnk, gznk, hnk, t, q, qs, gz, p, h, tv, lv, lf, pbase, &
-        buoybase, plcl, inb, tp, tvp, clw, hp, ep, sigp, buoy, frac)
+      CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, &              !na->nd
+                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
+                         p, h, tv, lv, lf, pbase, buoybase, plcl, &
+                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
+                         frac)
 
     END IF
 
     IF (iflag_con==4) THEN
-      CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
-        gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
-    END IF
-
-    ! -------------------------------------------------------------------
-    ! --- MIXING(1)   (if iflag_mix .ge. 1)
-    ! -------------------------------------------------------------------
+      CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
+                        tnk, qnk, gznk, t, q, qs, gz, &
+                        p, dph, h, tv, lv, &
+                        inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
+    END IF
+
+! -------------------------------------------------------------------
+! --- MIXING(1)   (if iflag_mix .ge. 1)
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
       IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
-        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', &
-          ' but iflag_mix=', iflag_mix, '. Might as well stop here.'
+        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
+          '. Might as well stop here.'
         STOP
       END IF
       IF (iflag_mix>=1) THEN
         CALL zilch(supmax, nloc*klev)
-        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
-                                                                  ! na->nd
-          , ph, t, q, qs, u, v, tra, h, lv, qnk, unk, vnk, hp, tv, tvp, ep, &
-          clw, sig, ment, qent, hent, uent, vent, nent, sigij, elij, supmax, &
-          ments, qents, traent)
-        ! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
+        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
+                         ph, t, q, qs, u, v, tra, h, lv, qnk, &
+                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
+                         ment, qent, hent, uent, vent, nent, &
+                         sigij, elij, supmax, ments, qents, traent)
+! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
 
       ELSE
@@ -836 +853 @@
       END IF
     END IF
-    ! -------------------------------------------------------------------
-    ! --- CLOSURE
-    ! -------------------------------------------------------------------
+! -------------------------------------------------------------------
+! --- CLOSURE
+! -------------------------------------------------------------------
 
 
     IF (iflag_con==3) THEN
       IF (iflag_clos==0) THEN
-        CALL cv3_closure(nloc, ncum, nd, icb, inb & ! na->nd
-          , pbase, p, ph, tv, buoy, sig, w0, cape, m, iflag)
+        CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
+                         pbase, p, ph, tv, buoy, &
+                         sig, w0, cape, m, iflag)
       END IF
 
@@ -851 +869 @@
       IF (iflag_clos==1) THEN
         PRINT *, ' pas d appel cv3p_closure'
-        ! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              !
-        ! na->nd
-        ! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
-        ! c    :                       ,supmax
-        ! c    o                       ,sig,w0,ptop2,cape,cin,m)
+! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              ! na->nd
+! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
+! c    :                       ,supmax
+! c    o                       ,sig,w0,ptop2,cape,cin,m)
       END IF
       IF (iflag_clos==2) THEN
-        CALL cv3p1_closure(nloc, ncum, nd, icb, inb & ! na->nd
-          , pbase, plcl, p, ph, tv, tvp, buoy, supmax, ok_inhib, ale, alp, &
-          sig, w0, ptop2, cape, cin, m, iflag, coef_clos, plim1, plim2, &
-          asupmax, supmax0, asupmaxmin, cbmf, plfc, wbeff)
+        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
+                           pbase, plcl, p, ph, tv, tvp, buoy, &
+                           supmax, ok_inhib, Ale, Alp, &
+                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
+                           Plim1, plim2, asupmax, supmax0, &
+                           asupmaxmin, cbmf, plfc, wbeff)
 
         PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
@@ -868 +887 @@
 
     IF (iflag_con==4) THEN
-      CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
-        cpn, iflag, cbmf)
-    END IF
-
-    ! print *,'cv_closure-> cape ',cape(1)
-
-    ! -------------------------------------------------------------------
-    ! --- MIXING(2)
-    ! -------------------------------------------------------------------
+      CALL cv_closure(nloc, ncum, nd, nk, icb, &
+                         tv, tvp, p, ph, dph, plcl, cpn, &
+                         iflag, cbmf)
+    END IF
+
+! print *,'cv_closure-> cape ',cape(1)
+
+! -------------------------------------------------------------------
+! --- MIXING(2)
+! -------------------------------------------------------------------
 
     IF (iflag_con==3) THEN
       IF (iflag_mix==0) THEN
-        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
-                                                                 ! na->nd
-          , ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, unk, vnk, hp, tv, &
-          tvp, ep, clw, m, sig, ment, qent, uent, vent, nent, sigij, elij, &
-          ments, qents, traent)
+        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
+                        ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
+                        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
+                        ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
         CALL zilch(hent, nloc*klev*klev)
       ELSE
@@ -895 +914 @@
 
     IF (iflag_con==4) THEN
-      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
-        h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
-        nent, sigij, elij)
-    END IF
+      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
+                     ph, t, q, qs, u, v, h, lv, qnk, &
+                     hp, tv, tvp, ep, clw, cbmf, &
+                     m, ment, qent, uent, vent, nent, sigij, elij)
+    END IF                                                                                         
 
     IF (debut) THEN
       PRINT *, ' cv_mixing ->'
     END IF !(debut) THEN
-    ! do i = 1,klev
-    ! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
-    ! enddo
-
-    ! -------------------------------------------------------------------
-    ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
-    ! -------------------------------------------------------------------
+! do i = 1,klev
+! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
+! enddo
+
+! -------------------------------------------------------------------
+! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
       IF (debut) THEN
@@ -915 +935 @@
       END IF !(debut) THEN
 
-      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag & !
-                                                                 ! na->nd
-        , t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, th_wake, tv_wake, &
-        lv_wake, lf_wake, cpn_wake, ep, sigp, clw, m, ment, elij, delt, plcl, &
-        coef_clos, mp, qp, up, vp, trap, wt, water, evap, fondue, ice, faci, &
-        b, sigd, wdtraina, wdtrainm) ! RomP
+      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
+                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
+                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
+                     ep, sigp, clw, &
+                     m, ment, elij, delt, plcl, coef_clos, &
+                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
+                     faci, b, sigd, &
+                     wdtrainA, wdtrainM)                                       ! RomP
     END IF
 
     IF (iflag_con==4) THEN
-      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
-        ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
+      CALL 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)
     END IF
 
@@ -932 +955 @@
     END IF !(debut) THEN
 
-    ! print *,'cv_unsat-> mp ',mp
-    ! print *,'cv_unsat-> water ',water
-    ! -------------------------------------------------------------------
-    ! --- YIELD
-    ! (tendencies, precipitation, variables of interface with other
-    ! processes, etc)
-    ! -------------------------------------------------------------------
+! print *,'cv_unsat-> mp ',mp
+! print *,'cv_unsat-> water ',water
+! -------------------------------------------------------------------
+! --- YIELD
+! (tendencies, precipitation, variables of interface with other
+! processes, etc)
+! -------------------------------------------------------------------
 
     IF (iflag_con==3) THEN
 
-      CALL cv3_yield(nloc, ncum, nd, nd, ntra & ! na->nd
-        , icb, inb, delt, t, q, t_wake, q_wake, s_wake, u, v, tra, gz, p, ph, &
-        h, hp, lv, lf, cpn, th, th_wake, ep, clw, m, tp, mp, qp, 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, ft, fq, fu, fv, ftra, cbmf, upwd, dnwd, &
-        dnwd0, ma, mip, tls, tps, qcondc, wd, ftd, fqd)
+      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
+                     icb, inb, delt, &
+                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
+                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
+                     ep, clw, m, tp, mp, qp, 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, ft, fq, fu, fv, ftra, &
+                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
+                     tls, tps, qcondc, wd, &
+                     ftd, fqd)
     END IF
 
@@ -956 +985 @@
 
     IF (iflag_con==4) THEN
-      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
-        ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
-        evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
-        tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
-    END IF
-
-    ! AC!
-    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-    ! --- passive tracers
-    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
+                     t, q, u, v, &
+                     gz, p, ph, h, hp, lv, cpn, &
+                     ep, clw, frac, m, mp, qp, up, vp, &
+                     wt, water, evap, &
+                     ment, qent, uent, vent, nent, elij, &
+                     tv, tvp, &
+                     iflag, wd, qprime, tprime, &
+                     precip, cbmf, ft, fq, fu, fv, ma, qcondc)
+    END IF
+
+!AC!
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+!--- passive tracers
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
     IF (iflag_con==3) THEN
-      ! RomP >>>
-      CALL cv3_tracer(nloc, len, ncum, nd, nd, ment, sigij, da, phi, phi2, &
-        d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
-      ! RomP <<<
-    END IF
-
-    ! AC!
-
-    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-    ! --- UNCOMPRESS THE FIELDS
-    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+!RomP >>>
+      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
+                     ment, sigij, da, phi, phi2, d1a, dam, &
+                     ep, vprecip, elij, clw, epmlmMm, eplaMm, &
+                     icb, inb)
+!RomP <<<
+    END IF
+
+!AC!
+
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! --- UNCOMPRESS THE FIELDS
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
 
     IF (iflag_con==3) THEN
-      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, icb, inb, &
-        precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, ft, fq, fu, fv, &
-        ftra, sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, qcondc, wd, cape, &
-        cin, tvp, ftd, fqd, plim1, plim2, asupmax, supmax0, asupmaxmin, da, &
-        phi, mp, phi2, d1a, dam, sigij & ! RomP
-        , clw, elij, evap, ep, epmlmmm, eplamm & ! RomP
-        , wdtraina, wdtrainm &     ! RomP
-        , iflag1, kbas1, ktop1, precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, &
-        w01, ptop21, ft1, fq1, fu1, fv1, ftra1, sigd1, ma1, mip1, vprecip1, &
-        upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1, cin1, tvp1, ftd1, fqd1, &
-        plim11, plim21, asupmax1, supmax01, asupmaxmin1, da1, phi1, mp1, &
-        phi21, d1a1, dam1, sigij1 & ! RomP
-        , clw1, elij1, evap1, ep1, epmlmmm1, eplamm1 & ! RomP
-        , wdtraina1, wdtrainm1) ! RomP
+      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, &
+                           iflag, icb, inb, &
+                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
+                           ft, fq, fu, fv, ftra, &
+                           sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, &
+                           qcondc, wd, cape, cin, &
+                           tvp, &
+                           ftd, fqd, &
+                           Plim1, plim2, asupmax, supmax0, &
+                           asupmaxmin, &
+                           da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
+                           clw, elij, evap, ep, epmlmMm, eplaMm, &       ! RomP
+                           wdtrainA, wdtrainM, &                         ! RomP
+                           iflag1, kbas1, ktop1, &
+                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
+                           ft1, fq1, fu1, fv1, ftra1, &
+                           sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, &
+                           qcondc1, wd1, cape1, cin1, &
+                           tvp1, &
+                           ftd1, fqd1, &
+                           Plim11, plim21, asupmax1, supmax01, &
+                           asupmaxmin1, &
+                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  & ! RomP
+                           clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
+                           wdtrainA1, wdtrainM1)                         ! RomP
     END IF
 
     IF (iflag_con==4) THEN
-      CALL 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)
+      CALL 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)
     END IF
 
@@ -1009 +1062 @@
     PRINT *, ' cv_compress -> '
     debut = .FALSE.
-  END IF !(debut) THEN
+  END IF  !(debut) THEN
+
 
   RETURN

LMDZ5/trunk/libf/phylmd/cvltr.F90

@@ -3 +3 @@
 !
 SUBROUTINE cvltr(pdtime, da, phi,phi2,d1a,dam, mpIN,epIN, &
-           sigd,sij,clw,elij,epmlmMm,eplaMm,              &
+!!           sigd,sij,clw,elij,epmlmMm,eplaMm,              &   !RL
+           sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,    &     !RL
            pmflxrIN,pmflxsIN,ev,te,wdtrainA,wdtrainM,     &
            paprs,it,tr,upd,dnd,inb,icb,                   &
@@ -47 +48 @@
   REAL,DIMENSION(klon,klev),INTENT(IN)      :: te 
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij        ! fraction dair de lenv
+  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd  ! weights of the layers feeding convection
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij       ! contenu en eau condensée spécifique/conc deau condensée massique
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm    ! eau condensee precipitee dans mel masse dair sat
@@ -71 +73 @@
   REAL,DIMENSION(klon,klev,nbtr)    :: zmfd,zmfa
   REAL,DIMENSION(klon,klev,nbtr)    :: zmfp,zmfu
+  REAL,DIMENSION(klon,nbtr)         :: qfeed     ! tracer concentration feeding convection
 
   REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfd1a
@@ -168 +171 @@
    scavtrac = 0.
    uscavtrac = 0.
-
+   qfeed(:,it) = 0.              !RL
   DO j=1,klev
    DO i=1,klon
@@ -330 +333 @@
 ! calcul des tendances liees aux courants satures   j <-> z ; k <-> z'
 ! =========================================
+!
+!RL
+!  Feeding concentrations
   DO j=1,klev
      DO i=1,klon
-        zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it))                     ! da
-     END DO
-  END DO
+        qfeed(i,it)=qfeed(i,it)+wght_cvfd(i,j)*tr(i,j,it)
+     END DO
+  END DO
+!RL
+!
+  DO j=1,klev
+     DO i=1,klon
+!RL
+!!        zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it))                     ! da
+        zmfa(i,j,it)=da(i,j)*(qfeed(i,it)-tr(i,j,it))                     ! da
+!RL
+     END DO
+  END DO
+!
   DO k=1,klev
      DO j=1,klev

LMDZ5/trunk/libf/phylmd/physiq.F90

@@ -237 +237 @@
   ! Variables pour le transport convectif
   real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
+  real wght_cvfd(klon,klev)
   ! Variables pour le lessivage convectif
   ! RomP >>> 
@@ -2061 +2062 @@
              ftd,fqd,lalim_conv,wght_th, &
              ev, ep,epmlmMm,eplaMm, &
-             wdtrainA,wdtrainM)
+             wdtrainA,wdtrainM,wght_cvfd)
         ! RomP <<<
 
@@ -3479 +3480 @@
        pmflxr,   pmflxs,    prfl,     psfl, &
        da,       phi,       mp,       upwd, &
-       phi2,     d1a,       dam,      sij, &        !<<RomP
+       phi2,     d1a,       dam,      sij, wght_cvfd, &        !<<RomP+RL
        wdtrainA, wdtrainM,  sigd,     clw,elij, &   !<<RomP
        ev,       ep,        epmlmMm,  eplaMm, &     !<<RomP

LMDZ5/trunk/libf/phylmd/phytrac_mod.F90

@@ -54 +54 @@
 CONTAINS
 
-SUBROUTINE phytrac(                            &
-     nstep,     julien,   gmtime,   debutphy,  &
-     lafin,     pdtphys,  u, v,     t_seri,    &
-     paprs,     pplay,    pmfu,     pmfd,      &
-     pen_u,     pde_u,    pen_d,    pde_d,     &
-     cdragh,    coefh,    fm_therm, entr_therm,&
-     yu1,       yv1,      ftsol,    pctsrf,    &
-     ustar,     u10m,      v10m,               &
-     wstar,     ale_bl,      ale_wake,         &
-     xlat,      xlon,                          &
-     frac_impa,frac_nucl,beta_fisrt,beta_v1,   &
-     presnivs,  pphis,    pphi,     albsol,    &
-     sh,        rh,       cldfra,   rneb,      &
-     diafra,    cldliq,   itop_con, ibas_con,  &
-     pmflxr,    pmflxs,   prfl,     psfl,      &
-     da,        phi,      mp,       upwd,      &
-     phi2,      d1a,      dam,      sij,       &   ! RomP
-     wdtrainA,  wdtrainM, sigd,     clw,elij,  &   ! RomP 
-     evap,      ep,       epmlmMm,  eplaMm,    &   ! RomP
-     dnwd,      aerosol_couple,     flxmass_w, &
-     tau_aero,  piz_aero,  cg_aero, ccm,       &
-     rfname,                                   &
-     d_tr_dyn,                                 &   ! RomP
+SUBROUTINE phytrac(                                 &
+     nstep,     julien,   gmtime,   debutphy,       &
+     lafin,     pdtphys,  u, v,     t_seri,         &
+     paprs,     pplay,    pmfu,     pmfd,           &
+     pen_u,     pde_u,    pen_d,    pde_d,          &
+     cdragh,    coefh,    fm_therm, entr_therm,     &
+     yu1,       yv1,      ftsol,    pctsrf,         &
+     ustar,     u10m,      v10m,                    &
+     wstar,     ale_bl,      ale_wake,              &
+     xlat,      xlon,                               &
+     frac_impa,frac_nucl,beta_fisrt,beta_v1,        &
+     presnivs,  pphis,    pphi,     albsol,         &
+     sh,        rh,       cldfra,   rneb,           &
+     diafra,    cldliq,   itop_con, ibas_con,       &
+     pmflxr,    pmflxs,   prfl,     psfl,           &
+     da,        phi,      mp,       upwd,           &
+     phi2,      d1a,      dam,      sij, wght_cvfd, &   ! RomP +RL
+     wdtrainA,  wdtrainM, sigd,     clw, elij,      &   ! RomP 
+     evap,      ep,       epmlmMm,  eplaMm,         &   ! RomP
+     dnwd,      aerosol_couple,     flxmass_w,      &
+     tau_aero,  piz_aero,  cg_aero, ccm,            &
+     rfname,                                        &
+     d_tr_dyn,                                      &   ! RomP
      tr_seri)         
 !
@@ -190 +190 @@
   REAL,DIMENSION(klon,klev),INTENT(IN)      :: ep
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
+  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd          !RL
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
@@ -507 +508 @@
 !
           CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,              &
-               sigd,sij,clw,elij,epmlmMm,eplaMm,                        &
+!!               sigd,sij,clw,elij,epmlmMm,eplaMm,                        &   !RL
+               sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,              &     !RL
                pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM,             &   
                paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con,            &
@@ -514 +516 @@
                zmfd1a,zmfphi2,zmfdam)
         else  !pas de lessivage convectif ou n'est pas un aerosol
-           CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,&
-                    upwd,dnwd,d_tr_cv)
+!!           CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,&      !jyg
+!!                    upwd,dnwd,d_tr_cv)                                      !jyg
+           CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, &  !jyg
+                    tr_seri,upwd,dnwd,d_tr_cv)                                !jyg
         endif
         END IF