Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/bl_for_dms.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/bl_for_dms.f90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/bl_for_dms.f90	(revision 5143)
@@ -2,4 +2,7 @@
         , t, q, tsol, ustar, obklen)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   !
@@ -19,6 +22,4 @@
   INCLUDE "dimensions.h"
   INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
-  INCLUDE "FCTTRE.h"
   !
   ! Arguments :
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5143)
@@ -799,4 +799,5 @@
     USE lmdz_yomcst
     USE lmdz_alpale
+    USE lmdz_YOETHF
 
     IMPLICIT NONE
@@ -816,5 +817,4 @@
     INCLUDE "chem.h"
     INCLUDE "chem_spla.h"
-    INCLUDE "YOETHF.h"
     INCLUDE "paramet.h"
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/FCTTRE.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/FCTTRE.h	(revision 5142)
+++ 	(revision )
@@ -1,45 +1,0 @@
-
-! $Header$
-
-
-!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
-!                 veillez  n'utiliser que des ! pour les commentaires
-!                 et  bien positionner les & des lignes de continuation
-!                 (les placer en colonne 6 et en colonne 73)
-
-!     ------------------------------------------------------------------
-!     This COMDECK includes the Thermodynamical functions for the cy39
-!       ECMWF Physics package.
-!       Consistent with YOMCST Basic physics constants, assuming the
-!       partial pressure of water vapour is given by a first order
-!       Taylor expansion of Qs(T) w.r.t. to Temperature, using constants
-!       in YOETHF
-!     ------------------------------------------------------------------
-      REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG
-      REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl
-      LOGICAL thermcep
-      PARAMETER (thermcep=.TRUE.)
-
-      FOEEW ( PTARG,PDELARG ) = EXP (                                   &
-                (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)        &
-       / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
-
-      FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG &
-       / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2
-
-      qsats(ptarg) = 100.0 * 0.622 * 10.0                               &
-                 ** (2.07023 - 0.00320991 * ptarg                       &
-                 - 2484.896 / ptarg + 3.56654 * LOG10(ptarg))
-      qsatl(ptarg) = 100.0 * 0.622 * 10.0                               &
-                 ** (23.8319 - 2948.964 / ptarg                         &
-                 - 5.028 * LOG10(ptarg)                                 &
-                 - 29810.16 * EXP( - 0.0699382 * ptarg)                 &
-                 + 25.21935 * EXP( - 2999.924 / ptarg))
-
-      dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg         &
-                           +2484.896*LOG(10.)/ptarg**2                  &
-                           -0.00320991*LOG(10.))
-      dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)*                &
-                      (2948.964/ptarg**2-5.028/LOG(10.)/ptarg           &
-                      +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg)  &
-                      +29810.16*0.0699382*EXP(-0.0699382*ptarg))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/YOEGWD.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/YOEGWD.h	(revision 5142)
+++ 	(revision )
@@ -1,32 +1,0 @@
-
-! $Header$
-
-!  ATTENTION : ce fichier include est compatible format fixe/format libre
-!                 veillez  n'utiliser que des ! pour les commentaires
-!                 et  bien positionner les & des lignes de continuation
-!                 (les placer en colonne 6 et en colonne 73)
-!     -----------------------------------------------------------------
-!*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
-!     -----------------------------------------------------------------
-
-      INTEGER NKTOPG,NSTRA
-      REAL GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT
-      REAL GHMAX,GRAHILO,GSIGCR,GSSEC,GTSEC,GVSEC
-
-      REAL GWD_RANDO_RUWMAX
-!     Maximum Eliassen-Palm flux at launch level, in "FLOTT_GWD_rando"
-
-      REAL GWD_RANDO_SAT ! saturation parameter in "FLOTT_GWD_rando"
-!     S_c in equation (12) of Lott (JGR, vol 118, page 8897, 2013)
-
-      REAL GWD_FRONT_RUWMAX,GWD_FRONT_SAT 
-! Same as GWD_RANDO params but for fronal GWs
-
-
-      COMMON/YOEGWD/ GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT,        &
-           GHMAX,GRAHILO,GSIGCR,NKTOPG,NSTRA,GSSEC,GTSEC,GVSEC,         &
-           GWD_RANDO_RUWMAX, gwd_rando_sat,                             &
-           GWD_FRONT_RUWMAX, gwd_front_sat
-
-      save /YOEGWD/
-!$OMP THREADPRIVATE(/YOEGWD/)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/YOETHF.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/YOETHF.h	(revision 5142)
+++ 	(revision )
@@ -1,31 +1,0 @@
-
-! $Id$
-
-!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
-!                 veillez  n'utiliser que des ! pour les commentaires
-!                 et  bien positionner les & des lignes de continuation
-!                 (les placer en colonne 6 et en colonne 73)
-
-!*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
-
-!     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
-!                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
-!                ICE(*R_IES*).
-!     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
-!     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
-
-      REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
-      REAL RVTMP2, RHOH2O
-      REAL R5ALVCP,R5ALSCP,RALVDCP,RALSDCP,RALFDCP,RTWAT,RTBER,RTBERCU
-      REAL RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,RKOOP2
-      LOGICAL OK_BAD_ECMWF_THERMO ! If TRUE, then variables set by rrtm/suphec.F90
-                                  ! If FALSE, then variables set by suphel.F90
-      COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES,    &
-                     RVTMP2, RHOH2O,                                    &
-                     R5ALVCP,R5ALSCP,RALVDCP,RALSDCP,                   &
-                     RALFDCP,RTWAT,RTBER,RTBERCU,                       &
-                     RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,&
-                     RKOOP2,                                            &
-                     OK_BAD_ECMWF_THERMO
-
-!$OMP THREADPRIVATE(/YOETHF/)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90	(revision 5143)
@@ -27,4 +27,6 @@
     USE lmdz_abort_physic, ONLY: abort_physic
     USE lmdz_clesphys
+    USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
 
     include "YOMCST.h"
@@ -33,5 +35,4 @@
 !   include "dimphy.h"
 !END DIFFERENCE
-    include "YOEGWD.h"
 
     ! 0. DECLARATIONS:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/borne_var_surf.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/borne_var_surf.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/borne_var_surf.F90	(revision 5143)
@@ -1,110 +1,110 @@
-SUBROUTINE borne_var_surf(klon,klev,nbsrf,                   &
-         iflag_bug_t2m_stab_ipslcm61,                        &
-         t1,q1,u1,v1,                                        &
-         ftsol, qsurf, pctsrf, paprs,                        &
-         t2m, q2m, u10m, v10m,                               &
-         zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor,           &
-         zrh2m_cor, zqsat2m_cor)
+SUBROUTINE borne_var_surf(klon, klev, nbsrf, &
+        iflag_bug_t2m_stab_ipslcm61, &
+        t1, q1, u1, v1, &
+        ftsol, qsurf, pctsrf, paprs, &
+        t2m, q2m, u10m, v10m, &
+        zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor, &
+        zrh2m_cor, zqsat2m_cor)
 
-IMPLICIT NONE
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
-!==================================================================
-! Declarations
-!==================================================================
+  IMPLICIT NONE
 
-! arguments
-INTEGER klon,klev,nbsrf,iflag_bug_t2m_stab_ipslcm61
-REAL,DIMENSION(klon),INTENT(IN) :: t1, q1, u1, v1
-REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: t2m, q2m, u10m, v10m
-REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol, pctsrf
-REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs 
-REAL,DIMENSION(klon),INTENT(IN) :: qsurf
-REAL,DIMENSION (klon),INTENT(OUT) :: zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor
-REAL,DIMENSION (klon),INTENT(OUT)  :: zrh2m_cor, zqsat2m_cor
+  !==================================================================
+  ! Declarations
+  !==================================================================
 
+  ! arguments
+  INTEGER klon, klev, nbsrf, iflag_bug_t2m_stab_ipslcm61
+  REAL, DIMENSION(klon), INTENT(IN) :: t1, q1, u1, v1
+  REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m, q2m, u10m, v10m
+  REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: ftsol, pctsrf
+  REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
+  REAL, DIMENSION(klon), INTENT(IN) :: qsurf
+  REAL, DIMENSION (klon), INTENT(OUT) :: zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor
+  REAL, DIMENSION (klon), INTENT(OUT) :: zrh2m_cor, zqsat2m_cor
 
-! local
-INTEGER i,nsrf
-REAL,DIMENSION (klon,nbsrf) :: t2m_cor, q2m_cor, u10m_cor, v10m_cor
-REAL                               :: zx_qs1, zcor1, zdelta1
-include "YOMCST.h"
-include "YOETHF.h"
-include "FCTTRE.h"
-!==================================================================
-! Correction of sub surface variables
-!==================================================================
+  ! local
+  INTEGER i, nsrf
+  REAL, DIMENSION (klon, nbsrf) :: t2m_cor, q2m_cor, u10m_cor, v10m_cor
+  REAL :: zx_qs1, zcor1, zdelta1
+  include "YOMCST.h"
+  !==================================================================
+  ! Correction of sub surface variables
+  !==================================================================
 
-zrh2m_cor=0.
-zqsat2m_cor=0.
+  zrh2m_cor = 0.
+  zqsat2m_cor = 0.
 
-DO nsrf=1,nbsrf
-   DO i=1,klon
-    t2m_cor(i,nsrf)=t2m(i,nsrf)
-    q2m_cor(i,nsrf)=q2m(i,nsrf)
-    u10m_cor(i,nsrf)=u10m(i,nsrf)
-    v10m_cor(i,nsrf)=v10m(i,nsrf)
-     IF(iflag_bug_t2m_stab_ipslcm61==-2.AND.q2m(i,nsrf)<0.) THEN
-      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
-      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
-      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
-      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
-      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
-     ELSEIF(iflag_bug_t2m_stab_ipslcm61==-1.AND.(ftsol(i,nsrf)<=t1(i).OR.q2m(i,nsrf)<0.)) THEN
-      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
-      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
-      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
-      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
-      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
-     ELSEIF(iflag_bug_t2m_stab_ipslcm61==1.AND.ftsol(i,nsrf)<=t1(i)) THEN
-      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
-      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
-      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
-      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
-      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
-     ELSEIF(iflag_bug_t2m_stab_ipslcm61==0) THEN
-      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
-      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
-      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
-      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
-      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
-      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
-     ENDIF
-!!!
-     zdelta1 = MAX(0.,SIGN(1., rtt-t2m_cor(i,nsrf) ))
-     zx_qs1  = r2es * FOEEW(t2m_cor(i,nsrf),zdelta1)/paprs(i,1)
-     zx_qs1  = MIN(0.5,zx_qs1)
-     zcor1   = 1./(1.-RETV*zx_qs1)
-     zx_qs1  = zx_qs1*zcor1
-     zrh2m_cor(i) = zrh2m_cor(i) + q2m_cor(i,nsrf)/zx_qs1 * pctsrf(i,nsrf)
-     zqsat2m_cor(i) = zqsat2m_cor(i) + zx_qs1  * pctsrf(i,nsrf)
-!!!
-   ENDDO
-ENDDO
+  DO nsrf = 1, nbsrf
+    DO i = 1, klon
+      t2m_cor(i, nsrf) = t2m(i, nsrf)
+      q2m_cor(i, nsrf) = q2m(i, nsrf)
+      u10m_cor(i, nsrf) = u10m(i, nsrf)
+      v10m_cor(i, nsrf) = v10m(i, nsrf)
+      IF(iflag_bug_t2m_stab_ipslcm61==-2.AND.q2m(i, nsrf)<0.) THEN
+        t2m_cor(i, nsrf) = MIN(t2m(i, nsrf), MAX(t1(i), ftsol(i, nsrf)))
+        t2m_cor(i, nsrf) = MAX(t2m_cor(i, nsrf), MIN(t1(i), ftsol(i, nsrf)))
+        q2m_cor(i, nsrf) = MIN(q2m(i, nsrf), MAX(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), MIN(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), 0.)
+        u10m_cor(i, nsrf) = SIGN(MIN(ABS(u1(i)), ABS(u10m(i, nsrf))), u1(i))
+        v10m_cor(i, nsrf) = SIGN(MIN(ABS(v1(i)), ABS(v10m(i, nsrf))), v1(i))
+      ELSEIF(iflag_bug_t2m_stab_ipslcm61==-1.AND.(ftsol(i, nsrf)<=t1(i).OR.q2m(i, nsrf)<0.)) THEN
+        t2m_cor(i, nsrf) = MIN(t2m(i, nsrf), MAX(t1(i), ftsol(i, nsrf)))
+        t2m_cor(i, nsrf) = MAX(t2m_cor(i, nsrf), MIN(t1(i), ftsol(i, nsrf)))
+        q2m_cor(i, nsrf) = MIN(q2m(i, nsrf), MAX(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), MIN(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), 0.)
+        u10m_cor(i, nsrf) = SIGN(MIN(ABS(u1(i)), ABS(u10m(i, nsrf))), u1(i))
+        v10m_cor(i, nsrf) = SIGN(MIN(ABS(v1(i)), ABS(v10m(i, nsrf))), v1(i))
+      ELSEIF(iflag_bug_t2m_stab_ipslcm61==1.AND.ftsol(i, nsrf)<=t1(i)) THEN
+        t2m_cor(i, nsrf) = MIN(t2m(i, nsrf), MAX(t1(i), ftsol(i, nsrf)))
+        t2m_cor(i, nsrf) = MAX(t2m_cor(i, nsrf), MIN(t1(i), ftsol(i, nsrf)))
+        q2m_cor(i, nsrf) = MIN(q2m(i, nsrf), MAX(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), MIN(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), 0.)
+        u10m_cor(i, nsrf) = SIGN(MIN(ABS(u1(i)), ABS(u10m(i, nsrf))), u1(i))
+        v10m_cor(i, nsrf) = SIGN(MIN(ABS(v1(i)), ABS(v10m(i, nsrf))), v1(i))
+      ELSEIF(iflag_bug_t2m_stab_ipslcm61==0) THEN
+        t2m_cor(i, nsrf) = MIN(t2m(i, nsrf), MAX(t1(i), ftsol(i, nsrf)))
+        t2m_cor(i, nsrf) = MAX(t2m_cor(i, nsrf), MIN(t1(i), ftsol(i, nsrf)))
+        q2m_cor(i, nsrf) = MIN(q2m(i, nsrf), MAX(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), MIN(q1(i), qsurf(i)))
+        q2m_cor(i, nsrf) = MAX(q2m_cor(i, nsrf), 0.)
+        u10m_cor(i, nsrf) = SIGN(MIN(ABS(u1(i)), ABS(u10m(i, nsrf))), u1(i))
+        v10m_cor(i, nsrf) = SIGN(MIN(ABS(v1(i)), ABS(v10m(i, nsrf))), v1(i))
+      ENDIF
+      !!!
+      zdelta1 = MAX(0., SIGN(1., rtt - t2m_cor(i, nsrf)))
+      zx_qs1 = r2es * FOEEW(t2m_cor(i, nsrf), zdelta1) / paprs(i, 1)
+      zx_qs1 = MIN(0.5, zx_qs1)
+      zcor1 = 1. / (1. - RETV * zx_qs1)
+      zx_qs1 = zx_qs1 * zcor1
+      zrh2m_cor(i) = zrh2m_cor(i) + q2m_cor(i, nsrf) / zx_qs1 * pctsrf(i, nsrf)
+      zqsat2m_cor(i) = zqsat2m_cor(i) + zx_qs1 * pctsrf(i, nsrf)
+      !!!
+    ENDDO
+  ENDDO
 
-!==================================================================
-! Agregation of sub surfaces
-!==================================================================
+  !==================================================================
+  ! Agregation of sub surfaces
+  !==================================================================
 
-zt2m_cor=0.
-zq2m_cor=0.
-zu10m_cor=0.
-zv10m_cor=0.
-DO nsrf = 1, nbsrf
-   DO i = 1, klon
-      zt2m_cor(i)  = zt2m_cor(i)  + t2m_cor(i,nsrf)  * pctsrf(i,nsrf)
-      zq2m_cor(i)  = zq2m_cor(i)  + q2m_cor(i,nsrf)  * pctsrf(i,nsrf)
-      zu10m_cor(i) = zu10m_cor(i) + u10m_cor(i,nsrf) * pctsrf(i,nsrf)
-      zv10m_cor(i) = zv10m_cor(i) + v10m_cor(i,nsrf) * pctsrf(i,nsrf)
-   ENDDO
-ENDDO
+  zt2m_cor = 0.
+  zq2m_cor = 0.
+  zu10m_cor = 0.
+  zv10m_cor = 0.
+  DO nsrf = 1, nbsrf
+    DO i = 1, klon
+      zt2m_cor(i) = zt2m_cor(i) + t2m_cor(i, nsrf) * pctsrf(i, nsrf)
+      zq2m_cor(i) = zq2m_cor(i) + q2m_cor(i, nsrf) * pctsrf(i, nsrf)
+      zu10m_cor(i) = zu10m_cor(i) + u10m_cor(i, nsrf) * pctsrf(i, nsrf)
+      zv10m_cor(i) = zv10m_cor(i) + v10m_cor(i, nsrf) * pctsrf(i, nsrf)
+    ENDDO
+  ENDDO
 
-RETURN
+  RETURN
 END
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90	(revision 5143)
@@ -20,4 +20,6 @@
     USE sens_heat_rain_m, ONLY: sens_heat_rain
     USE lmdz_clesphys
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
 ! Cette routine calcule les fluxs en h et q a l'interface et eventuellement
@@ -59,6 +61,4 @@
 !   lat_prec_sol                                  precipitations solides
 
-    INCLUDE "YOETHF.h"
-    INCLUDE "FCTTRE.h"
     INCLUDE "YOMCST.h"
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90	(revision 5143)
@@ -30,4 +30,5 @@
   USE lmdz_atke_turbulence_ini, ONLY: smmin, ric, cinf, cepsilon, pr_slope, pr_asym, pr_neut
   USE lmdz_clesphys
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
@@ -118,5 +119,4 @@
 
   INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/clcdrag.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/clcdrag.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/clcdrag.F90	(revision 5143)
@@ -11,4 +11,5 @@
   USE lmdz_abort_physic, ONLY: abort_physic
   USE lmdz_clesphys
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
@@ -44,5 +45,4 @@
 
   INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
 
 ! Quelques constantes et options:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/coef_diff_turb_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/coef_diff_turb_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/coef_diff_turb_mod.F90	(revision 5143)
@@ -1,19 +1,18 @@
-
 MODULE coef_diff_turb_mod
 
-! This module contains some procedures for calculation of the coefficients of the
-! turbulent diffusion in the atmosphere and coefficients for turbulent diffusion 
-! at surface(cdrag)
+  ! This module contains some procedures for calculation of the coefficients of the
+  ! turbulent diffusion in the atmosphere and coefficients for turbulent diffusion
+  ! at surface(cdrag)
 
   IMPLICIT NONE
-  
+
 CONTAINS
 
-!****************************************************************************************
+  !****************************************************************************************
 
   SUBROUTINE coef_diff_turb(dtime, nsrf, knon, ni, &
-       ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
-       ycoefm, ycoefh ,yq2, yeps, ydrgpro)
- 
+          ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
+          ycoefm, ycoefh, yq2, yeps, ydrgpro)
+
     USE dimphy
     USE indice_sol_mod
@@ -21,264 +20,263 @@
     USE lmdz_clesphys
     USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
-
-! Calculate coefficients(ycoefm, ycoefh) for turbulent diffusion in the 
-! atmosphere 
-! NB! No values are calculated between surface and the first model layer. 
-!     ycoefm(:,1) and ycoefh(:,1) are not valid !!!
-
-
-! Input arguments
-!****************************************************************************************
-    REAL, INTENT(IN)                           :: dtime
-    INTEGER, INTENT(IN)                        :: nsrf, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)       :: ni
-    REAL, DIMENSION(klon,klev+1), INTENT(IN)   :: ypaprs
-    REAL, DIMENSION(klon,klev), INTENT(IN)     :: ypplay
-    REAL, DIMENSION(klon,klev), INTENT(IN)     :: yu, yv
-    REAL, DIMENSION(klon,klev), INTENT(IN)     :: yq, yt
-    REAL, DIMENSION(klon), INTENT(IN)          :: yts, yqsurf
-    REAL, DIMENSION(klon), INTENT(IN)          :: ycdragm
-!FC
-    REAL, DIMENSION(klon,klev), INTENT(IN)     :: ydrgpro
-
-
-! InOutput arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon,klev+1), INTENT(INOUT):: yq2
-  
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon,klev+1), INTENT(OUT)  :: yeps
-    REAL, DIMENSION(klon,klev), INTENT(OUT)    :: ycoefh
-    REAL, DIMENSION(klon,klev), INTENT(OUT)    :: ycoefm
-
-! Other local variables
-!****************************************************************************************
-    INTEGER                                    :: k, i, j
-    REAL, DIMENSION(klon,klev)                 :: ycoefm0, ycoefh0, yzlay, yteta
-    REAL, DIMENSION(klon,klev+1)               :: yzlev, q2diag, ykmm, ykmn, ykmq
-    REAL, DIMENSION(klon)                      :: yustar
-
-! Include
-!****************************************************************************************
-    INCLUDE "YOETHF.h"
+    USE lmdz_YOETHF
+
+    ! Calculate coefficients(ycoefm, ycoefh) for turbulent diffusion in the
+    ! atmosphere
+    ! NB! No values are calculated between surface and the first model layer.
+    !     ycoefm(:,1) and ycoefh(:,1) are not valid !!!
+
+
+    ! Input arguments
+    !****************************************************************************************
+    REAL, INTENT(IN) :: dtime
+    INTEGER, INTENT(IN) :: nsrf, knon
+    INTEGER, DIMENSION(klon), INTENT(IN) :: ni
+    REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: ypaprs
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: ypplay
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: yu, yv
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: yq, yt
+    REAL, DIMENSION(klon), INTENT(IN) :: yts, yqsurf
+    REAL, DIMENSION(klon), INTENT(IN) :: ycdragm
+    !FC
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: ydrgpro
+
+
+    ! InOutput arguments
+    !****************************************************************************************
+    REAL, DIMENSION(klon, klev + 1), INTENT(INOUT) :: yq2
+
+    ! Output arguments
+    !****************************************************************************************
+    REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: yeps
+    REAL, DIMENSION(klon, klev), INTENT(OUT) :: ycoefh
+    REAL, DIMENSION(klon, klev), INTENT(OUT) :: ycoefm
+
+    ! Other local variables
+    !****************************************************************************************
+    INTEGER :: k, i, j
+    REAL, DIMENSION(klon, klev) :: ycoefm0, ycoefh0, yzlay, yteta
+    REAL, DIMENSION(klon, klev + 1) :: yzlev, q2diag, ykmm, ykmn, ykmq
+    REAL, DIMENSION(klon) :: yustar
+
+    ! Include
+    !****************************************************************************************
     INCLUDE "YOMCST.h"
-
 
     ykmm = 0 !ym missing init
     ykmn = 0 !ym missing init
     ykmq = 0 !ym missing init
-    
-    yeps(:,:) = 0.
-
-!****************************************************************************************    
-! Calcul de coefficients de diffusion turbulent de l'atmosphere : 
-! ycoefm(:,2:klev), ycoefh(:,2:klev) 
-
-!****************************************************************************************    
+
+    yeps(:, :) = 0.
+
+    !****************************************************************************************
+    ! Calcul de coefficients de diffusion turbulent de l'atmosphere :
+    ! ycoefm(:,2:klev), ycoefh(:,2:klev)
+
+    !****************************************************************************************
 
     CALL coefkz(nsrf, knon, ypaprs, ypplay, &
-         ksta, ksta_ter, &
-         yts, yu, yv, yt, yq, &
-         yqsurf, &
-         ycoefm, ycoefh)
-  
-!****************************************************************************************
-! Eventuelle recalcule des coeffeicients de diffusion turbulent de l'atmosphere : 
-! ycoefm(:,2:klev), ycoefh(:,2:klev) 
-
-!****************************************************************************************
+            ksta, ksta_ter, &
+            yts, yu, yv, yt, yq, &
+            yqsurf, &
+            ycoefm, ycoefh)
+
+    !****************************************************************************************
+    ! Eventuelle recalcule des coeffeicients de diffusion turbulent de l'atmosphere :
+    ! ycoefm(:,2:klev), ycoefh(:,2:klev)
+
+    !****************************************************************************************
 
     IF (iflag_pbl==1) THEN
-       CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, &
-            ycoefm0, ycoefh0)
-
-       DO k = 2, klev
-          DO i = 1, knon
-             ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
-             ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
-          ENDDO
-       ENDDO
+      CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, &
+              ycoefm0, ycoefh0)
+
+      DO k = 2, klev
+        DO i = 1, knon
+          ycoefm(i, k) = MAX(ycoefm(i, k), ycoefm0(i, k))
+          ycoefh(i, k) = MAX(ycoefh(i, k), ycoefh0(i, k))
+        ENDDO
+      ENDDO
     ENDIF
 
-  
-!****************************************************************************************  
-! Calcul d'une diffusion minimale pour les conditions tres stables
-
-!****************************************************************************************
+
+    !****************************************************************************************
+    ! Calcul d'une diffusion minimale pour les conditions tres stables
+
+    !****************************************************************************************
     IF (ok_kzmin) THEN
-       CALL coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycdragm, &
-            ycoefm0,ycoefh0)
-       
-       DO k = 2, klev
-          DO i = 1, knon
-             ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
-             ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
-          ENDDO
-       ENDDO
-       
+      CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycdragm, &
+              ycoefm0, ycoefh0)
+
+      DO k = 2, klev
+        DO i = 1, knon
+          ycoefm(i, k) = MAX(ycoefm(i, k), ycoefm0(i, k))
+          ycoefh(i, k) = MAX(ycoefh(i, k), ycoefh0(i, k))
+        ENDDO
+      ENDDO
+
     ENDIF
 
-  
-!****************************************************************************************
-! MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
-
-!****************************************************************************************
+
+    !****************************************************************************************
+    ! MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
+
+    !****************************************************************************************
 
     IF (iflag_pbl>=3) THEN
 
-       yzlay(1:knon,1)= &
-            RD*yt(1:knon,1)/(0.5*(ypaprs(1:knon,1)+ypplay(1:knon,1))) &
-            *(ypaprs(1:knon,1)-ypplay(1:knon,1))/RG
-       DO k=2,klev
-          DO i = 1, knon
-             yzlay(i,k)= &
-                  yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k)) &
-                  /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG
-          END DO
-       END DO
-
-       DO k=1,klev
-          DO i = 1, knon
-             yteta(i,k)= &
-                  yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**RKAPPA &
-                  *(1.+0.61*yq(i,k))
-          END DO
-       END DO
-
-       yzlev(1:knon,1)=0.
-       yzlev(1:knon,klev+1)=2.*yzlay(1:knon,klev)-yzlay(1:knon,klev-1)
-       DO k=2,klev
-          DO i = 1, knon
-             yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1))
-          END DO
-       END DO
-
-!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!$! Pour memoire, le papier Hourdin et al. 2002 a ete obtenur avec un
-!!$! bug sur les coefficients de surface :
-!!$!          ycdragh(1:knon) = ycoefm(1:knon,1)
-!!$!          ycdragm(1:knon) = ycoefh(1:knon,1)
-!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-       ! Normalement, on peut passer dans les codes avec knon=0
-       ! Mais ca fait planter le replay.
-       ! En attendant une réécriture, on a joute des if (Fredho)
-       IF ( klon>1 .OR. (klon==1 .AND. knon==1) ) THEN
-          CALL ustarhb(knon,klev,knon,yu,yv,ycdragm, yustar)
-       endif
-     
-       IF (prt_level > 9) THEN
-          WRITE(lunout,*) 'USTAR = ',(yustar(i),i=1,knon)
-       ENDIF
-         
-!   iflag_pbl peut etre utilise comme longuer de melange
-       IF (iflag_pbl>=31) THEN
-          IF ( klon>1 .OR. (klon==1 .AND. knon==1) ) THEN
-          CALL vdif_kcay(knon,klev,knon,dtime,RG,RD,ypaprs,yt, &
-               yzlev,yzlay,yu,yv,yteta, &
-               ycdragm,yq2,q2diag,ykmm,ykmn,yustar, &
-               iflag_pbl)
-          endif
-       ELSE IF (iflag_pbl<20) THEN
-          CALL yamada4(ni,nsrf,knon,dtime,RG,RD,ypaprs,yt, &
-               yzlev,yzlay,yu,yv,yteta, &
-               ycdragm,yq2,yeps,ykmm,ykmn,ykmq,yustar, &
-               iflag_pbl,ydrgpro)
-!FC
-       ENDIF
-       
-       ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
-       ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
-                
+      yzlay(1:knon, 1) = &
+              RD * yt(1:knon, 1) / (0.5 * (ypaprs(1:knon, 1) + ypplay(1:knon, 1))) &
+                      * (ypaprs(1:knon, 1) - ypplay(1:knon, 1)) / RG
+      DO k = 2, klev
+        DO i = 1, knon
+          yzlay(i, k) = &
+                  yzlay(i, k - 1) + RD * 0.5 * (yt(i, k - 1) + yt(i, k)) &
+                          / ypaprs(i, k) * (ypplay(i, k - 1) - ypplay(i, k)) / RG
+        END DO
+      END DO
+
+      DO k = 1, klev
+        DO i = 1, knon
+          yteta(i, k) = &
+                  yt(i, k) * (ypaprs(i, 1) / ypplay(i, k))**RKAPPA &
+                          * (1. + 0.61 * yq(i, k))
+        END DO
+      END DO
+
+      yzlev(1:knon, 1) = 0.
+      yzlev(1:knon, klev + 1) = 2. * yzlay(1:knon, klev) - yzlay(1:knon, klev - 1)
+      DO k = 2, klev
+        DO i = 1, knon
+          yzlev(i, k) = 0.5 * (yzlay(i, k) + yzlay(i, k - 1))
+        END DO
+      END DO
+
+      !!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !!$! Pour memoire, le papier Hourdin et al. 2002 a ete obtenur avec un
+      !!$! bug sur les coefficients de surface :
+      !!$!          ycdragh(1:knon) = ycoefm(1:knon,1)
+      !!$!          ycdragm(1:knon) = ycoefh(1:knon,1)
+      !!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      ! Normalement, on peut passer dans les codes avec knon=0
+      ! Mais ca fait planter le replay.
+      ! En attendant une réécriture, on a joute des if (Fredho)
+      IF (klon>1 .OR. (klon==1 .AND. knon==1)) THEN
+        CALL ustarhb(knon, klev, knon, yu, yv, ycdragm, yustar)
+      endif
+
+      IF (prt_level > 9) THEN
+        WRITE(lunout, *) 'USTAR = ', (yustar(i), i = 1, knon)
+      ENDIF
+
+      !   iflag_pbl peut etre utilise comme longuer de melange
+      IF (iflag_pbl>=31) THEN
+        IF (klon>1 .OR. (klon==1 .AND. knon==1)) THEN
+          CALL vdif_kcay(knon, klev, knon, dtime, RG, RD, ypaprs, yt, &
+                  yzlev, yzlay, yu, yv, yteta, &
+                  ycdragm, yq2, q2diag, ykmm, ykmn, yustar, &
+                  iflag_pbl)
+        endif
+      ELSE IF (iflag_pbl<20) THEN
+        CALL yamada4(ni, nsrf, knon, dtime, RG, RD, ypaprs, yt, &
+                yzlev, yzlay, yu, yv, yteta, &
+                ycdragm, yq2, yeps, ykmm, ykmn, ykmq, yustar, &
+                iflag_pbl, ydrgpro)
+        !FC
+      ENDIF
+
+      ycoefm(1:knon, 2:klev) = ykmm(1:knon, 2:klev)
+      ycoefh(1:knon, 2:klev) = ykmn(1:knon, 2:klev)
+
     ELSE
-       ! No TKE for Standard Physics
-       yq2=0.
+      ! No TKE for Standard Physics
+      yq2 = 0.
     ENDIF !(iflag_pbl.ge.3)
 
   END SUBROUTINE coef_diff_turb
 
-!****************************************************************************************
+  !****************************************************************************************
 
   SUBROUTINE coefkz(nsrf, knon, paprs, pplay, &
-       ksta, ksta_ter, &
-       ts, &
-       u,v,t,q, &
-       qsurf, &
-       pcfm, pcfh)
-    
+          ksta, ksta_ter, &
+          ts, &
+          u, v, t, q, &
+          qsurf, &
+          pcfm, pcfh)
+
     USE dimphy
     USE indice_sol_mod
     USE lmdz_print_control, ONLY: prt_level, lunout
     USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
-  
-!======================================================================
-! Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
-!           (une version strictement identique a l'ancien modele)
-! Objet: calculer le coefficient du frottement du sol (Cdrag) et les
-!        coefficients d'echange turbulent dans l'atmosphere.
-! Arguments:
-! nsrf-----input-I- indicateur de la nature du sol
-! knon-----input-I- nombre de points a traiter
-! paprs----input-R- pregssion a chaque intercouche (en Pa)
-! pplay----input-R- pression au milieu de chaque couche (en Pa)
-! ts-------input-R- temperature du sol (en Kelvin)
-! u--------input-R- vitesse u
-! v--------input-R- vitesse v
-! t--------input-R- temperature (K)
-! q--------input-R- vapeur d'eau (kg/kg)
-
-! pcfm-----output-R- coefficients a calculer (vitesse)
-! pcfh-----output-R- coefficients a calculer (chaleur et humidite)
-!======================================================================
-    INCLUDE "YOETHF.h"
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
+    !======================================================================
+    ! Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
+    !           (une version strictement identique a l'ancien modele)
+    ! Objet: calculer le coefficient du frottement du sol (Cdrag) et les
+    !        coefficients d'echange turbulent dans l'atmosphere.
+    ! Arguments:
+    ! nsrf-----input-I- indicateur de la nature du sol
+    ! knon-----input-I- nombre de points a traiter
+    ! paprs----input-R- pregssion a chaque intercouche (en Pa)
+    ! pplay----input-R- pression au milieu de chaque couche (en Pa)
+    ! ts-------input-R- temperature du sol (en Kelvin)
+    ! u--------input-R- vitesse u
+    ! v--------input-R- vitesse v
+    ! t--------input-R- temperature (K)
+    ! q--------input-R- vapeur d'eau (kg/kg)
+
+    ! pcfm-----output-R- coefficients a calculer (vitesse)
+    ! pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+    !======================================================================
     INCLUDE "YOMCST.h"
-    INCLUDE "FCTTRE.h"
-
-! Arguments:
-
-    INTEGER, INTENT(IN)                      :: knon, nsrf
-    REAL, INTENT(IN)                         :: ksta, ksta_ter
-    REAL, DIMENSION(klon), INTENT(IN)        :: ts
-    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: u, v, t, q
-    REAL, DIMENSION(klon), INTENT(IN)        :: qsurf
-
-    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: pcfm, pcfh
-
-! Local variables:
-
-    INTEGER, DIMENSION(klon)    :: itop ! numero de couche du sommet de la couche limite
-
-! Quelques constantes et options:
-
-    REAL, PARAMETER :: cepdu2=0.1**2
-    REAL, PARAMETER :: CKAP=0.4
-    REAL, PARAMETER :: cb=5.0
-    REAL, PARAMETER :: cc=5.0
-    REAL, PARAMETER :: cd=5.0
-    REAL, PARAMETER :: clam=160.0
-    REAL, PARAMETER :: ratqs=0.05 ! largeur de distribution de vapeur d'eau
-    LOGICAL, PARAMETER :: richum=.TRUE. ! utilise le nombre de Richardson humide
-    REAL, PARAMETER :: ric=0.4 ! nombre de Richardson critique
-    REAL, PARAMETER :: prandtl=0.4
+
+    ! Arguments:
+
+    INTEGER, INTENT(IN) :: knon, nsrf
+    REAL, INTENT(IN) :: ksta, ksta_ter
+    REAL, DIMENSION(klon), INTENT(IN) :: ts
+    REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: u, v, t, q
+    REAL, DIMENSION(klon), INTENT(IN) :: qsurf
+
+    REAL, DIMENSION(klon, klev), INTENT(OUT) :: pcfm, pcfh
+
+    ! Local variables:
+
+    INTEGER, DIMENSION(klon) :: itop ! numero de couche du sommet de la couche limite
+
+    ! Quelques constantes et options:
+
+    REAL, PARAMETER :: cepdu2 = 0.1**2
+    REAL, PARAMETER :: CKAP = 0.4
+    REAL, PARAMETER :: cb = 5.0
+    REAL, PARAMETER :: cc = 5.0
+    REAL, PARAMETER :: cd = 5.0
+    REAL, PARAMETER :: clam = 160.0
+    REAL, PARAMETER :: ratqs = 0.05 ! largeur de distribution de vapeur d'eau
+    LOGICAL, PARAMETER :: richum = .TRUE. ! utilise le nombre de Richardson humide
+    REAL, PARAMETER :: ric = 0.4 ! nombre de Richardson critique
+    REAL, PARAMETER :: prandtl = 0.4
     REAL kstable ! diffusion minimale (situation stable)
     ! GKtest
     ! PARAMETER (kstable=1.0e-10)
-!IM: 261103     REAL kstable_ter, kstable_sinon
-!IM: 211003 cf GK   PARAMETER (kstable_ter = 1.0e-6)
-!IM: 261103     PARAMETER (kstable_ter = 1.0e-8)
-!IM: 261103   PARAMETER (kstable_ter = 1.0e-10)
-!IM: 261103   PARAMETER (kstable_sinon = 1.0e-10)
+    !IM: 261103     REAL kstable_ter, kstable_sinon
+    !IM: 211003 cf GK   PARAMETER (kstable_ter = 1.0e-6)
+    !IM: 261103     PARAMETER (kstable_ter = 1.0e-8)
+    !IM: 261103   PARAMETER (kstable_ter = 1.0e-10)
+    !IM: 261103   PARAMETER (kstable_sinon = 1.0e-10)
     ! fin GKtest
-    REAL, PARAMETER :: mixlen=35.0 ! constante controlant longueur de melange
+    REAL, PARAMETER :: mixlen = 35.0 ! constante controlant longueur de melange
     INTEGER isommet ! le sommet de la couche limite
-    LOGICAL, PARAMETER :: tvirtu=.TRUE. ! calculer Ri d'une maniere plus performante
-    LOGICAL, PARAMETER :: opt_ec=.FALSE.! formule du Centre Europeen dans l'atmosphere
-
-! Variables locales:
+    LOGICAL, PARAMETER :: tvirtu = .TRUE. ! calculer Ri d'une maniere plus performante
+    LOGICAL, PARAMETER :: opt_ec = .FALSE.! formule du Centre Europeen dans l'atmosphere
+
+    ! Variables locales:
     INTEGER i, k !IM 120704
-    REAL zgeop(klon,klev)
+    REAL zgeop(klon, klev)
     REAL zmgeom(klon)
     REAL zri(klon)
@@ -288,247 +286,246 @@
     REAL zt, zq, zdelta, zcvm5, zcor, zqs, zfr, zdqs
     REAL z2geomf, zalh2, zalm2, zscfh, zscfm
-    REAL, PARAMETER :: t_coup=273.15
-    LOGICAL, PARAMETER :: check=.FALSE.
-
-! contre-gradient pour la chaleur sensible: Kelvin/metre
+    REAL, PARAMETER :: t_coup = 273.15
+    LOGICAL, PARAMETER :: check = .FALSE.
+
+    ! contre-gradient pour la chaleur sensible: Kelvin/metre
     REAL gamt(2:klev)
 
-    LOGICAL, SAVE :: appel1er=.TRUE.
+    LOGICAL, SAVE :: appel1er = .TRUE.
     !$OMP THREADPRIVATE(appel1er)
 
-! Fonctions thermodynamiques et fonctions d'instabilite
+    ! Fonctions thermodynamiques et fonctions d'instabilite
     REAL fsta, fins, x
 
-    fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
-    fins(x) = SQRT(1.0-18.0*x)
-
-    isommet=klev
-      
+    fsta(x) = 1.0 / (1.0 + 10.0 * x * (1 + 8.0 * x))
+    fins(x) = SQRT(1.0 - 18.0 * x)
+
+    isommet = klev
+
     IF (appel1er) THEN
-       IF (prt_level > 9) THEN
-          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
-          WRITE(lunout,*)'coefkz, richum:', richum
-          IF (richum) WRITE(lunout,*)'coefkz, ratqs:', ratqs
-          WRITE(lunout,*)'coefkz, isommet:', isommet
-          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
-          appel1er = .FALSE.
-       ENDIF
+      IF (prt_level > 9) THEN
+        WRITE(lunout, *)'coefkz, opt_ec:', opt_ec
+        WRITE(lunout, *)'coefkz, richum:', richum
+        IF (richum) WRITE(lunout, *)'coefkz, ratqs:', ratqs
+        WRITE(lunout, *)'coefkz, isommet:', isommet
+        WRITE(lunout, *)'coefkz, tvirtu:', tvirtu
+        appel1er = .FALSE.
+      ENDIF
     ENDIF
 
-! Initialiser les sorties
+    ! Initialiser les sorties
 
     DO k = 1, klev
-       DO i = 1, knon
-          pcfm(i,k) = 0.0
-          pcfh(i,k) = 0.0
-       ENDDO
+      DO i = 1, knon
+        pcfm(i, k) = 0.0
+        pcfh(i, k) = 0.0
+      ENDDO
     ENDDO
     DO i = 1, knon
-       itop(i) = 0
-    ENDDO
-
-! Prescrire la valeur de contre-gradient
+      itop(i) = 0
+    ENDDO
+
+    ! Prescrire la valeur de contre-gradient
 
     IF (iflag_pbl==1) THEN
-       DO k = 3, klev
-          gamt(k) = -1.0E-03
-       ENDDO
-       gamt(2) = -2.5E-03
+      DO k = 3, klev
+        gamt(k) = -1.0E-03
+      ENDDO
+      gamt(2) = -2.5E-03
     ELSE
-       DO k = 2, klev
-          gamt(k) = 0.0
-       ENDDO
+      DO k = 2, klev
+        gamt(k) = 0.0
+      ENDDO
     ENDIF
-!IM cf JLD/ GKtest
-    IF ( nsrf /= is_oce ) THEN
-!IM 261103     kstable = kstable_ter
-       kstable = ksta_ter
+    !IM cf JLD/ GKtest
+    IF (nsrf /= is_oce) THEN
+      !IM 261103     kstable = kstable_ter
+      kstable = ksta_ter
     ELSE
-!IM 261103     kstable = kstable_sinon
-       kstable = ksta
+      !IM 261103     kstable = kstable_sinon
+      kstable = ksta
     ENDIF
-!IM cf JLD/ GKtest fin
-
-! Calculer les geopotentiels de chaque couche
+    !IM cf JLD/ GKtest fin
+
+    ! Calculer les geopotentiels de chaque couche
 
     DO i = 1, knon
-       zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1))) &
-            * (paprs(i,1)-pplay(i,1))
+      zgeop(i, 1) = RD * t(i, 1) / (0.5 * (paprs(i, 1) + pplay(i, 1))) &
+              * (paprs(i, 1) - pplay(i, 1))
     ENDDO
     DO k = 2, klev
-       DO i = 1, knon
-          zgeop(i,k) = zgeop(i,k-1) &
-               + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k) &
-               * (pplay(i,k-1)-pplay(i,k))
-       ENDDO
-    ENDDO
-
-! Calculer les coefficients turbulents dans l'atmosphere
+      DO i = 1, knon
+        zgeop(i, k) = zgeop(i, k - 1) &
+                + RD * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) &
+                        * (pplay(i, k - 1) - pplay(i, k))
+      ENDDO
+    ENDDO
+
+    ! Calculer les coefficients turbulents dans l'atmosphere
 
     DO i = 1, knon
-       itop(i) = isommet
-    ENDDO
-
+      itop(i) = isommet
+    ENDDO
 
     DO k = 2, isommet
-       DO i = 1, knon
-          zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2 &
-               +(v(i,k)-v(i,k-1))**2)
-          zmgeom(i)=zgeop(i,k)-zgeop(i,k-1)
-          zdphi =zmgeom(i) / 2.0
-          zt = (t(i,k)+t(i,k-1)) * 0.5
-          zq = (q(i,k)+q(i,k-1)) * 0.5
-
-! Calculer Qs et dQs/dT:
-
-          IF (thermcep) THEN
-             zdelta = MAX(0.,SIGN(1.,RTT-zt))
-             zcvm5 = R5LES*RLVTT/RCPD/(1.0+RVTMP2*zq)*(1.-zdelta) &
-                  + R5IES*RLSTT/RCPD/(1.0+RVTMP2*zq)*zdelta
-             zqs = R2ES * FOEEW(zt,zdelta) / pplay(i,k)
-             zqs = MIN(0.5,zqs)
-             zcor = 1./(1.-RETV*zqs)
-             zqs = zqs*zcor
-             zdqs = FOEDE(zt,zdelta,zcvm5,zqs,zcor)
+      DO i = 1, knon
+        zdu2 = MAX(cepdu2, (u(i, k) - u(i, k - 1))**2 &
+                + (v(i, k) - v(i, k - 1))**2)
+        zmgeom(i) = zgeop(i, k) - zgeop(i, k - 1)
+        zdphi = zmgeom(i) / 2.0
+        zt = (t(i, k) + t(i, k - 1)) * 0.5
+        zq = (q(i, k) + q(i, k - 1)) * 0.5
+
+        ! Calculer Qs et dQs/dT:
+
+        IF (thermcep) THEN
+          zdelta = MAX(0., SIGN(1., RTT - zt))
+          zcvm5 = R5LES * RLVTT / RCPD / (1.0 + RVTMP2 * zq) * (1. - zdelta) &
+                  + R5IES * RLSTT / RCPD / (1.0 + RVTMP2 * zq) * zdelta
+          zqs = R2ES * FOEEW(zt, zdelta) / pplay(i, k)
+          zqs = MIN(0.5, zqs)
+          zcor = 1. / (1. - RETV * zqs)
+          zqs = zqs * zcor
+          zdqs = FOEDE(zt, zdelta, zcvm5, zqs, zcor)
+        ELSE
+          IF (zt < t_coup) THEN
+            zqs = qsats(zt) / pplay(i, k)
+            zdqs = dqsats(zt, zqs)
           ELSE
-             IF (zt < t_coup) THEN
-                zqs = qsats(zt) / pplay(i,k)
-                zdqs = dqsats(zt,zqs)
-             ELSE
-                zqs = qsatl(zt) / pplay(i,k)
-                zdqs = dqsatl(zt,zqs)
-             ENDIF
+            zqs = qsatl(zt) / pplay(i, k)
+            zdqs = dqsatl(zt, zqs)
           ENDIF
-
-!           calculer la fraction nuageuse (processus humide):
-
-          IF (zq /= 0.) THEN
-             zfr = (zq+ratqs*zq-zqs) / (2.0*ratqs*zq)
-          else
-             zfr = 0.
-          end if
-          zfr = MAX(0.0,MIN(1.0,zfr))
-          IF (.NOT.richum) zfr = 0.0
-
-!           calculer le nombre de Richardson:
-
-          IF (tvirtu) THEN
-             ztvd =( t(i,k) &
-                  + zdphi/RCPD/(1.+RVTMP2*zq) &
-                  *( (1.-zfr) + zfr*(1.+RLVTT*zqs/RD/zt)/(1.+zdqs) ) &
-                  )*(1.+RETV*q(i,k))
-             ztvu =( t(i,k-1) &
-                  - zdphi/RCPD/(1.+RVTMP2*zq) &
-                  *( (1.-zfr) + zfr*(1.+RLVTT*zqs/RD/zt)/(1.+zdqs) ) &
-                  )*(1.+RETV*q(i,k-1))
-             zri(i) =zmgeom(i)*(ztvd-ztvu)/(zdu2*0.5*(ztvd+ztvu))
-             zri(i) = zri(i) &
-                  + zmgeom(i)*zmgeom(i)/RG*gamt(k) &
-                  *(paprs(i,k)/101325.0)**RKAPPA &
-                  /(zdu2*0.5*(ztvd+ztvu))
-
-          ELSE ! calcul de Ridchardson compatible LMD5
-
-             zri(i) =(RCPD*(t(i,k)-t(i,k-1)) &
-                  -RD*0.5*(t(i,k)+t(i,k-1))/paprs(i,k) &
-                  *(pplay(i,k)-pplay(i,k-1)) &
-                  )*zmgeom(i)/(zdu2*0.5*RCPD*(t(i,k-1)+t(i,k)))
-             zri(i) = zri(i) + &
-                  zmgeom(i)*zmgeom(i)*gamt(k)/RG &
-                  *(paprs(i,k)/101325.0)**RKAPPA &
-                  /(zdu2*0.5*(t(i,k-1)+t(i,k)))
+        ENDIF
+
+        !           calculer la fraction nuageuse (processus humide):
+
+        IF (zq /= 0.) THEN
+          zfr = (zq + ratqs * zq - zqs) / (2.0 * ratqs * zq)
+        else
+          zfr = 0.
+        end if
+        zfr = MAX(0.0, MIN(1.0, zfr))
+        IF (.NOT.richum) zfr = 0.0
+
+        !           calculer le nombre de Richardson:
+
+        IF (tvirtu) THEN
+          ztvd = (t(i, k) &
+                  + zdphi / RCPD / (1. + RVTMP2 * zq) &
+                          * ((1. - zfr) + zfr * (1. + RLVTT * zqs / RD / zt) / (1. + zdqs)) &
+                  ) * (1. + RETV * q(i, k))
+          ztvu = (t(i, k - 1) &
+                  - zdphi / RCPD / (1. + RVTMP2 * zq) &
+                          * ((1. - zfr) + zfr * (1. + RLVTT * zqs / RD / zt) / (1. + zdqs)) &
+                  ) * (1. + RETV * q(i, k - 1))
+          zri(i) = zmgeom(i) * (ztvd - ztvu) / (zdu2 * 0.5 * (ztvd + ztvu))
+          zri(i) = zri(i) &
+                  + zmgeom(i) * zmgeom(i) / RG * gamt(k) &
+                          * (paprs(i, k) / 101325.0)**RKAPPA &
+                          / (zdu2 * 0.5 * (ztvd + ztvu))
+
+        ELSE ! calcul de Ridchardson compatible LMD5
+
+          zri(i) = (RCPD * (t(i, k) - t(i, k - 1)) &
+                  - RD * 0.5 * (t(i, k) + t(i, k - 1)) / paprs(i, k) &
+                          * (pplay(i, k) - pplay(i, k - 1)) &
+                  ) * zmgeom(i) / (zdu2 * 0.5 * RCPD * (t(i, k - 1) + t(i, k)))
+          zri(i) = zri(i) + &
+                  zmgeom(i) * zmgeom(i) * gamt(k) / RG &
+                          * (paprs(i, k) / 101325.0)**RKAPPA &
+                          / (zdu2 * 0.5 * (t(i, k - 1) + t(i, k)))
+        ENDIF
+
+        !           finalement, les coefficients d'echange sont obtenus:
+
+        zcdn = SQRT(zdu2) / zmgeom(i) * RG
+
+        IF (opt_ec) THEN
+          z2geomf = zgeop(i, k - 1) + zgeop(i, k)
+          zalm2 = (0.5 * ckap / RG * z2geomf &
+                  / (1. + 0.5 * ckap / rg / clam * z2geomf))**2
+          zalh2 = (0.5 * ckap / rg * z2geomf &
+                  / (1. + 0.5 * ckap / RG / (clam * SQRT(1.5 * cd)) * z2geomf))**2
+          IF (zri(i)<0.0) THEN  ! situation instable
+            zscf = ((zgeop(i, k) / zgeop(i, k - 1))**(1. / 3.) - 1.)**3 &
+                    / (zmgeom(i) / RG)**3 / (zgeop(i, k - 1) / RG)
+            zscf = SQRT(-zri(i) * zscf)
+            zscfm = 1.0 / (1.0 + 3.0 * cb * cc * zalm2 * zscf)
+            zscfh = 1.0 / (1.0 + 3.0 * cb * cc * zalh2 * zscf)
+            pcfm(i, k) = zcdn * zalm2 * (1. - 2.0 * cb * zri(i) * zscfm)
+            pcfh(i, k) = zcdn * zalh2 * (1. - 3.0 * cb * zri(i) * zscfh)
+          ELSE ! situation stable
+            zscf = SQRT(1. + cd * zri(i))
+            pcfm(i, k) = zcdn * zalm2 / (1. + 2.0 * cb * zri(i) / zscf)
+            pcfh(i, k) = zcdn * zalh2 / (1. + 3.0 * cb * zri(i) * zscf)
           ENDIF
-
-!           finalement, les coefficients d'echange sont obtenus:
-
-          zcdn=SQRT(zdu2) / zmgeom(i) * RG
-
-          IF (opt_ec) THEN
-             z2geomf=zgeop(i,k-1)+zgeop(i,k)
-             zalm2=(0.5*ckap/RG*z2geomf &
-                  /(1.+0.5*ckap/rg/clam*z2geomf))**2
-             zalh2=(0.5*ckap/rg*z2geomf &
-                  /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
-             IF (zri(i)<0.0) THEN  ! situation instable
-                zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3 &
-                     / (zmgeom(i)/RG)**3 / (zgeop(i,k-1)/RG)
-                zscf = SQRT(-zri(i)*zscf)
-                zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
-                zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
-                pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
-                pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
-             ELSE ! situation stable
-                zscf=SQRT(1.+cd*zri(i))
-                pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
-                pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
-             ENDIF
-          ELSE
-             zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1)) &
-                  /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
-             pcfm(i,k)=SQRT(MAX(zcdn*zcdn*(ric-zri(i))/ric, kstable))
-             pcfm(i,k)= zl2(i)* pcfm(i,k)
-             pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
-          ENDIF
-       ENDDO
-    ENDDO
-
-! Au-dela du sommet, pas de diffusion turbulente:
+        ELSE
+          zl2(i) = (mixlen * MAX(0.0, (paprs(i, k) - paprs(i, itop(i) + 1)) &
+                  / (paprs(i, 2) - paprs(i, itop(i) + 1))))**2
+          pcfm(i, k) = SQRT(MAX(zcdn * zcdn * (ric - zri(i)) / ric, kstable))
+          pcfm(i, k) = zl2(i) * pcfm(i, k)
+          pcfh(i, k) = pcfm(i, k) / prandtl ! h et m different
+        ENDIF
+      ENDDO
+    ENDDO
+
+    ! Au-dela du sommet, pas de diffusion turbulente:
 
     DO i = 1, knon
-       IF (itop(i)+1 <= klev) THEN
-          DO k = itop(i)+1, klev
-             pcfh(i,k) = 0.0
-             pcfm(i,k) = 0.0
-          ENDDO
-       ENDIF
-    ENDDO
-      
+      IF (itop(i) + 1 <= klev) THEN
+        DO k = itop(i) + 1, klev
+          pcfh(i, k) = 0.0
+          pcfm(i, k) = 0.0
+        ENDDO
+      ENDIF
+    ENDDO
+
   END SUBROUTINE coefkz
 
-!****************************************************************************************
-
-  SUBROUTINE coefkz2(nsrf, knon, paprs, pplay,t, &
-       pcfm, pcfh)
+  !****************************************************************************************
+
+  SUBROUTINE coefkz2(nsrf, knon, paprs, pplay, t, &
+          pcfm, pcfh)
 
     USE dimphy
     USE indice_sol_mod
 
-!======================================================================
-! J'introduit un peu de diffusion sauf dans les endroits
-! ou une forte inversion est presente
-! On peut dire qu'il represente la convection peu profonde
-
-! Arguments:
-! nsrf-----input-I- indicateur de la nature du sol
-! knon-----input-I- nombre de points a traiter
-! paprs----input-R- pression a chaque intercouche (en Pa)
-! pplay----input-R- pression au milieu de chaque couche (en Pa)
-! t--------input-R- temperature (K)
-
-! pcfm-----output-R- coefficients a calculer (vitesse)
-! pcfh-----output-R- coefficients a calculer (chaleur et humidite)
-!======================================================================
-
-! Arguments:
-
-    INTEGER, INTENT(IN)                       :: knon, nsrf
-    REAL, DIMENSION(klon, klev+1), INTENT(IN) ::  paprs
-    REAL, DIMENSION(klon, klev), INTENT(IN)   ::  pplay
-    REAL, DIMENSION(klon, klev), INTENT(IN)   :: t(klon,klev)
-    
-    REAL, DIMENSION(klon, klev), INTENT(OUT)  :: pcfm, pcfh
-
-! Quelques constantes et options:
-
-    REAL, PARAMETER :: prandtl=0.4
-    REAL, PARAMETER :: kstable=0.002
-!   REAL, PARAMETER :: kstable=0.001
-    REAL, PARAMETER :: mixlen=35.0 ! constante controlant longueur de melange
-    REAL, PARAMETER :: seuil=-0.02 ! au-dela l'inversion est consideree trop faible
-!    PARAMETER (seuil=-0.04)
-!    PARAMETER (seuil=-0.06)
-!    PARAMETER (seuil=-0.09)
-
-! Variables locales:
+    !======================================================================
+    ! J'introduit un peu de diffusion sauf dans les endroits
+    ! ou une forte inversion est presente
+    ! On peut dire qu'il represente la convection peu profonde
+
+    ! Arguments:
+    ! nsrf-----input-I- indicateur de la nature du sol
+    ! knon-----input-I- nombre de points a traiter
+    ! paprs----input-R- pression a chaque intercouche (en Pa)
+    ! pplay----input-R- pression au milieu de chaque couche (en Pa)
+    ! t--------input-R- temperature (K)
+
+    ! pcfm-----output-R- coefficients a calculer (vitesse)
+    ! pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+    !======================================================================
+
+    ! Arguments:
+
+    INTEGER, INTENT(IN) :: knon, nsrf
+    REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay
+    REAL, DIMENSION(klon, klev), INTENT(IN) :: t(klon, klev)
+
+    REAL, DIMENSION(klon, klev), INTENT(OUT) :: pcfm, pcfh
+
+    ! Quelques constantes et options:
+
+    REAL, PARAMETER :: prandtl = 0.4
+    REAL, PARAMETER :: kstable = 0.002
+    !   REAL, PARAMETER :: kstable=0.001
+    REAL, PARAMETER :: mixlen = 35.0 ! constante controlant longueur de melange
+    REAL, PARAMETER :: seuil = -0.02 ! au-dela l'inversion est consideree trop faible
+    !    PARAMETER (seuil=-0.04)
+    !    PARAMETER (seuil=-0.06)
+    !    PARAMETER (seuil=-0.09)
+
+    ! Variables locales:
 
     INTEGER i, k, invb(knon)
@@ -538,59 +535,59 @@
     INCLUDE "YOMCST.h"
 
-! Initialiser les sorties
+    ! Initialiser les sorties
 
     DO k = 1, klev
-       DO i = 1, knon
-          pcfm(i,k) = 0.0
-          pcfh(i,k) = 0.0
-       ENDDO
-    ENDDO
-
-! Chercher la zone d'inversion forte
+      DO i = 1, knon
+        pcfm(i, k) = 0.0
+        pcfh(i, k) = 0.0
+      ENDDO
+    ENDDO
+
+    ! Chercher la zone d'inversion forte
 
     DO i = 1, knon
-       invb(i) = klev
-       zdthmin(i)=0.0
-    ENDDO
-    DO k = 2, klev/2-1
-       DO i = 1, knon
-          zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1)) &
-               - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)
-          zdthdp = zdthdp * 100.0
-          IF (pplay(i,k)>0.8*paprs(i,1) .AND. &
-               zdthdp<zdthmin(i) ) THEN
-             zdthmin(i) = zdthdp
-             invb(i) = k
+      invb(i) = klev
+      zdthmin(i) = 0.0
+    ENDDO
+    DO k = 2, klev / 2 - 1
+      DO i = 1, knon
+        zdthdp = (t(i, k) - t(i, k + 1)) / (pplay(i, k) - pplay(i, k + 1)) &
+                - RD * 0.5 * (t(i, k) + t(i, k + 1)) / RCPD / paprs(i, k + 1)
+        zdthdp = zdthdp * 100.0
+        IF (pplay(i, k)>0.8 * paprs(i, 1) .AND. &
+                zdthdp<zdthmin(i)) THEN
+          zdthmin(i) = zdthdp
+          invb(i) = k
+        ENDIF
+      ENDDO
+    ENDDO
+
+    ! Introduire une diffusion:
+
+    IF (nsrf==is_oce) THEN
+      DO k = 2, klev
+        DO i = 1, knon
+          !IM cf FH/GK   IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean
+          !IM cf FH/GK  .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion
+          !IM cf JLD/ GKtest TERkz2
+          ! IF ( (nsrf.EQ.is_ter) .OR.  ! si on est sur la terre
+          ! fin GKtest
+
+
+          ! s'il n'y a pas d'inversion ou si l'inversion est trop faible
+          !          IF ( (nsrf.EQ.is_oce) .AND. &
+          IF ((invb(i)==klev) .OR. (zdthmin(i)>seuil)) THEN
+            zl2(i) = (mixlen * MAX(0.0, (paprs(i, k) - paprs(i, klev + 1)) &
+                    / (paprs(i, 2) - paprs(i, klev + 1))))**2
+            pcfm(i, k) = zl2(i) * kstable
+            pcfh(i, k) = pcfm(i, k) / prandtl ! h et m different
           ENDIF
-       ENDDO
-    ENDDO
-
-! Introduire une diffusion:
-
-    IF ( nsrf==is_oce ) THEN
-       DO k = 2, klev
-          DO i = 1, knon
-!IM cf FH/GK   IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean
-!IM cf FH/GK  .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion
-      !IM cf JLD/ GKtest TERkz2
-      ! IF ( (nsrf.EQ.is_ter) .OR.  ! si on est sur la terre
-      ! fin GKtest
-
-
-! s'il n'y a pas d'inversion ou si l'inversion est trop faible
-!          IF ( (nsrf.EQ.is_oce) .AND. &
-             IF ( (invb(i)==klev) .OR. (zdthmin(i)>seuil) ) THEN
-                zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,klev+1)) &
-                     /(paprs(i,2)-paprs(i,klev+1)) ))**2
-                pcfm(i,k)= zl2(i)* kstable
-                pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
-             ENDIF
-          ENDDO
-       ENDDO
+        ENDDO
+      ENDDO
     ENDIF
 
   END SUBROUTINE coefkz2
 
-!****************************************************************************************
+  !****************************************************************************************
 
 END MODULE coef_diff_turb_mod
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/coefcdrag.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/coefcdrag.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/coefcdrag.F90	(revision 5143)
@@ -10,4 +10,5 @@
       USE lmdz_abort_physic, ONLY: abort_physic
       USE lmdz_clesphys
+      USE lmdz_YOETHF
 
       IMPLICIT NONE
@@ -53,5 +54,4 @@
 
       include "YOMCST.h"
-      include "YOETHF.h"
 ! Quelques constantes :
       REAL, parameter :: RKAR=0.40, CB=5.0, CC=5.0, CD=5.0, cepdu2=(0.1)**2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conccm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conccm.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conccm.F90	(revision 5143)
@@ -1,9 +1,10 @@
-
 ! $Header$
 
 SUBROUTINE conccm(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, rain, snow, &
-    kbascm, ktopcm)
+        kbascm, ktopcm)
 
   USE dimphy
+  USE lmdz_YOETHF
+
   IMPLICIT NONE
   ! ======================================================================
@@ -13,9 +14,8 @@
   ! ======================================================================
   include "YOMCST.h"
-  include "YOETHF.h"
 
   ! Entree:
   REAL dtime ! pas d'integration
-  REAL paprs(klon, klev+1) ! pression inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
   REAL t(klon, klev) ! temperature (K)
@@ -43,5 +43,5 @@
 
   LOGICAL usekuo ! utiliser convection profonde (schema Kuo)
-  PARAMETER (usekuo=.TRUE.)
+  PARAMETER (usekuo = .TRUE.)
 
   REAL d_t_bis(klon, klev)
@@ -72,18 +72,18 @@
   DO k = 1, klev
     DO i = 1, klon
-      pt(i, k) = t(i, klev-k+1)
-      pq(i, k) = q(i, klev-k+1)
-      pres(i, k) = pplay(i, klev-k+1)
-      dp(i, k) = paprs(i, klev+1-k) - paprs(i, klev+1-k+1)
+      pt(i, k) = t(i, klev - k + 1)
+      pq(i, k) = q(i, klev - k + 1)
+      pres(i, k) = pplay(i, klev - k + 1)
+      dp(i, k) = paprs(i, klev + 1 - k) - paprs(i, klev + 1 - k + 1)
     END DO
   END DO
   DO i = 1, klon
-    zgeom(i, klev) = rd*t(i, 1)/(0.5*(paprs(i,1)+pplay(i, &
-      1)))*(paprs(i,1)-pplay(i,1))
+    zgeom(i, klev) = rd * t(i, 1) / (0.5 * (paprs(i, 1) + pplay(i, &
+            1))) * (paprs(i, 1) - pplay(i, 1))
   END DO
   DO k = 2, klev
     DO i = 1, klon
-      zgeom(i, klev+1-k) = zgeom(i, klev+1-k+1) + rd*0.5*(t(i,k-1)+t(i,k))/ &
-        paprs(i, k)*(pplay(i,k-1)-pplay(i,k))
+      zgeom(i, klev + 1 - k) = zgeom(i, klev + 1 - k + 1) + rd * 0.5 * (t(i, k - 1) + t(i, k)) / &
+              paprs(i, k) * (pplay(i, k - 1) - pplay(i, k))
     END DO
   END DO
@@ -93,12 +93,12 @@
   DO k = 1, klev
     DO i = 1, klon
-      d_q(i, klev+1-k) = pq(i, k) - q(i, klev+1-k)
-      d_t(i, klev+1-k) = pt(i, k) - t(i, klev+1-k)
+      d_q(i, klev + 1 - k) = pq(i, k) - q(i, klev + 1 - k)
+      d_t(i, klev + 1 - k) = pt(i, k) - t(i, klev + 1 - k)
     END DO
   END DO
 
   DO i = 1, klon
-    rain(i) = cmfprt(i)*rhoh2o
-    snow(i) = cmfprs(i)*rhoh2o
+    rain(i) = cmfprt(i) * rhoh2o
+    snow(i) = cmfprs(i) * rhoh2o
     kbascm(i) = klev + 1 - nbas(i)
     ktopcm(i) = klev + 1 - ntop(i)
@@ -107,5 +107,5 @@
   IF (usekuo) THEN
     CALL conkuo(dtime, paprs, pplay, t, q, conv_q, d_t_bis, d_q_bis, &
-      d_ql_bis, rneb_bis, rain_bis, snow_bis, ibas_bis, itop_bis)
+            d_ql_bis, rneb_bis, rain_bis, snow_bis, ibas_bis, itop_bis)
     DO k = 1, klev
       DO i = 1, klon
@@ -122,10 +122,10 @@
     DO k = 1, klev ! eau liquide convective est
       DO i = 1, klon ! dispersee dans l'air
-        zlvdcp = rlvtt/rcpd/(1.0+rvtmp2*q(i,k))
-        zlsdcp = rlstt/rcpd/(1.0+rvtmp2*q(i,k))
-        zdelta = max(0., sign(1.,rtt-t(i,k)))
+        zlvdcp = rlvtt / rcpd / (1.0 + rvtmp2 * q(i, k))
+        zlsdcp = rlstt / rcpd / (1.0 + rvtmp2 * q(i, k))
+        zdelta = max(0., sign(1., rtt - t(i, k)))
         zz = d_ql_bis(i, k) ! re-evap. de l'eau liquide
         zb = max(0.0, zz)
-        za = -max(0.0, zz)*(zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
+        za = -max(0.0, zz) * (zlvdcp * (1. - zdelta) + zlsdcp * zdelta)
         d_t(i, k) = d_t(i, k) + za
         d_q(i, k) = d_q(i, k) + zb
@@ -134,8 +134,10 @@
   END IF
 
-
 END SUBROUTINE conccm
 SUBROUTINE cmfmca(deltat, p, dp, gz, tb, shb, cmfprt, cmfprs, cnt, cnb)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! -----------------------------------------------------------------------
@@ -159,5 +161,5 @@
   ! -----------------------------------------------------------------------
   INTEGER pcnst ! nombre de traceurs passifs
-  PARAMETER (pcnst=1)
+  PARAMETER (pcnst = 1)
   ! ------------------------------Arguments--------------------------------
   ! Input arguments
@@ -194,25 +196,25 @@
   ! ------------------------------Parameters-------------------------------
   REAL c0 ! rain water autoconversion coefficient
-  PARAMETER (c0=1.0E-4)
+  PARAMETER (c0 = 1.0E-4)
   REAL dzmin ! minimum convective depth for precipitation
-  PARAMETER (dzmin=0.0)
+  PARAMETER (dzmin = 0.0)
   REAL betamn ! minimum overshoot parameter
-  PARAMETER (betamn=0.10)
+  PARAMETER (betamn = 0.10)
   REAL cmftau ! characteristic adjustment time scale
-  PARAMETER (cmftau=3600.)
+  PARAMETER (cmftau = 3600.)
   INTEGER limcnv ! top interface level limit for convection
-  PARAMETER (limcnv=1)
+  PARAMETER (limcnv = 1)
   REAL tpmax ! maximum acceptable t perturbation (degrees C)
-  PARAMETER (tpmax=1.50)
+  PARAMETER (tpmax = 1.50)
   REAL shpmax ! maximum acceptable q perturbation (g/g)
-  PARAMETER (shpmax=1.50E-3)
+  PARAMETER (shpmax = 1.50E-3)
   REAL tiny ! arbitrary small num used in transport estimates
-  PARAMETER (tiny=1.0E-36)
+  PARAMETER (tiny = 1.0E-36)
   REAL eps ! convergence criteria (machine dependent)
-  PARAMETER (eps=1.0E-13)
+  PARAMETER (eps = 1.0E-13)
   REAL tmelt ! freezing point of water(req'd for rain vs snow)
-  PARAMETER (tmelt=273.15)
+  PARAMETER (tmelt = 273.15)
   REAL ssfac ! supersaturation bound (detrained air)
-  PARAMETER (ssfac=1.001)
+  PARAMETER (ssfac = 1.001)
 
   ! ---------------------------Local workspace-----------------------------
@@ -222,8 +224,8 @@
   REAL shbs(klon, klev) ! sat. specific humidity (sh bar star)
   REAL hbs(klon, klev) ! sat. moist static energy (h bar star)
-  REAL shbh(klon, klev+1) ! specific humidity on interfaces
-  REAL sbh(klon, klev+1) ! s bar on interfaces
-  REAL hbh(klon, klev+1) ! h bar on interfaces
-  REAL cmrh(klon, klev+1) ! interface constituent mixing ratio
+  REAL shbh(klon, klev + 1) ! specific humidity on interfaces
+  REAL sbh(klon, klev + 1) ! s bar on interfaces
+  REAL hbh(klon, klev + 1) ! h bar on interfaces
+  REAL cmrh(klon, klev + 1) ! interface constituent mixing ratio
   REAL prec(klon) ! instantaneous total precipitation
   REAL dzcld(klon) ! depth of convective layer (m)
@@ -291,8 +293,6 @@
   REAL qhalf, sh1, sh2, shbs1, shbs2
   include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-  qhalf(sh1, sh2, shbs1, shbs2) = min(max(sh1,sh2), &
-    (shbs2*sh1+shbs1*sh2)/(shbs1+shbs2))
+  qhalf(sh1, sh2, shbs1, shbs2) = min(max(sh1, sh2), &
+          (shbs2 * sh1 + shbs1 * sh2) / (shbs1 + shbs2))
 
   ! -----------------------------------------------------------------------
@@ -324,5 +324,5 @@
   dt = deltat
   cats = max(dt, cmftau)
-  rdt = 1.0/dt
+  rdt = 1.0 / dt
 
   ! Compute sb,hb,shbs,hbs
@@ -333,11 +333,11 @@
       zx_p = p(i, k)
       zx_q = shb(i, k)
-      zdelta = max(0., sign(1.,rtt-zx_t))
-      zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta
-      zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zx_q)
-      zx_qs = r2es*foeew(zx_t, zdelta)/zx_p
+      zdelta = max(0., sign(1., rtt - zx_t))
+      zcvm5 = r5les * rlvtt * (1. - zdelta) + r5ies * rlstt * zdelta
+      zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * zx_q)
+      zx_qs = r2es * foeew(zx_t, zdelta) / zx_p
       zx_qs = min(0.5, zx_qs)
-      zcor = 1./(1.-retv*zx_qs)
-      zx_qs = zx_qs*zcor
+      zcor = 1. / (1. - retv * zx_qs)
+      zx_qs = zx_qs * zcor
       zx_gam = foede(zx_t, zdelta, zcvm5, zx_qs, zcor)
       shbs(i, k) = zx_qs
@@ -348,7 +348,7 @@
   DO k = limcnv, klev
     DO i = 1, klon
-      sb(i, k) = rcpd*tb(i, k) + gz(i, k)
-      hb(i, k) = sb(i, k) + rlvtt*shb(i, k)
-      hbs(i, k) = sb(i, k) + rlvtt*shbs(i, k)
+      sb(i, k) = rcpd * tb(i, k) + gz(i, k)
+      hb(i, k) = sb(i, k) + rlvtt * shb(i, k)
+      hbs(i, k) = sb(i, k) + rlvtt * shbs(i, k)
     END DO
   END DO
@@ -359,7 +359,7 @@
     km1 = k - 1
     DO i = 1, klon
-      sbh(i, k) = 0.5*(sb(i,km1)+sb(i,k))
-      shbh(i, k) = qhalf(shb(i,km1), shb(i,k), shbs(i,km1), shbs(i,k))
-      hbh(i, k) = sbh(i, k) + rlvtt*shbh(i, k)
+      sbh(i, k) = 0.5 * (sb(i, km1) + sb(i, k))
+      shbh(i, k) = qhalf(shb(i, km1), shb(i, k), shbs(i, km1), shbs(i, k))
+      hbh(i, k) = sbh(i, k) + rlvtt * shbh(i, k)
     END DO
   END DO
@@ -425,9 +425,9 @@
 
       pblhgt = max(pblh(i), 1.0)
-      IF (gz(i,kp1)/rg<=pblhgt .AND. dzcld(i)==0.0) THEN
-        fac1 = max(0.0, 1.0-gz(i,kp1)/rg/pblhgt)
-        tprime = min(thtap(i), tpmax)*fac1
-        qsattp = shbs(i, kp1) + rcpd/rlvtt*gam(i, kp1)*tprime
-        shprme = min(min(shp(i),shpmax)*fac1, max(qsattp-shb(i,kp1),0.0))
+      IF (gz(i, kp1) / rg<=pblhgt .AND. dzcld(i)==0.0) THEN
+        fac1 = max(0.0, 1.0 - gz(i, kp1) / rg / pblhgt)
+        tprime = min(thtap(i), tpmax) * fac1
+        qsattp = shbs(i, kp1) + rcpd / rlvtt * gam(i, kp1) * tprime
+        shprme = min(min(shp(i), shpmax) * fac1, max(qsattp - shb(i, kp1), 0.0))
         qprime = max(qprime, shprme)
       ELSE
@@ -438,9 +438,9 @@
       ! Specify "updraft" (in-cloud) thermodynamic properties
 
-      sc(i) = sb(i, kp1) + rcpd*tprime
+      sc(i) = sb(i, kp1) + rcpd * tprime
       shc(i) = shb(i, kp1) + qprime
-      hc(i) = sc(i) + rlvtt*shc(i)
+      hc(i) = sc(i) + rlvtt * shc(i)
       flotab(i) = hc(i) - hbs(i, k)
-      dz = dp(i, k)*rd*tb(i, k)/rg/p(i, k)
+      dz = dp(i, k) * rd * tb(i, k) / rg / p(i, k)
       IF (flotab(i)>0.0) THEN
         dzcld(i) = dzcld(i) + dz
@@ -471,8 +471,8 @@
     ! Current level just below top level => no overshoot
 
-    IF (k<=limcnv+1) THEN
+    IF (k<=limcnv + 1) THEN
       DO i = 1, klon
         IF (ldcum(i)) THEN
-          cldwtr(i) = sb(i, k) - sc(i) + flotab(i)/(1.0+gam(i,k))
+          cldwtr(i) = sb(i, k) - sc(i) + flotab(i) / (1.0 + gam(i, k))
           cldwtr(i) = max(0.0, cldwtr(i))
           beta(i) = 0.0
@@ -489,11 +489,11 @@
     DO i = 1, klon
       IF (ldcum(i)) THEN
-        cldwtr(i) = sb(i, k) - sc(i) + flotab(i)/(1.0+gam(i,k))
+        cldwtr(i) = sb(i, k) - sc(i) + flotab(i) / (1.0 + gam(i, k))
         cldwtr(i) = max(0.0, cldwtr(i))
-        betamx = 1.0 - c0*max(0.0, (dzcld(i)-dzmin))
-        b1 = (hc(i)-hbs(i,km1))*dp(i, km1)
-        b2 = (hc(i)-hbs(i,k))*dp(i, k)
-        beta(i) = max(betamn, min(betamx,1.0+b1/b2))
-        IF (hbs(i,km1)<=hb(i,km1)) beta(i) = 0.0
+        betamx = 1.0 - c0 * max(0.0, (dzcld(i) - dzmin))
+        b1 = (hc(i) - hbs(i, km1)) * dp(i, km1)
+        b2 = (hc(i) - hbs(i, k)) * dp(i, k)
+        beta(i) = max(betamn, min(betamx, 1.0 + b1 / b2))
+        IF (hbs(i, km1)<=hb(i, km1)) beta(i) = 0.0
       END IF
     END DO
@@ -507,10 +507,10 @@
     DO i = 1, klon
       IF (ldcum(i)) THEN
-        tmp1 = (1.0+gam(i,k))*(sc(i)-sbh(i,kp1)+cldwtr(i)) - &
-          (hbh(i,kp1)-hc(i))*dp(i, k)/dp(i, kp1)
-        tmp2 = (1.0+gam(i,k))*(sc(i)-sbh(i,k))
-        IF ((beta(i)*tmp2-tmp1)>0.0) THEN
-          betamx = 0.99*(tmp1/tmp2)
-          beta(i) = max(0.0, min(betamx,beta(i)))
+        tmp1 = (1.0 + gam(i, k)) * (sc(i) - sbh(i, kp1) + cldwtr(i)) - &
+                (hbh(i, kp1) - hc(i)) * dp(i, k) / dp(i, kp1)
+        tmp2 = (1.0 + gam(i, k)) * (sc(i) - sbh(i, k))
+        IF ((beta(i) * tmp2 - tmp1)>0.0) THEN
+          betamx = 0.99 * (tmp1 / tmp2)
+          beta(i) = max(0.0, min(betamx, beta(i)))
         END IF
 
@@ -521,16 +521,16 @@
         ! est acceptee (facteur ssfac).
 
-        IF (hb(i,km1)<hbs(i,km1)) THEN
-          tmp1 = (1.0+gam(i,k))*(sc(i)-sbh(i,kp1)+cldwtr(i)) - &
-            (hbh(i,kp1)-hc(i))*dp(i, k)/dp(i, kp1)
-          tmp1 = tmp1/dp(i, k)
-          tmp2 = gam(i, km1)*(sbh(i,k)-sc(i)+cldwtr(i)) - hbh(i, k) + hc(i) - &
-            sc(i) + sbh(i, k)
-          tmp3 = (1.0+gam(i,k))*(sc(i)-sbh(i,k))/dp(i, k)
-          tmp4 = (dt/cats)*(hc(i)-hbs(i,k))*tmp2/(dp(i,km1)*(hbs(i,km1)-hb(i, &
-            km1))) + tmp3
-          IF ((beta(i)*tmp4-tmp1)>0.0) THEN
-            betamx = ssfac*(tmp1/tmp4)
-            beta(i) = max(0.0, min(betamx,beta(i)))
+        IF (hb(i, km1)<hbs(i, km1)) THEN
+          tmp1 = (1.0 + gam(i, k)) * (sc(i) - sbh(i, kp1) + cldwtr(i)) - &
+                  (hbh(i, kp1) - hc(i)) * dp(i, k) / dp(i, kp1)
+          tmp1 = tmp1 / dp(i, k)
+          tmp2 = gam(i, km1) * (sbh(i, k) - sc(i) + cldwtr(i)) - hbh(i, k) + hc(i) - &
+                  sc(i) + sbh(i, k)
+          tmp3 = (1.0 + gam(i, k)) * (sc(i) - sbh(i, k)) / dp(i, k)
+          tmp4 = (dt / cats) * (hc(i) - hbs(i, k)) * tmp2 / (dp(i, km1) * (hbs(i, km1) - hb(i, &
+                  km1))) + tmp3
+          IF ((beta(i) * tmp4 - tmp1)>0.0) THEN
+            betamx = ssfac * (tmp1 / tmp4)
+            beta(i) = max(0.0, min(betamx, beta(i)))
           END IF
         ELSE
@@ -542,16 +542,16 @@
         ! so that the adjustment doesn't contribute to "kinks" in h
 
-        g = min(0.0, hb(i,k)-hb(i,km1))
-        tmp3 = (hb(i,k)-hb(i,km1)-g)*(cats/dt)/(hc(i)-hbs(i,k))
-        tmp1 = (1.0+gam(i,k))*(sc(i)-sbh(i,kp1)+cldwtr(i)) - &
-          (hbh(i,kp1)-hc(i))*dp(i, k)/dp(i, kp1)
-        tmp1 = tmp1/dp(i, k)
-        tmp1 = tmp3*tmp1 + (hc(i)-hbh(i,kp1))/dp(i, k)
-        tmp2 = tmp3*(1.0+gam(i,k))*(sc(i)-sbh(i,k))/dp(i, k) + &
-          (hc(i)-hbh(i,k)-cldwtr(i))*(1.0/dp(i,k)+1.0/dp(i,kp1))
-        IF ((beta(i)*tmp2-tmp1)>0.0) THEN
+        g = min(0.0, hb(i, k) - hb(i, km1))
+        tmp3 = (hb(i, k) - hb(i, km1) - g) * (cats / dt) / (hc(i) - hbs(i, k))
+        tmp1 = (1.0 + gam(i, k)) * (sc(i) - sbh(i, kp1) + cldwtr(i)) - &
+                (hbh(i, kp1) - hc(i)) * dp(i, k) / dp(i, kp1)
+        tmp1 = tmp1 / dp(i, k)
+        tmp1 = tmp3 * tmp1 + (hc(i) - hbh(i, kp1)) / dp(i, k)
+        tmp2 = tmp3 * (1.0 + gam(i, k)) * (sc(i) - sbh(i, k)) / dp(i, k) + &
+                (hc(i) - hbh(i, k) - cldwtr(i)) * (1.0 / dp(i, k) + 1.0 / dp(i, kp1))
+        IF ((beta(i) * tmp2 - tmp1)>0.0) THEN
           betamx = 0.0
-          IF (tmp2/=0.0) betamx = tmp1/tmp2
-          beta(i) = max(0.0, min(betamx,beta(i)))
+          IF (tmp2/=0.0) betamx = tmp1 / tmp2
+          beta(i) = max(0.0, min(betamx, beta(i)))
         END IF
       END IF
@@ -567,35 +567,35 @@
     ! physical states and adjust eta accordingly.
 
-20  CONTINUE
+    20  CONTINUE
     DO i = 1, klon
       IF (ldcum(i)) THEN
         beta(i) = max(0.0, beta(i))
         tmp1 = hc(i) - hbs(i, k)
-        tmp2 = ((1.0+gam(i,k))*(sc(i)-sbh(i,kp1)+cldwtr(i))-beta(i)*(1.0+gam( &
-          i,k))*(sc(i)-sbh(i,k)))/dp(i, k) - (hbh(i,kp1)-hc(i))/dp(i, kp1)
-        eta(i) = tmp1/(tmp2*rg*cats)
-        tmass = min(dp(i,k), dp(i,kp1))/rg
-        IF (eta(i)>tmass*rdt .OR. eta(i)<=0.0) eta(i) = 0.0
+        tmp2 = ((1.0 + gam(i, k)) * (sc(i) - sbh(i, kp1) + cldwtr(i)) - beta(i) * (1.0 + gam(&
+                i, k)) * (sc(i) - sbh(i, k))) / dp(i, k) - (hbh(i, kp1) - hc(i)) / dp(i, kp1)
+        eta(i) = tmp1 / (tmp2 * rg * cats)
+        tmass = min(dp(i, k), dp(i, kp1)) / rg
+        IF (eta(i)>tmass * rdt .OR. eta(i)<=0.0) eta(i) = 0.0
 
         ! Check on negative q in top layer (bound beta)
 
-        IF (shc(i)-shbh(i,k)<0.0 .AND. beta(i)*eta(i)/=0.0) THEN
-          denom = eta(i)*rg*dt*(shc(i)-shbh(i,k))/dp(i, km1)
-          beta(i) = max(0.0, min(-0.999*shb(i,km1)/denom,beta(i)))
+        IF (shc(i) - shbh(i, k)<0.0 .AND. beta(i) * eta(i)/=0.0) THEN
+          denom = eta(i) * rg * dt * (shc(i) - shbh(i, k)) / dp(i, km1)
+          beta(i) = max(0.0, min(-0.999 * shb(i, km1) / denom, beta(i)))
         END IF
 
         ! Check on negative q in middle layer (zero eta)
 
-        qtest1 = shb(i, k) + eta(i)*rg*dt*((shc(i)-shbh(i, &
-          kp1))-(1.0-beta(i))*cldwtr(i)/rlvtt-beta(i)*(shc(i)-shbh(i, &
-          k)))/dp(i, k)
+        qtest1 = shb(i, k) + eta(i) * rg * dt * ((shc(i) - shbh(i, &
+                kp1)) - (1.0 - beta(i)) * cldwtr(i) / rlvtt - beta(i) * (shc(i) - shbh(i, &
+                k))) / dp(i, k)
         IF (qtest1<=0.0) eta(i) = 0.0
 
         ! Check on negative q in lower layer (bound eta)
 
-        fac1 = -(shbh(i,kp1)-shc(i))/dp(i, kp1)
-        qtest2 = shb(i, kp1) - eta(i)*rg*dt*fac1
+        fac1 = -(shbh(i, kp1) - shc(i)) / dp(i, kp1)
+        qtest2 = shb(i, kp1) - eta(i) * rg * dt * fac1
         IF (qtest2<0.0) THEN
-          eta(i) = 0.99*shb(i, kp1)/(rg*dt*fac1)
+          eta(i) = 0.99 * shb(i, kp1) / (rg * dt * fac1)
         END IF
       END IF
@@ -607,34 +607,34 @@
     DO i = 1, klon
       IF (ldcum(i)) THEN
-        etagdt = eta(i)*rg*dt
-        cldwtr(i) = etagdt*cldwtr(i)/rlvtt/rg
-        rnwtr(i) = (1.0-beta(i))*cldwtr(i)
-        ds1(i) = etagdt*(sbh(i,kp1)-sc(i))/dp(i, kp1)
-        dq1(i) = etagdt*(shbh(i,kp1)-shc(i))/dp(i, kp1)
-        ds2(i) = (etagdt*(sc(i)-sbh(i,kp1))+rlvtt*rg*cldwtr(i)-beta(i)*etagdt &
-          *(sc(i)-sbh(i,k)))/dp(i, k)
-        dq2(i) = (etagdt*(shc(i)-shbh(i,kp1))-rg*rnwtr(i)-beta(i)*etagdt*(shc &
-          (i)-shbh(i,k)))/dp(i, k)
-        ds3(i) = beta(i)*(etagdt*(sc(i)-sbh(i,k))-rlvtt*rg*cldwtr(i))/dp(i, &
-          km1)
-        dq3(i) = beta(i)*etagdt*(shc(i)-shbh(i,k))/dp(i, km1)
+        etagdt = eta(i) * rg * dt
+        cldwtr(i) = etagdt * cldwtr(i) / rlvtt / rg
+        rnwtr(i) = (1.0 - beta(i)) * cldwtr(i)
+        ds1(i) = etagdt * (sbh(i, kp1) - sc(i)) / dp(i, kp1)
+        dq1(i) = etagdt * (shbh(i, kp1) - shc(i)) / dp(i, kp1)
+        ds2(i) = (etagdt * (sc(i) - sbh(i, kp1)) + rlvtt * rg * cldwtr(i) - beta(i) * etagdt &
+                * (sc(i) - sbh(i, k))) / dp(i, k)
+        dq2(i) = (etagdt * (shc(i) - shbh(i, kp1)) - rg * rnwtr(i) - beta(i) * etagdt * (shc &
+                (i) - shbh(i, k))) / dp(i, k)
+        ds3(i) = beta(i) * (etagdt * (sc(i) - sbh(i, k)) - rlvtt * rg * cldwtr(i)) / dp(i, &
+                km1)
+        dq3(i) = beta(i) * etagdt * (shc(i) - shbh(i, k)) / dp(i, km1)
 
         ! Isolate convective fluxes for later diagnostics
 
-        fslkp = eta(i)*(sc(i)-sbh(i,kp1))
-        fslkm = beta(i)*(eta(i)*(sc(i)-sbh(i,k))-rlvtt*cldwtr(i)*rdt)
-        fqlkp = eta(i)*(shc(i)-shbh(i,kp1))
-        fqlkm = beta(i)*eta(i)*(shc(i)-shbh(i,k))
+        fslkp = eta(i) * (sc(i) - sbh(i, kp1))
+        fslkm = beta(i) * (eta(i) * (sc(i) - sbh(i, k)) - rlvtt * cldwtr(i) * rdt)
+        fqlkp = eta(i) * (shc(i) - shbh(i, kp1))
+        fqlkm = beta(i) * eta(i) * (shc(i) - shbh(i, k))
 
 
         ! Update thermodynamic profile (update sb, hb, & hbs later)
 
-        tb(i, kp1) = tb(i, kp1) + ds1(i)/rcpd
-        tb(i, k) = tb(i, k) + ds2(i)/rcpd
-        tb(i, km1) = tb(i, km1) + ds3(i)/rcpd
+        tb(i, kp1) = tb(i, kp1) + ds1(i) / rcpd
+        tb(i, k) = tb(i, k) + ds2(i) / rcpd
+        tb(i, km1) = tb(i, km1) + ds3(i) / rcpd
         shb(i, kp1) = shb(i, kp1) + dq1(i)
         shb(i, k) = shb(i, k) + dq2(i)
         shb(i, km1) = shb(i, km1) + dq3(i)
-        prec(i) = prec(i) + rnwtr(i)/rhoh2o
+        prec(i) = prec(i) + rnwtr(i) / rhoh2o
 
         ! Update diagnostic information for final budget
@@ -643,18 +643,18 @@
         ! water static energy flux, and convective total water flux
 
-        cmfdt(i, kp1) = cmfdt(i, kp1) + ds1(i)/rcpd*rdt
-        cmfdt(i, k) = cmfdt(i, k) + ds2(i)/rcpd*rdt
-        cmfdt(i, km1) = cmfdt(i, km1) + ds3(i)/rcpd*rdt
-        cmfdq(i, kp1) = cmfdq(i, kp1) + dq1(i)*rdt
-        cmfdq(i, k) = cmfdq(i, k) + dq2(i)*rdt
-        cmfdq(i, km1) = cmfdq(i, km1) + dq3(i)*rdt
-        cmfdqr(i, k) = cmfdqr(i, k) + (rg*rnwtr(i)/dp(i,k))*rdt
+        cmfdt(i, kp1) = cmfdt(i, kp1) + ds1(i) / rcpd * rdt
+        cmfdt(i, k) = cmfdt(i, k) + ds2(i) / rcpd * rdt
+        cmfdt(i, km1) = cmfdt(i, km1) + ds3(i) / rcpd * rdt
+        cmfdq(i, kp1) = cmfdq(i, kp1) + dq1(i) * rdt
+        cmfdq(i, k) = cmfdq(i, k) + dq2(i) * rdt
+        cmfdq(i, km1) = cmfdq(i, km1) + dq3(i) * rdt
+        cmfdqr(i, k) = cmfdqr(i, k) + (rg * rnwtr(i) / dp(i, k)) * rdt
         cmfmc(i, kp1) = cmfmc(i, kp1) + eta(i)
-        cmfmc(i, k) = cmfmc(i, k) + beta(i)*eta(i)
+        cmfmc(i, k) = cmfmc(i, k) + beta(i) * eta(i)
         cmfsl(i, kp1) = cmfsl(i, kp1) + fslkp
         cmfsl(i, k) = cmfsl(i, k) + fslkm
-        cmflq(i, kp1) = cmflq(i, kp1) + rlvtt*fqlkp
-        cmflq(i, k) = cmflq(i, k) + rlvtt*fqlkm
-        qc(i, k) = (rg*rnwtr(i)/dp(i,k))*rdt
+        cmflq(i, kp1) = cmflq(i, kp1) + rlvtt * fqlkp
+        cmflq(i, k) = cmflq(i, k) + rlvtt * fqlkm
+        qc(i, k) = (rg * rnwtr(i) / dp(i, k)) * rdt
       END IF
     END DO
@@ -669,18 +669,18 @@
           ! the three adjacent levels, nothing will be done to the profile
 
-          IF ((cmrb(i,kp1,m)<0.0) .OR. (cmrb(i,k,m)<0.0) .OR. (cmrb(i,km1, &
-            m)<0.0)) GO TO 40
+          IF ((cmrb(i, kp1, m)<0.0) .OR. (cmrb(i, k, m)<0.0) .OR. (cmrb(i, km1, &
+                  m)<0.0)) GO TO 40
 
           ! Specify constituent interface values (linear interpolation)
 
-          cmrh(i, k) = 0.5*(cmrb(i,km1,m)+cmrb(i,k,m))
-          cmrh(i, kp1) = 0.5*(cmrb(i,k,m)+cmrb(i,kp1,m))
+          cmrh(i, k) = 0.5 * (cmrb(i, km1, m) + cmrb(i, k, m))
+          cmrh(i, kp1) = 0.5 * (cmrb(i, k, m) + cmrb(i, kp1, m))
 
           ! Specify perturbation properties of constituents in PBL
 
           pblhgt = max(pblh(i), 1.0)
-          IF (gz(i,kp1)/rg<=pblhgt .AND. dzcld(i)==0.) THEN
-            fac1 = max(0.0, 1.0-gz(i,kp1)/rg/pblhgt)
-            cmrc(i) = cmrb(i, kp1, m) + cmrp(i, m)*fac1
+          IF (gz(i, kp1) / rg<=pblhgt .AND. dzcld(i)==0.) THEN
+            fac1 = max(0.0, 1.0 - gz(i, kp1) / rg / pblhgt)
+            cmrc(i) = cmrb(i, kp1, m) + cmrp(i, m) * fac1
           ELSE
             cmrc(i) = cmrb(i, kp1, m)
@@ -692,36 +692,36 @@
           ! Tendency is modified (reduced) when pending disaster detected.
 
-          etagdt = eta(i)*rg*dt
-          botflx = etagdt*(cmrc(i)-cmrh(i,kp1))
-          topflx = beta(i)*etagdt*(cmrc(i)-cmrh(i,k))
-          dcmr1(i) = -botflx/dp(i, kp1)
+          etagdt = eta(i) * rg * dt
+          botflx = etagdt * (cmrc(i) - cmrh(i, kp1))
+          topflx = beta(i) * etagdt * (cmrc(i) - cmrh(i, k))
+          dcmr1(i) = -botflx / dp(i, kp1)
           efac1 = 1.0
           efac2 = 1.0
           efac3 = 1.0
 
-          IF (cmrb(i,kp1,m)+dcmr1(i)<0.0) THEN
-            efac1 = max(tiny, abs(cmrb(i,kp1,m)/dcmr1(i))-eps)
+          IF (cmrb(i, kp1, m) + dcmr1(i)<0.0) THEN
+            efac1 = max(tiny, abs(cmrb(i, kp1, m) / dcmr1(i)) - eps)
           END IF
 
           IF (efac1==tiny .OR. efac1>1.0) efac1 = 0.0
-          dcmr1(i) = -efac1*botflx/dp(i, kp1)
-          dcmr2(i) = (efac1*botflx-topflx)/dp(i, k)
-
-          IF (cmrb(i,k,m)+dcmr2(i)<0.0) THEN
-            efac2 = max(tiny, abs(cmrb(i,k,m)/dcmr2(i))-eps)
+          dcmr1(i) = -efac1 * botflx / dp(i, kp1)
+          dcmr2(i) = (efac1 * botflx - topflx) / dp(i, k)
+
+          IF (cmrb(i, k, m) + dcmr2(i)<0.0) THEN
+            efac2 = max(tiny, abs(cmrb(i, k, m) / dcmr2(i)) - eps)
           END IF
 
           IF (efac2==tiny .OR. efac2>1.0) efac2 = 0.0
-          dcmr2(i) = (efac1*botflx-efac2*topflx)/dp(i, k)
-          dcmr3(i) = efac2*topflx/dp(i, km1)
-
-          IF (cmrb(i,km1,m)+dcmr3(i)<0.0) THEN
-            efac3 = max(tiny, abs(cmrb(i,km1,m)/dcmr3(i))-eps)
+          dcmr2(i) = (efac1 * botflx - efac2 * topflx) / dp(i, k)
+          dcmr3(i) = efac2 * topflx / dp(i, km1)
+
+          IF (cmrb(i, km1, m) + dcmr3(i)<0.0) THEN
+            efac3 = max(tiny, abs(cmrb(i, km1, m) / dcmr3(i)) - eps)
           END IF
 
           IF (efac3==tiny .OR. efac3>1.0) efac3 = 0.0
           efac3 = min(efac2, efac3)
-          dcmr2(i) = (efac1*botflx-efac3*topflx)/dp(i, k)
-          dcmr3(i) = efac3*topflx/dp(i, km1)
+          dcmr2(i) = (efac1 * botflx - efac3 * topflx) / dp(i, k)
+          dcmr3(i) = efac3 * topflx / dp(i, km1)
 
           cmrb(i, kp1, m) = cmrb(i, kp1, m) + dcmr1(i)
@@ -729,8 +729,8 @@
           cmrb(i, km1, m) = cmrb(i, km1, m) + dcmr3(i)
         END IF
-40    END DO
+      40    END DO
     END DO ! end of m=1,pcnst loop
 
-    IF (k==limcnv+1) GO TO 60 ! on ne pourra plus glisser
+    IF (k==limcnv + 1) GO TO 60 ! on ne pourra plus glisser
 
     ! Dans la procedure de glissage ascendant, les variables thermo-
@@ -743,11 +743,11 @@
         zx_p = p(i, k)
         zx_q = shb(i, k)
-        zdelta = max(0., sign(1.,rtt-zx_t))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zx_q)
-        zx_qs = r2es*foeew(zx_t, zdelta)/zx_p
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + r5ies * rlstt * zdelta
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * zx_q)
+        zx_qs = r2es * foeew(zx_t, zdelta) / zx_p
         zx_qs = min(0.5, zx_qs)
-        zcor = 1./(1.-retv*zx_qs)
-        zx_qs = zx_qs*zcor
+        zcor = 1. / (1. - retv * zx_qs)
+        zx_qs = zx_qs * zcor
         zx_gam = foede(zx_t, zdelta, zcvm5, zx_qs, zcor)
         shbs(i, k) = zx_qs
@@ -757,11 +757,11 @@
         zx_p = p(i, km1)
         zx_q = shb(i, km1)
-        zdelta = max(0., sign(1.,rtt-zx_t))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zx_q)
-        zx_qs = r2es*foeew(zx_t, zdelta)/zx_p
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + r5ies * rlstt * zdelta
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * zx_q)
+        zx_qs = r2es * foeew(zx_t, zdelta) / zx_p
         zx_qs = min(0.5, zx_qs)
-        zcor = 1./(1.-retv*zx_qs)
-        zx_qs = zx_qs*zcor
+        zcor = 1. / (1. - retv * zx_qs)
+        zx_qs = zx_qs * zcor
         zx_gam = foede(zx_t, zdelta, zcvm5, zx_qs, zcor)
         shbs(i, km1) = zx_qs
@@ -770,16 +770,16 @@
         sb(i, k) = sb(i, k) + ds2(i)
         sb(i, km1) = sb(i, km1) + ds3(i)
-        hb(i, k) = sb(i, k) + rlvtt*shb(i, k)
-        hb(i, km1) = sb(i, km1) + rlvtt*shb(i, km1)
-        hbs(i, k) = sb(i, k) + rlvtt*shbs(i, k)
-        hbs(i, km1) = sb(i, km1) + rlvtt*shbs(i, km1)
-
-        sbh(i, k) = 0.5*(sb(i,k)+sb(i,km1))
-        shbh(i, k) = qhalf(shb(i,km1), shb(i,k), shbs(i,km1), shbs(i,k))
-        hbh(i, k) = sbh(i, k) + rlvtt*shbh(i, k)
-        sbh(i, km1) = 0.5*(sb(i,km1)+sb(i,k-2))
-        shbh(i, km1) = qhalf(shb(i,k-2), shb(i,km1), shbs(i,k-2), &
-          shbs(i,km1))
-        hbh(i, km1) = sbh(i, km1) + rlvtt*shbh(i, km1)
+        hb(i, k) = sb(i, k) + rlvtt * shb(i, k)
+        hb(i, km1) = sb(i, km1) + rlvtt * shb(i, km1)
+        hbs(i, k) = sb(i, k) + rlvtt * shbs(i, k)
+        hbs(i, km1) = sb(i, km1) + rlvtt * shbs(i, km1)
+
+        sbh(i, k) = 0.5 * (sb(i, k) + sb(i, km1))
+        shbh(i, k) = qhalf(shb(i, km1), shb(i, k), shbs(i, km1), shbs(i, k))
+        hbh(i, k) = sbh(i, k) + rlvtt * shbh(i, k)
+        sbh(i, km1) = 0.5 * (sb(i, km1) + sb(i, k - 2))
+        shbh(i, km1) = qhalf(shb(i, k - 2), shb(i, km1), shbs(i, k - 2), &
+                shbs(i, km1))
+        hbh(i, km1) = sbh(i, km1) + rlvtt * shbh(i, km1)
       END IF
     END DO
@@ -789,5 +789,5 @@
     ! top of convective layer determined by size of overshoot param.
 
-60  CONTINUE
+    60  CONTINUE
     DO i = 1, klon
       etagt0 = eta(i) > 0.0
@@ -803,13 +803,13 @@
       END IF
     END DO
-70 END DO ! end of k loop
+  70 END DO ! end of k loop
 
   ! determine whether precipitation, prec, is frozen (snow) or not
 
   DO i = 1, klon
-    IF (tb(i,klev)<tmelt .AND. tb(i,klev-1)<tmelt) THEN
-      cmfprs(i) = prec(i)*rdt
+    IF (tb(i, klev)<tmelt .AND. tb(i, klev - 1)<tmelt) THEN
+      cmfprs(i) = prec(i) * rdt
     ELSE
-      cmfprt(i) = prec(i)*rdt
+      cmfprt(i) = prec(i) * rdt
     END IF
   END DO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90	(revision 5143)
@@ -1,32 +1,31 @@
 SUBROUTINE concvl(iflag_clos, &
-                  dtime, paprs, pplay, k_upper_cv, &
-                  t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
-                  Ale, Alp, sig1, w01, &
-                  d_t, d_q, d_qcomp, d_u, d_v, d_tra, &
-                  rain, snow, kbas, ktop, sigd, &
-                  cbmf, plcl, plfc, wbeff, convoccur, &
-                  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, phii, d1a, dam, sij, qta, clw, elij, &! RomP
-                  dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
-                  evap, ep, epmlmMm, eplaMm, &                       ! RomP
-                  wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
-                  tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
-!RomP <<<
-                  epmax_diag) ! epmax_cape
-! **************************************************************
-! *
-! CONCVL                                                      *
-! *
-! *
-! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
-! modified by :                                               *
-! **************************************************************
-
+        dtime, paprs, pplay, k_upper_cv, &
+        t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
+        Ale, Alp, sig1, w01, &
+        d_t, d_q, d_qcomp, d_u, d_v, d_tra, &
+        rain, snow, kbas, ktop, sigd, &
+        cbmf, plcl, plfc, wbeff, convoccur, &
+        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, phii, d1a, dam, sij, qta, clw, elij, &! RomP
+        dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
+        evap, ep, epmlmMm, eplaMm, &                       ! RomP
+        wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
+        tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
+        !RomP <<<
+        epmax_diag) ! epmax_cape
+  ! **************************************************************
+  ! *
+  ! CONCVL                                                      *
+  ! *
+  ! *
+  ! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
+  ! modified by :                                               *
+  ! **************************************************************
 
   USE dimphy
@@ -36,170 +35,172 @@
   USE lmdz_clesphys
   USE lmdz_conema3
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   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 total precipitation (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
-! wdtrainS---output-R
-! wdtrainM---output-R
-! wght-------output-R
-! ======================================================================
-
-  INTEGER, INTENT(IN)                           :: iflag_clos
-  REAL, INTENT(IN)                              :: dtime
-  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: pplay
-  REAL, DIMENSION(klon,klev+1), INTENT(IN)      :: paprs
-  INTEGER,                      INTENT(IN)      :: k_upper_cv
-  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: t, q, u, v
-  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: t_wake, q_wake
-  REAL, DIMENSION(klon),        INTENT(IN)      :: s_wake
-  REAL, DIMENSION(klon,klev, nbtr),INTENT(IN)   :: tra
-  INTEGER,                      INTENT(IN)      :: ntra
-  REAL, DIMENSION(klon),        INTENT(IN)      :: Ale, Alp
-!CR:test: on passe lentr et alim_star des thermiques
-  INTEGER, DIMENSION(klon),     INTENT(IN)      :: lalim_conv
-  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: wght_th
-
-  REAL, DIMENSION(klon,klev),   INTENT(INOUT)   :: sig1, w01
-
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d_t, d_q, d_qcomp, d_u, d_v
-  REAL, DIMENSION(klon,klev, nbtr),INTENT(OUT)  :: d_tra
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: rain, snow
-
-  INTEGER, DIMENSION(klon),     INTENT(OUT)     :: kbas, ktop
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: sigd
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: cbmf, plcl, plfc, wbeff
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: convoccur
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: upwd, dnwd, dnwdbis
-
-!!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)                    !jyg
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: Ma, mip 
-  REAL, DIMENSION(klon,klev+1), INTENT(OUT)     :: Vprecip                        !jyg
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: cape, cin
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: tvp
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: Tconv
-  INTEGER, DIMENSION(klon),     INTENT(OUT)     :: iflag
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: pbase, bbase
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: dtvpdt1, dtvpdq1
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: dplcldt, dplcldr
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: qcondc
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: wd
-  REAL, DIMENSION(klon,klev+1), INTENT(OUT)     :: pmflxr, pmflxs
-
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: da, mp
-  REAL, DIMENSION(klon,klev,klev),INTENT(OUT)   :: phi
-! RomP >>>
-  REAL, DIMENSION(klon,klev,klev),INTENT(OUT)   :: phii
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d1a, dam
-  REAL, DIMENSION(klon,klev,klev),INTENT(OUT)   :: sij, elij
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: qta
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: clw
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: dd_t, dd_q
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: evap, ep
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: eplaMm
-  REAL, DIMENSION(klon,klev,klev), INTENT(OUT)  :: epmlmMm
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: wdtrainA, wdtrainS, wdtrainM
-! RomP <<<
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: wght                       !RL
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: qtc
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: sigt, detrain
-  REAL,                         INTENT(OUT)     :: tau_cld_cv, coefw_cld_cv
-  REAL, DIMENSION(klon),        INTENT(OUT)     :: epmax_diag                ! epmax_cape
-
-!  Local
-!  ----
-  REAL, DIMENSION(klon,klev)                    :: em_p
-  REAL, DIMENSION(klon,klev+1)                  :: em_ph
-  REAL                                          :: em_sig1feed ! sigma at lower bound of feeding layer
-  REAL                                          :: em_sig2feed ! sigma at upper bound of feeding layer
-  REAL, DIMENSION(klev)                         :: em_wght ! weight density determining the feeding mixture
-  REAL, DIMENSION(klon,klev+1)                  :: Vprecipi                       !jyg
-!on enleve le save
-! SAVE em_sig1feed,em_sig2feed,em_wght
-
-  REAL, DIMENSION(klon)                         :: rflag
-  REAL, DIMENSION(klon)                         :: plim1, plim2
-  REAL, DIMENSION(klon)                         :: ptop2
-  REAL, DIMENSION(klon,klev)                    :: asupmax
-  REAL, DIMENSION(klon)                         :: supmax0, asupmaxmin
-  REAL                                          :: zx_t, zdelta, zx_qs, zcor
-
-!   INTEGER iflag_mix
-!   SAVE iflag_mix
-  INTEGER                                       :: noff, minorig
-  INTEGER                                       :: i,j, k, itra
-  REAL, DIMENSION(klon,klev)                    :: qs, qs_wake
-!LF          SAVE cbmf
-!IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
-!!!$OMP THREADPRIVATE(cbmf)!
-  REAL, DIMENSION(klon)                         :: cbmflast
-
-
-! 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./
+  ! ======================================================================
+  ! 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 total precipitation (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
+  ! wdtrainS---output-R
+  ! wdtrainM---output-R
+  ! wght-------output-R
+  ! ======================================================================
+
+  INTEGER, INTENT(IN) :: iflag_clos
+  REAL, INTENT(IN) :: dtime
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay
+  REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
+  INTEGER, INTENT(IN) :: k_upper_cv
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: t, q, u, v
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: t_wake, q_wake
+  REAL, DIMENSION(klon), INTENT(IN) :: s_wake
+  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tra
+  INTEGER, INTENT(IN) :: ntra
+  REAL, DIMENSION(klon), INTENT(IN) :: Ale, Alp
+  !CR:test: on passe lentr et alim_star des thermiques
+  INTEGER, DIMENSION(klon), INTENT(IN) :: lalim_conv
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: wght_th
+
+  REAL, DIMENSION(klon, klev), INTENT(INOUT) :: sig1, w01
+
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t, d_q, d_qcomp, d_u, d_v
+  REAL, DIMENSION(klon, klev, nbtr), INTENT(OUT) :: d_tra
+  REAL, DIMENSION(klon), INTENT(OUT) :: rain, snow
+
+  INTEGER, DIMENSION(klon), INTENT(OUT) :: kbas, ktop
+  REAL, DIMENSION(klon), INTENT(OUT) :: sigd
+  REAL, DIMENSION(klon), INTENT(OUT) :: cbmf, plcl, plfc, wbeff
+  REAL, DIMENSION(klon), INTENT(OUT) :: convoccur
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: upwd, dnwd, dnwdbis
+
+  !!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)                    !jyg
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: Ma, mip
+  REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: Vprecip                        !jyg
+  REAL, DIMENSION(klon), INTENT(OUT) :: cape, cin
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: tvp
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: Tconv
+  INTEGER, DIMENSION(klon), INTENT(OUT) :: iflag
+  REAL, DIMENSION(klon), INTENT(OUT) :: pbase, bbase
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: dtvpdt1, dtvpdq1
+  REAL, DIMENSION(klon), INTENT(OUT) :: dplcldt, dplcldr
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcondc
+  REAL, DIMENSION(klon), INTENT(OUT) :: wd
+  REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: pmflxr, pmflxs
+
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: da, mp
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phi
+  ! RomP >>>
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phii
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d1a, dam
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: sij, elij
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qta
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: clw
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: dd_t, dd_q
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: evap, ep
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: eplaMm
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: epmlmMm
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: wdtrainA, wdtrainS, wdtrainM
+  ! RomP <<<
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: wght                       !RL
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qtc
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: sigt, detrain
+  REAL, INTENT(OUT) :: tau_cld_cv, coefw_cld_cv
+  REAL, DIMENSION(klon), INTENT(OUT) :: epmax_diag                ! epmax_cape
+
+  !  Local
+  !  ----
+  REAL, DIMENSION(klon, klev) :: em_p
+  REAL, DIMENSION(klon, klev + 1) :: em_ph
+  REAL :: em_sig1feed ! sigma at lower bound of feeding layer
+  REAL :: em_sig2feed ! sigma at upper bound of feeding layer
+  REAL, DIMENSION(klev) :: em_wght ! weight density determining the feeding mixture
+  REAL, DIMENSION(klon, klev + 1) :: Vprecipi                       !jyg
+  !on enleve le save
+  ! SAVE em_sig1feed,em_sig2feed,em_wght
+
+  REAL, DIMENSION(klon) :: rflag
+  REAL, DIMENSION(klon) :: plim1, plim2
+  REAL, DIMENSION(klon) :: ptop2
+  REAL, DIMENSION(klon, klev) :: asupmax
+  REAL, DIMENSION(klon) :: supmax0, asupmaxmin
+  REAL :: zx_t, zdelta, zx_qs, zcor
+
+  !   INTEGER iflag_mix
+  !   SAVE iflag_mix
+  INTEGER :: noff, minorig
+  INTEGER :: i, j, k, itra
+  REAL, DIMENSION(klon, klev) :: qs, qs_wake
+  !LF          SAVE cbmf
+  !IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
+  !!!$OMP THREADPRIVATE(cbmf)!
+  REAL, DIMENSION(klon) :: cbmflast
+
+
+  ! 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
+          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)
+          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)
+  !$OMP THREADPRIVATE(d_h_vcol_phy)
   REAL        zero_v(klon)
   CHARACTER *15 ztit
@@ -207,43 +208,40 @@
   SAVE        ip_ebil
   DATA        ip_ebil/2/
-!$OMP THREADPRIVATE(ip_ebil)
+  !$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
+  !$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"
   include "YOMCST2.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
 
   IF (first) THEN
-! Allocate some variables LF 04/2008
-
-!IM/JYG allocate(cbmf(klon))
-    ALLOCATE (ql(klon,klev))
-    ALLOCATE (t1(klon,klev))
-    ALLOCATE (q1(klon,klev))
+    ! Allocate some variables LF 04/2008
+
+    !IM/JYG allocate(cbmf(klon))
+    ALLOCATE (ql(klon, klev))
+    ALLOCATE (t1(klon, klev))
+    ALLOCATE (q1(klon, klev))
 
     convoccur(:) = 0.
 
     itap = 0
-    igout = klon/2 + 1/klon
+    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
@@ -262,5 +260,5 @@
   END IF
 
-! ym
+  ! ym
   snow(:) = 0
 
@@ -268,36 +266,36 @@
     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)
+    ! ===========================================================================
+    ! 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
-! ===========================================================================
+    ! ===========================================================================
+    ! 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 !(first)
 
-! Initialisation a chaque pas de temps
+  ! Initialisation a chaque pas de temps
   plfc(:) = 0.
   wbeff(:) = 100.
@@ -306,5 +304,5 @@
   DO k = 1, klev + 1
     DO i = 1, klon
-      em_ph(i, k) = paprs(i, k)/100.0
+      em_ph(i, k) = paprs(i, k) / 100.0
       pmflxr(i, k) = 0.
       pmflxs(i, k) = 0.
@@ -314,28 +312,28 @@
   DO k = 1, klev
     DO i = 1, klon
-      em_p(i, k) = pplay(i, k)/100.0
-    END DO
-  END DO
-
-
-! Feeding layer
+      em_p(i, k) = pplay(i, k) / 100.0
+    END DO
+  END DO
+
+
+  ! Feeding layer
 
   em_sig1feed = 1.
-!jyg<
-!  em_sig2feed = 0.97
+  !jyg<
+  !  em_sig2feed = 0.97
   em_sig2feed = cvl_sig2feed
-!>jyg
-! em_sig2feed = 0.8
-! Relative Weight densities
+  !>jyg
+  ! 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
@@ -343,15 +341,15 @@
       DO i = 1, klon
         zx_t = t(i, k)
-        zdelta = max(0., sign(1.,rtt-zx_t))
-        zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
-        zcor = 1./(1.-retv*zx_qs)
-        qs(i, k) = zx_qs*zcor
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0)
+        zcor = 1. / (1. - retv * zx_qs)
+        qs(i, k) = zx_qs * zcor
       END DO
       DO i = 1, klon
         zx_t = t_wake(i, k)
-        zdelta = max(0., sign(1.,rtt-zx_t))
-        zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
-        zcor = 1./(1.-retv*zx_qs)
-        qs_wake(i, k) = zx_qs*zcor
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0)
+        zcor = 1. / (1. - retv * zx_qs)
+        qs_wake(i, k) = zx_qs * zcor
       END DO
     END DO
@@ -360,18 +358,18 @@
       DO i = 1, klon
         zx_t = t(i, k)
-        zdelta = max(0., sign(1.,rtt-zx_t))
-        zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0
         zx_qs = min(0.5, zx_qs)
-        zcor = 1./(1.-retv*zx_qs)
-        zx_qs = zx_qs*zcor
+        zcor = 1. / (1. - retv * zx_qs)
+        zx_qs = zx_qs * zcor
         qs(i, k) = zx_qs
       END DO
       DO i = 1, klon
         zx_t = t_wake(i, k)
-        zdelta = max(0., sign(1.,rtt-zx_t))
-        zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0
         zx_qs = min(0.5, zx_qs)
-        zcor = 1./(1.-retv*zx_qs)
-        zx_qs = zx_qs*zcor
+        zcor = 1. / (1. - retv * zx_qs)
+        zx_qs = zx_qs * zcor
         qs_wake(i, k) = zx_qs
       END DO
@@ -379,27 +377,26 @@
   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
+    ! 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, phii, d1a, dam, sij, clw, elij, &       !RomP
-                   evap, ep, epmlmMm, eplaMm, &                         !RomP
-                   wdtrainA, wdtrainM, &                                !RomP
-                   epmax_diag) ! epmax_cape
-!           print *, 'cv_driver ->'      !jyg
+            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, phii, d1a, dam, sij, clw, elij, &       !RomP
+            evap, ep, epmlmMm, eplaMm, &                         !RomP
+            wdtrainA, wdtrainM, &                                !RomP
+            epmax_diag) ! epmax_cape
+    !           print *, 'cv_driver ->'      !jyg
 
     DO i = 1, klon
@@ -407,44 +404,44 @@
     END DO
 
-!RL
+    !RL
     wght(:, :) = 0.
     DO i = 1, klon
       wght(i, 1) = 1.
     END DO
-!RL
+    !RL
 
   ELSE
 
-!LF   necessary for gathered fields
+    !LF   necessary for gathered fields
     nloc = klon
-    CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
-                    iflag_con, iflag_mix, iflag_ice_thermo, &
-                    iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
-                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
-                    em_p, em_ph, &
-                    Ale, Alp, omega, &
-                    em_sig1feed, em_sig2feed, em_wght, &
-                    iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, &
-                    cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
-                    Ma, mip, Vprecip, Vprecipi, 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,phii,d1a,dam,sij,clw,elij, &               ! RomP
-!!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
-                    da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
-                    qta, clw, elij, evap, ep, epmlmMm, eplaMm, &        ! RomP+RL
-                    wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, &
-                    tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
-!AC!+!RomP+jyg
-                    epmax_diag) ! epmax_cape
+    CALL cva_driver(klon, klev, klev + 1, ntra, nloc, k_upper_cv, &
+            iflag_con, iflag_mix, iflag_ice_thermo, &
+            iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
+            t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
+            em_p, em_ph, &
+            Ale, Alp, omega, &
+            em_sig1feed, em_sig2feed, em_wght, &
+            iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, &
+            cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
+            Ma, mip, Vprecip, Vprecipi, 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,phii,d1a,dam,sij,clw,elij, &               ! RomP
+            !!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
+            da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
+            qta, clw, elij, evap, ep, epmlmMm, eplaMm, &        ! RomP+RL
+            wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, &
+            tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
+            !AC!+!RomP+jyg
+            epmax_diag) ! epmax_cape
   END IF
-! ------------------------------------------------------------------
+  ! ------------------------------------------------------------------
   IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff, d_t, d_q ', &
-                                         cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1,1), d_q(1,1)
+          cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1, 1), d_q(1, 1)
 
   DO i = 1, klon
-    rain(i) = rain(i)/86400.
+    rain(i) = rain(i) / 86400.
     rflag(i) = iflag(i)
   END DO
@@ -452,16 +449,16 @@
   DO k = 1, klev
     DO i = 1, klon
-      d_t(i, k) = dtime*d_t(i, k)
-      d_q(i, k) = dtime*d_q(i, k)
-      d_u(i, k) = dtime*d_u(i, k)
-      d_v(i, k) = dtime*d_v(i, k)
+      d_t(i, k) = dtime * d_t(i, k)
+      d_q(i, k) = dtime * d_q(i, k)
+      d_u(i, k) = dtime * d_u(i, k)
+      d_v(i, k) = dtime * d_v(i, k)
     END DO
   END DO
 
   IF (iflag_con==3) THEN
-    DO i = 1,klon
+    DO i = 1, klon
       IF (wbeff(i) > 100. .OR. wbeff(i) == 0 .OR. iflag(i) > 3) THEN
         wbeff(i) = 0.
-        convoccur(i) = 0.  
+        convoccur(i) = 0.
       ELSE
         convoccur(i) = 1.
@@ -474,5 +471,5 @@
       DO k = 1, klev
         DO i = 1, klon
-!RL!            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
@@ -481,10 +478,10 @@
   END IF
 
-!!AC!
+  !!AC!
   IF (iflag_con==3) THEN
     DO itra = 1, ntra
       DO k = 1, klev
         DO i = 1, klon
-!RL!            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
@@ -492,5 +489,5 @@
     END DO
   END IF
-!!AC!
+  !!AC!
 
   DO k = 1, klev
@@ -500,10 +497,10 @@
     END DO
   END DO
-!                                                     !jyg
+  !                                                     !jyg
   IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN
-! --Separation neige/pluie (pour diagnostics)         !jyg
+    ! --Separation neige/pluie (pour diagnostics)         !jyg
     DO k = 1, klev                                    !jyg
       DO i = 1, klon                                  !jyg
-        IF (t1(i,k)<rtt) THEN                         !jyg
+        IF (t1(i, k)<rtt) THEN                         !jyg
           pmflxs(i, k) = Vprecip(i, k)                !jyg
         ELSE                                          !jyg
@@ -516,23 +513,23 @@
       DO i = 1, klon                                  !jyg
         pmflxs(i, k) = Vprecipi(i, k)                 !jyg
-        pmflxr(i, k) = Vprecip(i, k)-Vprecipi(i, k)   !jyg
+        pmflxr(i, k) = Vprecip(i, k) - Vprecipi(i, k)   !jyg
       END DO                                          !jyg
     END DO                                            !jyg
   ENDIF
 
-! 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:
+  ! 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
@@ -544,5 +541,5 @@
     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
@@ -559,29 +556,28 @@
   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
 
-
 END SUBROUTINE concvl
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90	(revision 5143)
@@ -1,12 +1,13 @@
-
 ! $Header$
 
 SUBROUTINE conemav(dtime, paprs, pplay, t, q, u, v, tra, ntra, work1, work2, &
-    d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwdbis, &
-    ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr)
-
+        d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwdbis, &
+        ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr)
 
   USE dimphy
   USE infotrac_phy, ONLY: nbtr
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -42,6 +43,5 @@
   ! ======================================================================
 
-
-  REAL dtime, paprs(klon, klev+1), pplay(klon, klev)
+  REAL dtime, paprs(klon, klev + 1), pplay(klon, klev)
   REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
   REAL tra(klon, klev, nbtr)
@@ -54,5 +54,5 @@
 
   INTEGER kbas(klon), ktop(klon)
-  REAL em_ph(klon, klev+1), em_p(klon, klev)
+  REAL em_ph(klon, klev + 1), em_p(klon, klev)
   REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
   REAL ma(klon, klev), cape(klon), tvp(klon, klev)
@@ -75,7 +75,4 @@
   !$OMP THREADPRIVATE(ifrst)
   include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
 
   IF (ifrst==0) THEN
@@ -89,5 +86,5 @@
   DO k = 1, klev + 1
     DO i = 1, klon
-      em_ph(i, k) = paprs(i, k)/100.0
+      em_ph(i, k) = paprs(i, k) / 100.0
     END DO
   END DO
@@ -95,16 +92,15 @@
   DO k = 1, klev
     DO i = 1, klon
-      em_p(i, k) = pplay(i, k)/100.0
+      em_p(i, k) = pplay(i, k) / 100.0
     END DO
   END DO
-
 
   DO k = 1, klev
     DO i = 1, klon
       zx_t = t(i, k)
-      zdelta = max(0., sign(1.,rtt-zx_t))
-      zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
-      zcor = 1./(1.-retv*zx_qs)
-      qs(i, k) = zx_qs*zcor
+      zdelta = max(0., sign(1., rtt - zx_t))
+      zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0)
+      zcor = 1. / (1. - retv * zx_qs)
+      qs(i, k) = zx_qs * zcor
     END DO
   END DO
@@ -112,9 +108,9 @@
   noff = 2
   minorig = 2
-  CALL convect1(klon, klev, klev+1, noff, minorig, t, q, qs, u, v, em_p, &
-    em_ph, iflag, d_t, d_q, d_u, d_v, rain, cbmf, dtime, ma)
+  CALL convect1(klon, klev, klev + 1, noff, minorig, t, q, qs, u, v, em_p, &
+          em_ph, iflag, d_t, d_q, d_u, d_v, rain, cbmf, dtime, ma)
 
   DO i = 1, klon
-    rain(i) = rain(i)/86400.
+    rain(i) = rain(i) / 86400.
     rflag(i) = iflag(i)
   END DO
@@ -127,8 +123,8 @@
   DO k = 1, klev
     DO i = 1, klon
-      d_t(i, k) = dtime*d_t(i, k)
-      d_q(i, k) = dtime*d_q(i, k)
-      d_u(i, k) = dtime*d_u(i, k)
-      d_v(i, k) = dtime*d_v(i, k)
+      d_t(i, k) = dtime * d_t(i, k)
+      d_q(i, k) = dtime * d_q(i, k)
+      d_u(i, k) = dtime * d_u(i, k)
+      d_v(i, k) = dtime * d_v(i, k)
     END DO
     DO itra = 1, ntra
@@ -139,8 +135,4 @@
   END DO
 
-
-
-
-
 END SUBROUTINE conemav
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5143)
@@ -43,10 +43,9 @@
     USE lmdz_comsoil, ONLY: inertie_sol, inertie_sno, inertie_sic, inertie_lic, iflag_sic, iflag_inertie
     USE lmdz_conema3
+    USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
 
     INCLUDE "YOMCST.h"
     INCLUDE "YOMCST2.h"
-
-    !IM : on inclut/initialise les taux de CH4, N2O, CFC11 et CFC12
-    INCLUDE "YOEGWD.h"
 
     ! Configuration de la "physique" de LMDZ a l'aide de la fonction
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conflx.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conflx.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conflx.F90	(revision 5143)
@@ -6,4 +6,7 @@
 
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -16,5 +19,4 @@
   ! ======================================================================
   include "YOMCST.h"
-  include "YOETHF.h"
   ! Entree:
   REAL dtime ! pas d'integration (s)
@@ -71,6 +73,4 @@
   REAL zdelta, zqsat
 
-  include "FCTTRE.h"
-
   ! initialiser les variables de sortie (pour securite)
   DO i = 1, klon
@@ -204,9 +204,9 @@
   USE dimphy
   USE lmdz_YOECUMF
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
   ! ------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
   ! ----------------------------------------------------------------
   REAL pten(klon, klev), pqen(klon, klev), pqsen(klon, klev)
@@ -477,4 +477,6 @@
         pdmfup, pdpmel, plu, plude, klab, pen_u, pde_u, pen_d, pde_d)
   USE dimphy
+  USE lmdz_YOETHF
+
   IMPLICIT NONE
   ! ----------------------------------------------------------------------
@@ -484,5 +486,4 @@
   ! ----------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
 
   REAL pten(klon, klev) ! temperature (environnement)
@@ -598,4 +599,6 @@
         klab)
   USE dimphy
+  USE lmdz_YOETHF
+
   IMPLICIT NONE
   ! ----------------------------------------------------------------------
@@ -611,5 +614,4 @@
   ! ----------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
   ! ----------------------------------------------------------------
   REAL ptenh(klon, klev), pqenh(klon, klev)
@@ -680,4 +682,5 @@
   USE dimphy
   USE lmdz_YOECUMF
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
@@ -687,5 +690,4 @@
   ! ----------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
 
   REAL pdtime
@@ -981,4 +983,6 @@
   USE lmdz_print_control, ONLY: prt_level
   USE lmdz_YOECUMF
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   IMPLICIT NONE
@@ -988,5 +992,4 @@
   ! ----------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
 
   REAL cevapcu(klon, klev)
@@ -1021,6 +1024,4 @@
   LOGICAL lddraf(klon)
   INTEGER kdtop(klon)
-
-  include "FCTTRE.h"
 
   DO k = 1, klev
@@ -1224,4 +1225,5 @@
   USE dimphy
   USE lmdz_YOECUMF
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
@@ -1230,5 +1232,4 @@
   ! ----------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
   ! -----------------------------------------------------------------
   LOGICAL llo1
@@ -1286,4 +1287,5 @@
   USE dimphy
   USE lmdz_YOECUMF
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
@@ -1305,5 +1307,4 @@
   ! ----------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
 
   REAL ptenh(klon, klev)
@@ -1393,4 +1394,5 @@
   USE dimphy
   USE lmdz_YOECUMF
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
@@ -1412,5 +1414,4 @@
   ! ----------------------------------------------------------------------
   include "YOMCST.h"
-  include "YOETHF.h"
 
   REAL ptenh(klon, klev), pqenh(klon, klev)
@@ -1506,4 +1507,7 @@
 SUBROUTINE flxadjtq(pp, pt, pq, ldflag, kcall)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -1525,6 +1529,4 @@
   REAL zdelta, zcvm5, zldcp, zqsat, zcor
   INTEGER is, i
-  include "YOETHF.h"
-  include "FCTTRE.h"
 
   z5alvcp = r5les * rlvtt / rcpd
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conlmd.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conlmd.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conlmd.F90	(revision 5143)
@@ -1,8 +1,9 @@
-
 ! $Header$
 
 SUBROUTINE conlmd(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, rain, snow, &
-    ibas, itop)
+        ibas, itop)
   USE dimphy
+  USE lmdz_YOETHF
+
   IMPLICIT NONE
   ! ======================================================================
@@ -12,10 +13,9 @@
   ! ======================================================================
   include "YOMCST.h"
-  include "YOETHF.h"
 
   ! Arguments:
 
   REAL dtime ! pas d'integration (s)
-  REAL paprs(klon, klev+1) ! pression inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
   REAL t(klon, klev) ! temperature (K)
@@ -31,5 +31,5 @@
 
   LOGICAL usekuo ! utiliser convection profonde (schema Kuo)
-  PARAMETER (usekuo=.TRUE.)
+  PARAMETER (usekuo = .TRUE.)
 
   REAL d_t_bis(klon, klev)
@@ -47,13 +47,13 @@
   ! cc      CALL fiajh ! ancienne version de Convection Manabe
   CALL conman &                    ! nouvelle version de Convection
-                                   ! Manabe
-    (dtime, paprs, pplay, t, q, d_t, d_q, d_ql, rneb, rain, snow, ibas, itop)
+          ! Manabe
+          (dtime, paprs, pplay, t, q, d_t, d_q, d_ql, rneb, rain, snow, ibas, itop)
 
   IF (usekuo) THEN
     ! cc      CALL fiajc ! ancienne version de Convection Kuo
     CALL conkuo &                  ! nouvelle version de Convection
-                                   ! Kuo
-      (dtime, paprs, pplay, t, q, conv_q, d_t_bis, d_q_bis, d_ql_bis, &
-      rneb_bis, rain_bis, snow_bis, ibas_bis, itop_bis)
+            ! Kuo
+            (dtime, paprs, pplay, t, q, conv_q, d_t_bis, d_q_bis, d_ql_bis, &
+            rneb_bis, rain_bis, snow_bis, ibas_bis, itop_bis)
     DO k = 1, klev
       DO i = 1, klon
@@ -75,10 +75,10 @@
   DO k = 1, klev
     DO i = 1, klon
-      zlvdcp = rlvtt/rcpd/(1.0+rvtmp2*q(i,k))
-      zlsdcp = rlstt/rcpd/(1.0+rvtmp2*q(i,k))
-      zdelta = max(0., sign(1.,rtt-t(i,k)))
+      zlvdcp = rlvtt / rcpd / (1.0 + rvtmp2 * q(i, k))
+      zlsdcp = rlstt / rcpd / (1.0 + rvtmp2 * q(i, k))
+      zdelta = max(0., sign(1., rtt - t(i, k)))
       zz = d_ql(i, k) ! re-evap. de l'eau liquide
       zb = max(0.0, zz)
-      za = -max(0.0, zz)*(zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
+      za = -max(0.0, zz) * (zlvdcp * (1. - zdelta) + zlsdcp * zdelta)
       d_t(i, k) = d_t(i, k) + za
       d_q(i, k) = d_q(i, k) + zb
@@ -86,9 +86,11 @@
   END DO
 
-
 END SUBROUTINE conlmd
 SUBROUTINE conman(dtime, paprs, pplay, t, q, d_t, d_q, d_ql, rneb, rain, &
-    snow, ibas, itop)
+        snow, ibas, itop)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -108,5 +110,5 @@
   REAL t(klon, klev) ! temperature (K)
   REAL q(klon, klev) ! humidite specifique (kg/kg)
-  REAL paprs(klon, klev+1) ! pression inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
 
@@ -124,9 +126,9 @@
 
   INTEGER nb ! nombre de sous-fractions a considere
-  PARAMETER (nb=1)
+  PARAMETER (nb = 1)
   ! cc      PARAMETER (nb=3)
 
   REAL ratqs ! largeur de la distribution pour vapeur d'eau
-  PARAMETER (ratqs=0.05)
+  PARAMETER (ratqs = 0.05)
 
   REAL w_q(klon, klev)
@@ -139,5 +141,5 @@
 
   REAL t_coup
-  PARAMETER (t_coup=234.0)
+  PARAMETER (t_coup = 234.0)
   REAL zdp1, zdp2
   REAL zqs1, zqs2, zdqs1, zdqs2
@@ -163,7 +165,4 @@
   ! Fonctions thermodynamiques:
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
   DATA frac/1.0/
   DATA opt_cld/4/
@@ -207,43 +206,43 @@
     DO i = 1, klon
       IF (thermcep) THEN
-        zdelta = max(0., sign(1.,rtt-t(i,k)))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*q(i,k))
-        zqs1 = r2es*foeew(t(i,k), zdelta)/pplay(i, k)
+        zdelta = max(0., sign(1., rtt - t(i, k)))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * q(i, k))
+        zqs1 = r2es * foeew(t(i, k), zdelta) / pplay(i, k)
         zqs1 = min(0.5, zqs1)
-        zcor = 1./(1.-retv*zqs1)
-        zqs1 = zqs1*zcor
-        zdqs1 = foede(t(i,k), zdelta, zcvm5, zqs1, zcor)
-
-        zdelta = max(0., sign(1.,rtt-t(i,k+1)))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*q(i,k+1))
-        zqs2 = r2es*foeew(t(i,k+1), zdelta)/pplay(i, k+1)
+        zcor = 1. / (1. - retv * zqs1)
+        zqs1 = zqs1 * zcor
+        zdqs1 = foede(t(i, k), zdelta, zcvm5, zqs1, zcor)
+
+        zdelta = max(0., sign(1., rtt - t(i, k + 1)))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * q(i, k + 1))
+        zqs2 = r2es * foeew(t(i, k + 1), zdelta) / pplay(i, k + 1)
         zqs2 = min(0.5, zqs2)
-        zcor = 1./(1.-retv*zqs2)
-        zqs2 = zqs2*zcor
-        zdqs2 = foede(t(i,k+1), zdelta, zcvm5, zqs2, zcor)
+        zcor = 1. / (1. - retv * zqs2)
+        zqs2 = zqs2 * zcor
+        zdqs2 = foede(t(i, k + 1), zdelta, zcvm5, zqs2, zcor)
       ELSE
-        IF (t(i,k)<t_coup) THEN
-          zqs1 = qsats(t(i,k))/pplay(i, k)
-          zdqs1 = dqsats(t(i,k), zqs1)
-
-          zqs2 = qsats(t(i,k+1))/pplay(i, k+1)
-          zdqs2 = dqsats(t(i,k+1), zqs2)
+        IF (t(i, k)<t_coup) THEN
+          zqs1 = qsats(t(i, k)) / pplay(i, k)
+          zdqs1 = dqsats(t(i, k), zqs1)
+
+          zqs2 = qsats(t(i, k + 1)) / pplay(i, k + 1)
+          zdqs2 = dqsats(t(i, k + 1), zqs2)
         ELSE
-          zqs1 = qsatl(t(i,k))/pplay(i, k)
-          zdqs1 = dqsatl(t(i,k), zqs1)
-
-          zqs2 = qsatl(t(i,k+1))/pplay(i, k+1)
-          zdqs2 = dqsatl(t(i,k+1), zqs2)
-        END IF
-      END IF
-      zdp1 = paprs(i, k) - paprs(i, k+1)
-      zdp2 = paprs(i, k+1) - paprs(i, k+2)
-      zgamdz = -(pplay(i,k)-pplay(i,k+1))/paprs(i, k+1)/rcpd*(rd*(t(i, &
-        k)*zdp1+t(i,k+1)*zdp2)/(zdp1+zdp2)+rlvtt*(zqs1*zdp1+zqs2*zdp2)/(zdp1+ &
-        zdp2))/(1.0+(zdqs1*zdp1+zdqs2*zdp2)/(zdp1+zdp2))
-      zflo = t(i, k) + zgamdz - t(i, k+1)
-      zsat = (q(i,k)-zqs1)*zdp1 + (q(i,k+1)-zqs2)*zdp2
+          zqs1 = qsatl(t(i, k)) / pplay(i, k)
+          zdqs1 = dqsatl(t(i, k), zqs1)
+
+          zqs2 = qsatl(t(i, k + 1)) / pplay(i, k + 1)
+          zdqs2 = dqsatl(t(i, k + 1), zqs2)
+        END IF
+      END IF
+      zdp1 = paprs(i, k) - paprs(i, k + 1)
+      zdp2 = paprs(i, k + 1) - paprs(i, k + 2)
+      zgamdz = -(pplay(i, k) - pplay(i, k + 1)) / paprs(i, k + 1) / rcpd * (rd * (t(i, &
+              k) * zdp1 + t(i, k + 1) * zdp2) / (zdp1 + zdp2) + rlvtt * (zqs1 * zdp1 + zqs2 * zdp2) / (zdp1 + &
+              zdp2)) / (1.0 + (zdqs1 * zdp1 + zdqs2 * zdp2) / (zdp1 + zdp2))
+      zflo = t(i, k) + zgamdz - t(i, k + 1)
+      zsat = (q(i, k) - zqs1) * zdp1 + (q(i, k + 1) - zqs2) * zdp2
       IF (zflo>0.0) afaire(i) = .TRUE.
       ! erreur         IF (zflo.GT.0.0 .AND. zsat.GT.0.0) afaire(i) = .TRUE.
@@ -257,7 +256,7 @@
       DO i = 1, klon
         IF (afaire(i)) THEN
-          zq1 = q(i, k)*(1.0-ratqs)
-          zq2 = q(i, k)*(1.0+ratqs)
-          w_q(i, k) = zq2 - frac(n)/2.0*(zq2-zq1)
+          zq1 = q(i, k) * (1.0 - ratqs)
+          zq2 = q(i, k) * (1.0 + ratqs)
+          w_q(i, k) = zq2 - frac(n) / 2.0 * (zq2 - zq1)
         END IF
       END DO
@@ -265,13 +264,13 @@
 
     CALL conmanv(dtime, paprs, pplay, t, w_q, afaire, opt_cld(n), w_d_t, &
-      w_d_q, w_d_ql, w_rneb, w_rain, w_snow, w_ibas, w_itop, accompli, &
-      imprim)
+            w_d_q, w_d_ql, w_rneb, w_rain, w_snow, w_ibas, w_itop, accompli, &
+            imprim)
     DO k = 1, klev
       DO i = 1, klon
         IF (afaire(i) .AND. accompli(i)) THEN
-          d_t(i, k) = w_d_t(i, k)*frac(n)
-          d_q(i, k) = w_d_q(i, k)*frac(n)
-          d_ql(i, k) = w_d_ql(i, k)*frac(n)
-          IF (nint(w_rneb(i,k))==1) rneb(i, k) = frac(n)
+          d_t(i, k) = w_d_t(i, k) * frac(n)
+          d_q(i, k) = w_d_q(i, k) * frac(n)
+          d_ql(i, k) = w_d_ql(i, k) * frac(n)
+          IF (nint(w_rneb(i, k))==1) rneb(i, k) = frac(n)
         END IF
       END DO
@@ -279,6 +278,6 @@
     DO i = 1, klon
       IF (afaire(i) .AND. accompli(i)) THEN
-        rain(i) = w_rain(i)*frac(n)
-        snow(i) = w_snow(i)*frac(n)
+        rain(i) = w_rain(i) * frac(n)
+        snow(i) = w_snow(i) * frac(n)
         ibas(i) = min(ibas(i), w_ibas(i))
         itop(i) = max(itop(i), w_itop(i))
@@ -293,9 +292,11 @@
   ncpt = ncpt + 1
 
-
 END SUBROUTINE conman
 SUBROUTINE conmanv(dtime, paprs, pplay, t, q, afaire, opt_cld, d_t, d_q, &
-    d_ql, rneb, rain, snow, ibas, itop, accompli, imprim)
+        d_ql, rneb, rain, snow, ibas, itop, accompli, imprim)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -313,5 +314,5 @@
   REAL t(klon, klev) ! temperature (K)
   REAL q(klon, klev) ! humidite specifique (kg/kg)
-  REAL paprs(klon, klev+1) ! pression inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
   INTEGER opt_cld ! comment traiter l'eau liquide
@@ -332,27 +333,27 @@
 
   LOGICAL new_top ! re-calculer sommet quand re-ajustement est fait
-  PARAMETER (new_top=.FALSE.)
+  PARAMETER (new_top = .FALSE.)
   LOGICAL evap_prec ! evaporation de pluie au-dessous de convection
-  PARAMETER (evap_prec=.TRUE.)
+  PARAMETER (evap_prec = .TRUE.)
   REAL coef_eva
-  PARAMETER (coef_eva=1.0E-05)
+  PARAMETER (coef_eva = 1.0E-05)
   REAL t_coup
-  PARAMETER (t_coup=234.0)
+  PARAMETER (t_coup = 234.0)
   REAL seuil_vap
-  PARAMETER (seuil_vap=1.0E-10)
+  PARAMETER (seuil_vap = 1.0E-10)
   LOGICAL old_tau ! implique precip nulle, si vrai.
-  PARAMETER (old_tau=.FALSE.)
+  PARAMETER (old_tau = .FALSE.)
   REAL toliq(klon) ! rapport entre l'eau nuageuse et l'eau precipitante
   REAL dpmin, tomax !Epaisseur faible, rapport eau liquide plus grande
-  PARAMETER (dpmin=0.15, tomax=0.97)
+  PARAMETER (dpmin = 0.15, tomax = 0.97)
   REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-  PARAMETER (dpmax=0.30, tomin=0.05)
+  PARAMETER (dpmax = 0.30, tomin = 0.05)
   REAL deep_sig, deep_to ! au dela de deep_sig, utiliser deep_to
-  PARAMETER (deep_sig=0.50, deep_to=0.05)
+  PARAMETER (deep_sig = 0.50, deep_to = 0.05)
   LOGICAL exigent ! implique un calcul supplementaire pour Qs
-  PARAMETER (exigent=.FALSE.)
+  PARAMETER (exigent = .FALSE.)
 
   INTEGER kbase
-  PARAMETER (kbase=0)
+  PARAMETER (kbase = 0)
 
   ! Variables locales:
@@ -360,5 +361,5 @@
   INTEGER nexpo
   INTEGER i, k, k1min, k1max, k2min, k2max, is
-  REAL zgamdz(klon, klev-1)
+  REAL zgamdz(klon, klev - 1)
   REAL zt(klon, klev), zq(klon, klev)
   REAL zqs(klon, klev), zdqs(klon, klev)
@@ -380,10 +381,7 @@
   ! Fonctions thermodynamiques:
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
   DO k = 1, klev
     DO i = 1, klon
-      delp(i, k) = paprs(i, k) - paprs(i, k+1)
+      delp(i, k) = paprs(i, k) - paprs(i, k + 1)
     END DO
   END DO
@@ -418,24 +416,24 @@
 
         IF (thermcep) THEN
-          zdelta = max(0., sign(1.,rtt-zt(i,k)))
-          zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-          zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i,k))
-          zqs(i, k) = r2es*foeew(zt(i,k), zdelta)/pplay(i, k)
-          zqs(i, k) = min(0.5, zqs(i,k))
-          zcor = 1./(1.-retv*zqs(i,k))
-          zqs(i, k) = zqs(i, k)*zcor
-          zdqs(i, k) = foede(zt(i,k), zdelta, zcvm5, zqs(i,k), zcor)
+          zdelta = max(0., sign(1., rtt - zt(i, k)))
+          zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+          zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * zq(i, k))
+          zqs(i, k) = r2es * foeew(zt(i, k), zdelta) / pplay(i, k)
+          zqs(i, k) = min(0.5, zqs(i, k))
+          zcor = 1. / (1. - retv * zqs(i, k))
+          zqs(i, k) = zqs(i, k) * zcor
+          zdqs(i, k) = foede(zt(i, k), zdelta, zcvm5, zqs(i, k), zcor)
         ELSE
-          IF (zt(i,k)<t_coup) THEN
-            zqs(i, k) = qsats(zt(i,k))/pplay(i, k)
-            zdqs(i, k) = dqsats(zt(i,k), zqs(i,k))
+          IF (zt(i, k)<t_coup) THEN
+            zqs(i, k) = qsats(zt(i, k)) / pplay(i, k)
+            zdqs(i, k) = dqsats(zt(i, k), zqs(i, k))
           ELSE
-            zqs(i, k) = qsatl(zt(i,k))/pplay(i, k)
-            zdqs(i, k) = dqsatl(zt(i,k), zqs(i,k))
+            zqs(i, k) = qsatl(zt(i, k)) / pplay(i, k)
+            zdqs(i, k) = dqsatl(zt(i, k), zqs(i, k))
           END IF
         END IF
 
         ! Calculer (q-qs)*dp
-        zqmqsdp(i, k) = (zq(i,k)-zqs(i,k))*delp(i, k)
+        zqmqsdp(i, k) = (zq(i, k) - zqs(i, k)) * delp(i, k)
       END IF
     END DO
@@ -450,9 +448,9 @@
     DO i = 1, klon
       IF (afaire(i)) THEN
-        zgamdz(i, k) = -(pplay(i,k)-pplay(i,k+1))/paprs(i, k+1)/rcpd*(rd*(zt( &
-          i,k)*delp(i,k)+zt(i,k+1)*delp(i,k+1))/(delp(i,k)+delp(i, &
-          k+1))+rlvtt*(zqs(i,k)*delp(i,k)+zqs(i,k+1)*delp(i,k+1))/(delp(i, &
-          k)+delp(i,k+1)))/(1.0+(zdqs(i,k)*delp(i,k)+zdqs(i,k+1)*delp(i, &
-          k+1))/(delp(i,k)+delp(i,k+1)))
+        zgamdz(i, k) = -(pplay(i, k) - pplay(i, k + 1)) / paprs(i, k + 1) / rcpd * (rd * (zt(&
+                i, k) * delp(i, k) + zt(i, k + 1) * delp(i, k + 1)) / (delp(i, k) + delp(i, &
+                k + 1)) + rlvtt * (zqs(i, k) * delp(i, k) + zqs(i, k + 1) * delp(i, k + 1)) / (delp(i, &
+                k) + delp(i, k + 1))) / (1.0 + (zdqs(i, k) * delp(i, k) + zdqs(i, k + 1) * delp(i, &
+                k + 1)) / (delp(i, k) + delp(i, k + 1)))
       END IF
     END DO
@@ -468,6 +466,6 @@
     DO i = 1, klon
       IF (afaire(i)) THEN
-        zflo(i) = zt(i, k-1) + zgamdz(i, k-1) - zt(i, k)
-        zsat(i) = zqmqsdp(i, k) + zqmqsdp(i, k-1)
+        zflo(i) = zt(i, k - 1) + zgamdz(i, k - 1) - zt(i, k)
+        zsat(i) = zqmqsdp(i, k) + zqmqsdp(i, k - 1)
         IF (zflo(i)>0.0 .AND. zsat(i)>0.0) possible(i) = .TRUE.
       END IF
@@ -482,5 +480,5 @@
   END DO
 
-810 CONTINUE ! chercher le bas de la colonne a ajuster
+  810 CONTINUE ! chercher le bas de la colonne a ajuster
 
   k2min = klev
@@ -494,6 +492,6 @@
     DO i = 1, klon
       IF (possible(i) .AND. k>=k2(i) .AND. aller(i)) THEN
-        zflo(i) = zt(i, k) + zgamdz(i, k) - zt(i, k+1)
-        zsat(i) = zqmqsdp(i, k) + zqmqsdp(i, k+1)
+        zflo(i) = zt(i, k) + zgamdz(i, k) - zt(i, k + 1)
+        zsat(i) = zqmqsdp(i, k) + zqmqsdp(i, k + 1)
         IF (zflo(i)>0.0 .AND. zsat(i)>0.0) THEN
           k1(i) = k
@@ -530,5 +528,5 @@
   ! CC      ENDDO
 
-820 CONTINUE ! chercher le haut de la colonne
+  820 CONTINUE ! chercher le haut de la colonne
 
   k2min = klev
@@ -542,5 +540,5 @@
         IF (todo(i) .AND. k>k2(i) .AND. aller(i)) THEN
           zsat(i) = zsat(i) + zqmqsdp(i, k)
-          zflo(i) = zt(i, k-1) + zgamdz(i, k-1) - zt(i, k)
+          zflo(i) = zt(i, k - 1) + zgamdz(i, k - 1) - zt(i, k)
           IF (zflo(i)<=0.0 .OR. zsat(i)<=0.0) THEN
             aller(i) = .FALSE.
@@ -579,5 +577,5 @@
   ! CC      ENDDO
 
-830 CONTINUE ! faire l'ajustement en sachant k1 et k2
+  830 CONTINUE ! faire l'ajustement en sachant k1 et k2
 
   is = 0
@@ -608,7 +606,7 @@
       k = k1(i)
       za(i) = 0.
-      zb(i) = (rcpd*(1.+zdqs(i,k))*(zt(i,k)-za(i))-rlvtt*(zqs(i,k)-zq(i, &
-        k)))*delp(i, k)
-      zc(i) = delp(i, k)*rcpd*(1.+zdqs(i,k))
+      zb(i) = (rcpd * (1. + zdqs(i, k)) * (zt(i, k) - za(i)) - rlvtt * (zqs(i, k) - zq(i, &
+              k))) * delp(i, k)
+      zc(i) = delp(i, k) * rcpd * (1. + zdqs(i, k))
     END IF
   END DO
@@ -616,9 +614,9 @@
   DO k = k1min, k2max
     DO i = 1, klon
-      IF (todo(i) .AND. k>=(k1(i)+1) .AND. k<=k2(i)) THEN
-        za(i) = za(i) + zgamdz(i, k-1)
-        zb(i) = zb(i) + (rcpd*(1.+zdqs(i,k))*(zt(i,k)-za(i))-rlvtt*(zqs(i, &
-          k)-zq(i,k)))*delp(i, k)
-        zc(i) = zc(i) + delp(i, k)*rcpd*(1.+zdqs(i,k))
+      IF (todo(i) .AND. k>=(k1(i) + 1) .AND. k<=k2(i)) THEN
+        za(i) = za(i) + zgamdz(i, k - 1)
+        zb(i) = zb(i) + (rcpd * (1. + zdqs(i, k)) * (zt(i, k) - za(i)) - rlvtt * (zqs(i, &
+                k) - zq(i, k))) * delp(i, k)
+        zc(i) = zc(i) + delp(i, k) * rcpd * (1. + zdqs(i, k))
       END IF
     END DO
@@ -628,6 +626,6 @@
     IF (todo(i)) THEN
       k = k1(i)
-      ztnew(i, k) = zb(i)/zc(i)
-      zqnew(i, k) = zqs(i, k) + (ztnew(i,k)-zt(i,k))*rcpd/rlvtt*zdqs(i, k)
+      ztnew(i, k) = zb(i) / zc(i)
+      zqnew(i, k) = zqs(i, k) + (ztnew(i, k) - zt(i, k)) * rcpd / rlvtt * zdqs(i, k)
     END IF
   END DO
@@ -635,7 +633,7 @@
   DO k = k1min, k2max
     DO i = 1, klon
-      IF (todo(i) .AND. k>=(k1(i)+1) .AND. k<=k2(i)) THEN
-        ztnew(i, k) = ztnew(i, k-1) + zgamdz(i, k-1)
-        zqnew(i, k) = zqs(i, k) + (ztnew(i,k)-zt(i,k))*rcpd/rlvtt*zdqs(i, k)
+      IF (todo(i) .AND. k>=(k1(i) + 1) .AND. k<=k2(i)) THEN
+        ztnew(i, k) = ztnew(i, k - 1) + zgamdz(i, k - 1)
+        zqnew(i, k) = zqs(i, k) + (ztnew(i, k) - zt(i, k)) * rcpd / rlvtt * zdqs(i, k)
       END IF
     END DO
@@ -651,5 +649,5 @@
       IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) THEN
         rneb(i, k) = 1.0
-        zcond(i) = zcond(i) + (zq(i,k)-zqnew(i,k))*delp(i, k)/rg
+        zcond(i) = zcond(i) + (zq(i, k) - zqnew(i, k)) * delp(i, k) / rg
       END IF
     END DO
@@ -680,8 +678,8 @@
   DO i = 1, klon
     IF (todo(i)) THEN
-      toliq(i) = tomax - ((paprs(i,k1(i))-paprs(i,k2(i)+1))/paprs(i,1)-dpmin) &
-        *(tomax-tomin)/(dpmax-dpmin)
-      toliq(i) = max(tomin, min(tomax,toliq(i)))
-      IF (pplay(i,k2(i))/paprs(i,1)<=deep_sig) toliq(i) = deep_to
+      toliq(i) = tomax - ((paprs(i, k1(i)) - paprs(i, k2(i) + 1)) / paprs(i, 1) - dpmin) &
+              * (tomax - tomin) / (dpmax - dpmin)
+      toliq(i) = max(tomin, min(tomax, toliq(i)))
+      IF (pplay(i, k2(i)) / paprs(i, 1)<=deep_sig) toliq(i) = deep_to
       IF (old_tau) toliq(i) = 1.0
     END IF
@@ -706,5 +704,5 @@
 
     DO i = 1, klon
-      IF (todo(i)) zrfl(i) = zcond(i)/dtime
+      IF (todo(i)) zrfl(i) = zcond(i) / dtime
     END DO
 
@@ -717,12 +715,12 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) zvapo(i) = zvapo(i) + &
-          zqnew(i, k)*delp(i, k)/rg
+                zqnew(i, k) * delp(i, k) / rg
       END DO
     END DO
     DO i = 1, klon
       IF (todo(i)) THEN
-        zrapp(i) = toliq(i)*zcond(i)/zvapo(i)
-        zrapp(i) = max(0., min(1.,zrapp(i)))
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+        zrapp(i) = toliq(i) * zcond(i) / zvapo(i)
+        zrapp(i) = max(0., min(1., zrapp(i)))
+        zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
       END IF
     END DO
@@ -730,5 +728,5 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) THEN
-          d_ql(i, k) = d_ql(i, k) + zrapp(i)*zqnew(i, k)
+          d_ql(i, k) = d_ql(i, k) + zrapp(i) * zqnew(i, k)
         END IF
       END DO
@@ -743,5 +741,5 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) zvapo(i) = zvapo(i) + &
-          delp(i, k)/rg
+                delp(i, k) / rg
       END DO
     END DO
@@ -749,10 +747,10 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) THEN
-          d_ql(i, k) = d_ql(i, k) + toliq(i)*zcond(i)/zvapo(i)
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (todo(i)) zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+          d_ql(i, k) = d_ql(i, k) + toliq(i) * zcond(i) / zvapo(i)
+        END IF
+      END DO
+    END DO
+    DO i = 1, klon
+      IF (todo(i)) zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
     END DO
 
@@ -765,5 +763,5 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) zvapo(i) = zvapo(i) + &
-          max(0.0, zq(i,k)-zqnew(i,k))*delp(i, k)/rg
+                max(0.0, zq(i, k) - zqnew(i, k)) * delp(i, k) / rg
       END DO
     END DO
@@ -771,10 +769,10 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i) .AND. zvapo(i)>0.0) d_ql(i, &
-          k) = d_ql(i, k) + toliq(i)*zcond(i)/zvapo(i)*max(0.0, zq(i,k)-zqnew &
-          (i,k))
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (todo(i)) zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+                k) = d_ql(i, k) + toliq(i) * zcond(i) / zvapo(i) * max(0.0, zq(i, k) - zqnew &
+                (i, k))
+      END DO
+    END DO
+    DO i = 1, klon
+      IF (todo(i)) zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
     END DO
 
@@ -789,16 +787,16 @@
     DO k = k1min, k2max
       DO i = 1, klon
-        IF (todo(i) .AND. k>=(k1(i)+1) .AND. k<=k2(i)) zvapo(i) = zvapo(i) + &
-          delp(i, k)/rg*(pplay(i,k1(i))-pplay(i,k))**nexpo
+        IF (todo(i) .AND. k>=(k1(i) + 1) .AND. k<=k2(i)) zvapo(i) = zvapo(i) + &
+                delp(i, k) / rg * (pplay(i, k1(i)) - pplay(i, k))**nexpo
       END DO
     END DO
     DO k = k1min, k2max
       DO i = 1, klon
-        IF (todo(i) .AND. k>=(k1(i)+1) .AND. k<=k2(i)) d_ql(i, k) = d_ql(i, &
-          k) + toliq(i)*zcond(i)/zvapo(i)*(pplay(i,k1(i))-pplay(i,k))**nexpo
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (todo(i)) zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+        IF (todo(i) .AND. k>=(k1(i) + 1) .AND. k<=k2(i)) d_ql(i, k) = d_ql(i, &
+                k) + toliq(i) * zcond(i) / zvapo(i) * (pplay(i, k1(i)) - pplay(i, k))**nexpo
+      END DO
+    END DO
+    DO i = 1, klon
+      IF (todo(i)) zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
     END DO
 
@@ -817,13 +815,13 @@
       DO i = 1, klon
         IF (todo(i) .AND. k<k1(i) .AND. zrfl(i)>0.0) THEN
-          zqev = max(0.0, (zqs(i,k)-zq(i,k))*zalfa)
-          zqevt = coef_eva*(1.0-zq(i,k)/zqs(i,k))*sqrt(zrfl(i))*delp(i, k)/ &
-            pplay(i, k)*zt(i, k)*rd/rg
-          zqevt = max(0.0, min(zqevt,zrfl(i)))*rg*dtime/delp(i, k)
+          zqev = max(0.0, (zqs(i, k) - zq(i, k)) * zalfa)
+          zqevt = coef_eva * (1.0 - zq(i, k) / zqs(i, k)) * sqrt(zrfl(i)) * delp(i, k) / &
+                  pplay(i, k) * zt(i, k) * rd / rg
+          zqevt = max(0.0, min(zqevt, zrfl(i))) * rg * dtime / delp(i, k)
           zqev = min(zqev, zqevt)
-          zrfln = zrfl(i) - zqev*(delp(i,k))/rg/dtime
-          zq(i, k) = zq(i, k) - (zrfln-zrfl(i))*(rg/(delp(i,k)))*dtime
-          zt(i, k) = zt(i, k) + (zrfln-zrfl(i))*(rg/(delp(i, &
-            k)))*dtime*rlvtt/rcpd/(1.0+rvtmp2*zq(i,k))
+          zrfln = zrfl(i) - zqev * (delp(i, k)) / rg / dtime
+          zq(i, k) = zq(i, k) - (zrfln - zrfl(i)) * (rg / (delp(i, k))) * dtime
+          zt(i, k) = zt(i, k) + (zrfln - zrfl(i)) * (rg / (delp(i, &
+                  k))) * dtime * rlvtt / rcpd / (1.0 + rvtmp2 * zq(i, k))
           zrfl(i) = zrfln
         END IF
@@ -836,5 +834,5 @@
   DO i = 1, klon
     IF (todo(i)) THEN
-      IF (zt(i,1)>rtt) THEN
+      IF (zt(i, 1)>rtt) THEN
         rain(i) = rain(i) + zrfl(i)
       ELSE
@@ -862,19 +860,19 @@
         IF (todo(i)) THEN
           IF (thermcep) THEN
-            zdelta = max(0., sign(1.,rtt-zt(i,k)))
-            zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-            zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i,k))
-            zqs(i, k) = r2es*foeew(zt(i,k), zdelta)/pplay(i, k)
-            zqs(i, k) = min(0.5, zqs(i,k))
-            zcor = 1./(1.-retv*zqs(i,k))
-            zqs(i, k) = zqs(i, k)*zcor
-            zdqs(i, k) = foede(zt(i,k), zdelta, zcvm5, zqs(i,k), zcor)
+            zdelta = max(0., sign(1., rtt - zt(i, k)))
+            zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+            zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * zq(i, k))
+            zqs(i, k) = r2es * foeew(zt(i, k), zdelta) / pplay(i, k)
+            zqs(i, k) = min(0.5, zqs(i, k))
+            zcor = 1. / (1. - retv * zqs(i, k))
+            zqs(i, k) = zqs(i, k) * zcor
+            zdqs(i, k) = foede(zt(i, k), zdelta, zcvm5, zqs(i, k), zcor)
           ELSE
-            IF (zt(i,k)<t_coup) THEN
-              zqs(i, k) = qsats(zt(i,k))/pplay(i, k)
-              zdqs(i, k) = dqsats(zt(i,k), zqs(i,k))
+            IF (zt(i, k)<t_coup) THEN
+              zqs(i, k) = qsats(zt(i, k)) / pplay(i, k)
+              zdqs(i, k) = dqsats(zt(i, k), zqs(i, k))
             ELSE
-              zqs(i, k) = qsatl(zt(i,k))/pplay(i, k)
-              zdqs(i, k) = dqsatl(zt(i,k), zqs(i,k))
+              zqs(i, k) = qsatl(zt(i, k)) / pplay(i, k)
+              zdqs(i, k) = dqsatl(zt(i, k), zqs(i, k))
             END IF
           END IF
@@ -888,9 +886,9 @@
       DO i = 1, klon
         IF (todo(i)) THEN
-          zgamdz(i, k) = -(pplay(i,k)-pplay(i,k+1))/paprs(i, k+1)/rcpd*(rd*( &
-            zt(i,k)*delp(i,k)+zt(i,k+1)*delp(i,k+1))/(delp(i,k)+delp(i, &
-            k+1))+rlvtt*(zqs(i,k)*delp(i,k)+zqs(i,k+1)*delp(i,k+1))/(delp(i, &
-            k)+delp(i,k+1)))/(1.0+(zdqs(i,k)*delp(i,k)+zdqs(i,k+1)*delp(i, &
-            k+1))/(delp(i,k)+delp(i,k+1)))
+          zgamdz(i, k) = -(pplay(i, k) - pplay(i, k + 1)) / paprs(i, k + 1) / rcpd * (rd * (&
+                  zt(i, k) * delp(i, k) + zt(i, k + 1) * delp(i, k + 1)) / (delp(i, k) + delp(i, &
+                  k + 1)) + rlvtt * (zqs(i, k) * delp(i, k) + zqs(i, k + 1) * delp(i, k + 1)) / (delp(i, &
+                  k) + delp(i, k + 1))) / (1.0 + (zdqs(i, k) * delp(i, k) + zdqs(i, k + 1) * delp(i, &
+                  k + 1)) / (delp(i, k) + delp(i, k + 1)))
         END IF
       END DO
@@ -903,5 +901,5 @@
     DO i = 1, klon
       IF (todo(i)) THEN
-        zqmqsdp(i, k) = (zq(i,k)-zqs(i,k))*delp(i, k)
+        zqmqsdp(i, k) = (zq(i, k) - zqs(i, k)) * delp(i, k)
       END IF
     END DO
@@ -916,8 +914,8 @@
   k1max = 1
   DO i = 1, klon
-    IF (todo(i) .AND. k1(i)>(kbase+1)) THEN
+    IF (todo(i) .AND. k1(i)>(kbase + 1)) THEN
       k = k1(i)
-      zflo(i) = zt(i, k-1) + zgamdz(i, k-1) - zt(i, k)
-      zsat(i) = zqmqsdp(i, k) + zqmqsdp(i, k-1)
+      zflo(i) = zt(i, k - 1) + zgamdz(i, k - 1) - zt(i, k)
+      zsat(i) = zqmqsdp(i, k) + zqmqsdp(i, k - 1)
       ! sc voici l'ancienne ligne:
       ! sc         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) THEN
@@ -932,10 +930,10 @@
   END DO
 
-  IF (k1max>(kbase+1)) THEN
+  IF (k1max>(kbase + 1)) THEN
     DO k = k1max, kbase + 1, -1
       DO i = 1, klon
         IF (etendre(i) .AND. k<k1(i) .AND. aller(i)) THEN
           zsat(i) = zsat(i) + zqmqsdp(i, k)
-          zflo(i) = zt(i, k) + zgamdz(i, k) - zt(i, k+1)
+          zflo(i) = zt(i, k) + zgamdz(i, k) - zt(i, k + 1)
           IF (zsat(i)<=0.0 .OR. zflo(i)<=0.0) THEN
             aller(i) = .FALSE.
@@ -999,5 +997,5 @@
   ! a ajuster a partir du sommet de la colonne precedente
 
-860 CONTINUE ! Calculer les tendances et diagnostiques
+  860 CONTINUE ! Calculer les tendances et diagnostiques
   ! cc      PRINT*, "Apres 860"
 
@@ -1006,5 +1004,5 @@
       IF (accompli(i)) THEN
         d_t(i, k) = zt(i, k) - t(i, k)
-        zq(i, k) = max(zq(i,k), seuil_vap)
+        zq(i, k) = max(zq(i, k), seuil_vap)
         d_q(i, k) = zq(i, k) - q(i, k)
       END IF
@@ -1015,17 +1013,17 @@
     IF (accompli(i)) THEN
       DO k = 1, klev
-        IF (rneb(i,k)>0.0) THEN
+        IF (rneb(i, k)>0.0) THEN
           ibas(i) = k
           GO TO 807
         END IF
       END DO
-807   CONTINUE
+      807   CONTINUE
       DO k = klev, 1, -1
-        IF (rneb(i,k)>0.0) THEN
+        IF (rneb(i, k)>0.0) THEN
           itop(i) = k
           GO TO 808
         END IF
       END DO
-808   CONTINUE
+      808   CONTINUE
     END IF
   END DO
@@ -1041,9 +1039,11 @@
   END IF
 
-
 END SUBROUTINE conmanv
 SUBROUTINE conkuo(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, d_ql, rneb, &
-    rain, snow, ibas, itop)
+        rain, snow, ibas, itop)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -1058,5 +1058,5 @@
 
   REAL dtime ! intervalle du temps (s)
-  REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression a inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
   REAL t(klon, klev) ! temperature (K)
@@ -1079,26 +1079,26 @@
 
   LOGICAL calcfcl ! calculer le niveau de convection libre
-  PARAMETER (calcfcl=.TRUE.)
+  PARAMETER (calcfcl = .TRUE.)
   INTEGER ldepar ! niveau fixe de convection libre
-  PARAMETER (ldepar=4)
+  PARAMETER (ldepar = 4)
   INTEGER opt_cld ! comment traiter l'eau liquide
-  PARAMETER (opt_cld=4) ! valeur possible: 0, 1, 2, 3 ou 4
+  PARAMETER (opt_cld = 4) ! valeur possible: 0, 1, 2, 3 ou 4
   LOGICAL evap_prec ! evaporation de pluie au-dessous de convection
-  PARAMETER (evap_prec=.TRUE.)
+  PARAMETER (evap_prec = .TRUE.)
   REAL coef_eva
-  PARAMETER (coef_eva=1.0E-05)
+  PARAMETER (coef_eva = 1.0E-05)
   LOGICAL new_deh ! nouvelle facon de calculer dH
-  PARAMETER (new_deh=.FALSE.)
+  PARAMETER (new_deh = .FALSE.)
   REAL t_coup
-  PARAMETER (t_coup=234.0)
+  PARAMETER (t_coup = 234.0)
   LOGICAL old_tau ! implique precipitation nulle
-  PARAMETER (old_tau=.FALSE.)
+  PARAMETER (old_tau = .FALSE.)
   REAL toliq(klon) ! rapport entre l'eau nuageuse et l'eau precipitante
   REAL dpmin, tomax !Epaisseur faible, rapport eau liquide plus grande
-  PARAMETER (dpmin=0.15, tomax=0.97)
+  PARAMETER (dpmin = 0.15, tomax = 0.97)
   REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-  PARAMETER (dpmax=0.30, tomin=0.05)
+  PARAMETER (dpmax = 0.30, tomin = 0.05)
   REAL deep_sig, deep_to ! au dela de deep_sig, utiliser deep_to
-  PARAMETER (deep_sig=0.50, deep_to=0.05)
+  PARAMETER (deep_sig = 0.50, deep_to = 0.05)
 
   ! Variables locales:
@@ -1129,7 +1129,4 @@
   ! Fonctions thermodynamiques
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
   DATA appel1er/.TRUE./
 
@@ -1165,19 +1162,19 @@
     DO i = 1, klon
       IF (thermcep) THEN
-        zdelta = max(0., sign(1.,rtt-t(i,k)))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*q(i,k))
-        zqs(i, k) = r2es*foeew(t(i,k), zdelta)/pplay(i, k)
-        zqs(i, k) = min(0.5, zqs(i,k))
-        zcor = 1./(1.-retv*zqs(i,k))
-        zqs(i, k) = zqs(i, k)*zcor
-        zdqs(i, k) = foede(t(i,k), zdelta, zcvm5, zqs(i,k), zcor)
+        zdelta = max(0., sign(1., rtt - t(i, k)))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * q(i, k))
+        zqs(i, k) = r2es * foeew(t(i, k), zdelta) / pplay(i, k)
+        zqs(i, k) = min(0.5, zqs(i, k))
+        zcor = 1. / (1. - retv * zqs(i, k))
+        zqs(i, k) = zqs(i, k) * zcor
+        zdqs(i, k) = foede(t(i, k), zdelta, zcvm5, zqs(i, k), zcor)
       ELSE
-        IF (t(i,k)<t_coup) THEN
-          zqs(i, k) = qsats(t(i,k))/pplay(i, k)
-          zdqs(i, k) = dqsats(t(i,k), zqs(i,k))
+        IF (t(i, k)<t_coup) THEN
+          zqs(i, k) = qsats(t(i, k)) / pplay(i, k)
+          zdqs(i, k) = dqsats(t(i, k), zqs(i, k))
         ELSE
-          zqs(i, k) = qsatl(t(i,k))/pplay(i, k)
-          zdqs(i, k) = dqsatl(t(i,k), zqs(i,k))
+          zqs(i, k) = qsatl(t(i, k)) / pplay(i, k)
+          zdqs(i, k) = dqsatl(t(i, k), zqs(i, k))
         END IF
       END IF
@@ -1188,11 +1185,11 @@
 
   DO i = 1, klon
-    zgz(i, 1) = rd*t(i, 1)/(0.5*(paprs(i,1)+pplay(i, &
-      1)))*(paprs(i,1)-pplay(i,1))
+    zgz(i, 1) = rd * t(i, 1) / (0.5 * (paprs(i, 1) + pplay(i, &
+            1))) * (paprs(i, 1) - pplay(i, 1))
   END DO
   DO k = 2, klev
     DO i = 1, klon
-      zgz(i, k) = zgz(i, k-1) + rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)*(pplay(i &
-        ,k-1)-pplay(i,k))
+      zgz(i, k) = zgz(i, k - 1) + rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) * (pplay(i &
+              , k - 1) - pplay(i, k))
     END DO
   END DO
@@ -1202,5 +1199,5 @@
   DO k = 1, klev
     DO i = 1, klon
-      ztotal(i, k) = rcpd*t(i, k) + rlvtt*zqs(i, k) + zgz(i, k)
+      ztotal(i, k) = rcpd * t(i, k) + rlvtt * zqs(i, k) + zgz(i, k)
     END DO
   END DO
@@ -1222,22 +1219,22 @@
         k = kb(i)
         IF (new_deh) THEN
-          zdeh(i, k) = ztotal(i, k-1) - ztotal(i, k)
+          zdeh(i, k) = ztotal(i, k - 1) - ztotal(i, k)
         ELSE
-          zdeh(i, k) = rcpd*(t(i,k-1)-t(i,k)) - rd*0.5*(t(i,k-1)+t(i,k))/ &
-            paprs(i, k)*(pplay(i,k-1)-pplay(i,k)) + &
-            rlvtt*(zqs(i,k-1)-zqs(i,k))
-        END IF
-        zdeh(i, k) = zdeh(i, k)*0.5
+          zdeh(i, k) = rcpd * (t(i, k - 1) - t(i, k)) - rd * 0.5 * (t(i, k - 1) + t(i, k)) / &
+                  paprs(i, k) * (pplay(i, k - 1) - pplay(i, k)) + &
+                  rlvtt * (zqs(i, k - 1) - zqs(i, k))
+        END IF
+        zdeh(i, k) = zdeh(i, k) * 0.5
       END IF
     END DO
     DO k = 1, klev
       DO i = 1, klon
-        IF (ldcum(i) .AND. k>=(kb(i)+1)) THEN
+        IF (ldcum(i) .AND. k>=(kb(i) + 1)) THEN
           IF (new_deh) THEN
-            zdeh(i, k) = zdeh(i, k-1) + (ztotal(i,k-1)-ztotal(i,k))
+            zdeh(i, k) = zdeh(i, k - 1) + (ztotal(i, k - 1) - ztotal(i, k))
           ELSE
-            zdeh(i, k) = zdeh(i, k-1) + rcpd*(t(i,k-1)-t(i,k)) - &
-              rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)* &
-              (pplay(i,k-1)-pplay(i,k)) + rlvtt*(zqs(i,k-1)-zqs(i,k))
+            zdeh(i, k) = zdeh(i, k - 1) + rcpd * (t(i, k - 1) - t(i, k)) - &
+                    rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) * &
+                            (pplay(i, k - 1) - pplay(i, k)) + rlvtt * (zqs(i, k - 1) - zqs(i, k))
           END IF
         END IF
@@ -1250,19 +1247,19 @@
       ldcum(i) = .TRUE.
       IF (new_deh) THEN
-        zdeh(i, k) = ztotal(i, k-1) - ztotal(i, k)
+        zdeh(i, k) = ztotal(i, k - 1) - ztotal(i, k)
       ELSE
-        zdeh(i, k) = rcpd*(t(i,k-1)-t(i,k)) - rd*0.5*(t(i,k-1)+t(i,k))/paprs( &
-          i, k)*(pplay(i,k-1)-pplay(i,k)) + rlvtt*(zqs(i,k-1)-zqs(i,k))
-      END IF
-      zdeh(i, k) = zdeh(i, k)*0.5
+        zdeh(i, k) = rcpd * (t(i, k - 1) - t(i, k)) - rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(&
+                i, k) * (pplay(i, k - 1) - pplay(i, k)) + rlvtt * (zqs(i, k - 1) - zqs(i, k))
+      END IF
+      zdeh(i, k) = zdeh(i, k) * 0.5
     END DO
     DO k = ldepar + 1, klev
       DO i = 1, klon
         IF (new_deh) THEN
-          zdeh(i, k) = zdeh(i, k-1) + (ztotal(i,k-1)-ztotal(i,k))
+          zdeh(i, k) = zdeh(i, k - 1) + (ztotal(i, k - 1) - ztotal(i, k))
         ELSE
-          zdeh(i, k) = zdeh(i, k-1) + rcpd*(t(i,k-1)-t(i,k)) - &
-            rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)*(pplay(i,k-1)-pplay(i,k)) + &
-            rlvtt*(zqs(i,k-1)-zqs(i,k))
+          zdeh(i, k) = zdeh(i, k - 1) + rcpd * (t(i, k - 1) - t(i, k)) - &
+                  rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) * (pplay(i, k - 1) - pplay(i, k)) + &
+                  rlvtt * (zqs(i, k - 1) - zqs(i, k))
         END IF
       END DO
@@ -1288,7 +1285,7 @@
         IF (nuage(i)) THEN
           kh(i) = k
-          zconv(i) = zconv(i) + conv_q(i, k)*dtime*(paprs(i,k)-paprs(i,k+1))
-          zvirt(i) = zvirt(i) + (zdeh(i,k)/rlvtt+zqs(i,k)-q(i,k))*(paprs(i,k) &
-            -paprs(i,k+1))
+          zconv(i) = zconv(i) + conv_q(i, k) * dtime * (paprs(i, k) - paprs(i, k + 1))
+          zvirt(i) = zvirt(i) + (zdeh(i, k) / rlvtt + zqs(i, k) - q(i, k)) * (paprs(i, k) &
+                  - paprs(i, k + 1))
         END IF
       END IF
@@ -1315,5 +1312,5 @@
   DO i = 1, klon
     IF (todo(i)) THEN
-      zfrac(i) = max(0.0, min(zconv(i)/zvirt(i),1.0))
+      zfrac(i) = max(0.0, min(zconv(i) / zvirt(i), 1.0))
     END IF
   END DO
@@ -1329,9 +1326,9 @@
     DO i = 1, klon
       IF (todo(i) .AND. k>=kb(i) .AND. k<=kh(i)) THEN
-        zvar = zdeh(i, k)/(1.+zdqs(i,k))
-        d_t(i, k) = zvar*zfrac(i)/rcpd
-        d_q(i, k) = (zvar*zdqs(i,k)/rlvtt+zqs(i,k)-q(i,k))*zfrac(i) - &
-          conv_q(i, k)*dtime
-        zcond(i) = zcond(i) - d_q(i, k)*(paprs(i,k)-paprs(i,k+1))/rg
+        zvar = zdeh(i, k) / (1. + zdqs(i, k))
+        d_t(i, k) = zvar * zfrac(i) / rcpd
+        d_q(i, k) = (zvar * zdqs(i, k) / rlvtt + zqs(i, k) - q(i, k)) * zfrac(i) - &
+                conv_q(i, k) * dtime
+        zcond(i) = zcond(i) - d_q(i, k) * (paprs(i, k) - paprs(i, k + 1)) / rg
         rneb(i, k) = zfrac(i)
       END IF
@@ -1362,8 +1359,8 @@
   DO i = 1, klon
     IF (todo(i)) THEN
-      toliq(i) = tomax - ((paprs(i,kb(i))-paprs(i,kh(i)+1))/paprs(i,1)-dpmin) &
-        *(tomax-tomin)/(dpmax-dpmin)
-      toliq(i) = max(tomin, min(tomax,toliq(i)))
-      IF (pplay(i,kh(i))/paprs(i,1)<=deep_sig) toliq(i) = deep_to
+      toliq(i) = tomax - ((paprs(i, kb(i)) - paprs(i, kh(i) + 1)) / paprs(i, 1) - dpmin) &
+              * (tomax - tomin) / (dpmax - dpmin)
+      toliq(i) = max(tomin, min(tomax, toliq(i)))
+      IF (pplay(i, kh(i)) / paprs(i, 1)<=deep_sig) toliq(i) = deep_to
       IF (old_tau) toliq(i) = 1.0
     END IF
@@ -1388,5 +1385,5 @@
 
     DO i = 1, klon
-      IF (todo(i)) zrfl(i) = zcond(i)/dtime
+      IF (todo(i)) zrfl(i) = zcond(i) / dtime
     END DO
 
@@ -1399,6 +1396,6 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=kb(i) .AND. k<=kh(i)) THEN
-          zvapo(i) = zvapo(i) + (q(i,k)+d_q(i,k))*(paprs(i,k)-paprs(i,k+1))/ &
-            rg
+          zvapo(i) = zvapo(i) + (q(i, k) + d_q(i, k)) * (paprs(i, k) - paprs(i, k + 1)) / &
+                  rg
         END IF
       END DO
@@ -1406,6 +1403,6 @@
     DO i = 1, klon
       IF (todo(i)) THEN
-        zrapp(i) = toliq(i)*zcond(i)/zvapo(i)
-        zrapp(i) = max(0., min(1.,zrapp(i)))
+        zrapp(i) = toliq(i) * zcond(i) / zvapo(i)
+        zrapp(i) = max(0., min(1., zrapp(i)))
       END IF
     END DO
@@ -1413,5 +1410,5 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=kb(i) .AND. k<=kh(i)) THEN
-          d_ql(i, k) = zrapp(i)*(q(i,k)+d_q(i,k))
+          d_ql(i, k) = zrapp(i) * (q(i, k) + d_q(i, k))
         END IF
       END DO
@@ -1419,5 +1416,5 @@
     DO i = 1, klon
       IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+        zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
       END IF
     END DO
@@ -1431,5 +1428,5 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=kb(i) .AND. k<=kh(i)) THEN
-          zvapo(i) = zvapo(i) + (paprs(i,k)-paprs(i,k+1))/rg
+          zvapo(i) = zvapo(i) + (paprs(i, k) - paprs(i, k + 1)) / rg
         END IF
       END DO
@@ -1438,5 +1435,5 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=kb(i) .AND. k<=kh(i)) THEN
-          d_ql(i, k) = toliq(i)*zcond(i)/zvapo(i)
+          d_ql(i, k) = toliq(i) * zcond(i) / zvapo(i)
         END IF
       END DO
@@ -1444,5 +1441,5 @@
     DO i = 1, klon
       IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+        zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
       END IF
     END DO
@@ -1458,6 +1455,6 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=kb(i) .AND. k<=kh(i)) THEN
-          zvapo(i) = zvapo(i) + max(0.0, -d_q(i,k))*(paprs(i,k)-paprs(i,k+1)) &
-            /rg
+          zvapo(i) = zvapo(i) + max(0.0, -d_q(i, k)) * (paprs(i, k) - paprs(i, k + 1)) &
+                  / rg
         END IF
       END DO
@@ -1466,6 +1463,6 @@
       DO i = 1, klon
         IF (todo(i) .AND. k>=kb(i) .AND. k<=kh(i) .AND. zvapo(i)>0.0) THEN
-          d_ql(i, k) = d_ql(i, k) + toliq(i)*zcond(i)/zvapo(i)*max(0.0, -d_q( &
-            i,k))
+          d_ql(i, k) = d_ql(i, k) + toliq(i) * zcond(i) / zvapo(i) * max(0.0, -d_q(&
+                  i, k))
         END IF
       END DO
@@ -1473,5 +1470,5 @@
     DO i = 1, klon
       IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+        zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
       END IF
     END DO
@@ -1489,7 +1486,7 @@
     DO k = kbmin, khmax
       DO i = 1, klon
-        IF (todo(i) .AND. k>=(kb(i)+1) .AND. k<=kh(i)) THEN
-          zvapo(i) = zvapo(i) + (paprs(i,k)-paprs(i,k+1))/rg*(pplay(i,kb(i))- &
-            pplay(i,k))**nexpo
+        IF (todo(i) .AND. k>=(kb(i) + 1) .AND. k<=kh(i)) THEN
+          zvapo(i) = zvapo(i) + (paprs(i, k) - paprs(i, k + 1)) / rg * (pplay(i, kb(i)) - &
+                  pplay(i, k))**nexpo
         END IF
       END DO
@@ -1497,7 +1494,7 @@
     DO k = kbmin, khmax
       DO i = 1, klon
-        IF (todo(i) .AND. k>=(kb(i)+1) .AND. k<=kh(i)) THEN
-          d_ql(i, k) = d_ql(i, k) + toliq(i)*zcond(i)/zvapo(i)*(pplay(i,kb(i) &
-            )-pplay(i,k))**nexpo
+        IF (todo(i) .AND. k>=(kb(i) + 1) .AND. k<=kh(i)) THEN
+          d_ql(i, k) = d_ql(i, k) + toliq(i) * zcond(i) / zvapo(i) * (pplay(i, kb(i) &
+                  ) - pplay(i, k))**nexpo
         END IF
       END DO
@@ -1505,5 +1502,5 @@
     DO i = 1, klon
       IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
+        zrfl(i) = (1.0 - toliq(i)) * zcond(i) / dtime
       END IF
     END DO
@@ -1521,15 +1518,15 @@
     DO k = kbmax, 1, -1
       DO i = 1, klon
-        IF (todo(i) .AND. k<=(kb(i)-1) .AND. zrfl(i)>0.0) THEN
-          zqev = max(0.0, (zqs(i,k)-q(i,k))*zfrac(i))
-          zqevt = coef_eva*(1.0-q(i,k)/zqs(i,k))*sqrt(zrfl(i))* &
-            (paprs(i,k)-paprs(i,k+1))/pplay(i, k)*t(i, k)*rd/rg
-          zqevt = max(0.0, min(zqevt,zrfl(i)))*rg*dtime/ &
-            (paprs(i,k)-paprs(i,k+1))
+        IF (todo(i) .AND. k<=(kb(i) - 1) .AND. zrfl(i)>0.0) THEN
+          zqev = max(0.0, (zqs(i, k) - q(i, k)) * zfrac(i))
+          zqevt = coef_eva * (1.0 - q(i, k) / zqs(i, k)) * sqrt(zrfl(i)) * &
+                  (paprs(i, k) - paprs(i, k + 1)) / pplay(i, k) * t(i, k) * rd / rg
+          zqevt = max(0.0, min(zqevt, zrfl(i))) * rg * dtime / &
+                  (paprs(i, k) - paprs(i, k + 1))
           zqev = min(zqev, zqevt)
-          zrfln = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))/rg/dtime
-          d_q(i, k) = -(zrfln-zrfl(i))*(rg/(paprs(i,k)-paprs(i,k+1)))*dtime
-          d_t(i, k) = (zrfln-zrfl(i))*(rg/(paprs(i,k)-paprs(i, &
-            k+1)))*dtime*rlvtt/rcpd
+          zrfln = zrfl(i) - zqev * (paprs(i, k) - paprs(i, k + 1)) / rg / dtime
+          d_q(i, k) = -(zrfln - zrfl(i)) * (rg / (paprs(i, k) - paprs(i, k + 1))) * dtime
+          d_t(i, k) = (zrfln - zrfl(i)) * (rg / (paprs(i, k) - paprs(i, &
+                  k + 1))) * dtime * rlvtt / rcpd
           zrfl(i) = zrfln
         END IF
@@ -1542,5 +1539,5 @@
   DO i = 1, klon
     IF (todo(i)) THEN
-      IF (t(i,1)>rtt) THEN
+      IF (t(i, 1)>rtt) THEN
         rain(i) = rain(i) + zrfl(i)
       ELSE
@@ -1550,8 +1547,9 @@
   END DO
 
-
 END SUBROUTINE conkuo
 SUBROUTINE kuofcl(pt, pq, pg, pp, ldcum, kcbot)
   USE dimphy
+  USE lmdz_YOETHF
+
   IMPLICIT NONE
   ! ======================================================================
@@ -1571,5 +1569,4 @@
   ! ======================================================================
   include "YOMCST.h"
-  include "YOETHF.h"
 
   REAL pt(klon, klev), pq(klon, klev), pg(klon, klev), pp(klon, klev)
@@ -1609,7 +1606,7 @@
     is = 0
     DO i = 1, klon
-      IF (klab(i,k-1)==1) is = is + 1
+      IF (klab(i, k - 1)==1) is = is + 1
       lflag(i) = .FALSE.
-      IF (klab(i,k-1)==1) lflag(i) = .TRUE.
+      IF (klab(i, k - 1)==1) lflag(i) = .TRUE.
     END DO
     IF (is==0) GO TO 290
@@ -1619,8 +1616,8 @@
     DO i = 1, klon
       IF (lflag(i)) THEN
-        zqu(i, k) = zqu(i, k-1)
-        ztu(i, k) = ztu(i, k-1) + (pg(i,k-1)-pg(i,k))/rcpd
-        zbuo = ztu(i, k)*(1.+retv*zqu(i,k)) - pt(i, k)*(1.+retv*pq(i,k)) + &
-          0.5
+        zqu(i, k) = zqu(i, k - 1)
+        ztu(i, k) = ztu(i, k - 1) + (pg(i, k - 1) - pg(i, k)) / rcpd
+        zbuo = ztu(i, k) * (1. + retv * zqu(i, k)) - pt(i, k) * (1. + retv * pq(i, k)) + &
+                0.5
         IF (zbuo>0.) klab(i, k) = 1
         zqold(i) = zqu(i, k)
@@ -1630,5 +1627,5 @@
     ! on calcule la condensation eventuelle
 
-    CALL adjtq(pp(1,k), ztu(1,k), zqu(1,k), lflag, 1)
+    CALL adjtq(pp(1, k), ztu(1, k), zqu(1, k), lflag, 1)
 
     ! s'il y a la condensation et la "buoyancy" force est positive
@@ -1636,9 +1633,9 @@
 
     DO i = 1, klon
-      IF (lflag(i) .AND. zqu(i,k)/=zqold(i)) THEN
+      IF (lflag(i) .AND. zqu(i, k)/=zqold(i)) THEN
         klab(i, k) = 2
         zlu(i, k) = zlu(i, k) + zqold(i) - zqu(i, k)
-        zbuo = ztu(i, k)*(1.+retv*zqu(i,k)) - pt(i, k)*(1.+retv*pq(i,k)) + &
-          0.5
+        zbuo = ztu(i, k) * (1. + retv * zqu(i, k)) - pt(i, k) * (1. + retv * pq(i, k)) + &
+                0.5
         IF (zbuo>0.) THEN
           kcbot(i) = k
@@ -1648,10 +1645,12 @@
     END DO
 
-290 END DO
-
+  290 END DO
 
 END SUBROUTINE kuofcl
 SUBROUTINE adjtq(pp, pt, pq, ldflag, kcall)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -1679,11 +1678,9 @@
 
   REAL t_coup
-  PARAMETER (t_coup=234.0)
+  PARAMETER (t_coup = 234.0)
 
   REAL zcond(klon), zcond1
   REAL zdelta, zcvm5, zldcp, zqsat, zcor, zdqsat
   INTEGER is, i
-  include "YOETHF.h"
-  include "FCTTRE.h"
 
   DO i = 1, klon
@@ -1693,28 +1690,28 @@
   DO i = 1, klon
     IF (ldflag(i)) THEN
-      zdelta = max(0., sign(1.,rtt-pt(i)))
-      zldcp = rlvtt*(1.-zdelta) + zdelta*rlstt
-      zldcp = zldcp/rcpd/(1.0+rvtmp2*pq(i))
+      zdelta = max(0., sign(1., rtt - pt(i)))
+      zldcp = rlvtt * (1. - zdelta) + zdelta * rlstt
+      zldcp = zldcp / rcpd / (1.0 + rvtmp2 * pq(i))
       IF (thermcep) THEN
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*pq(i))
-        zqsat = r2es*foeew(pt(i), zdelta)/pp(i)
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * pq(i))
+        zqsat = r2es * foeew(pt(i), zdelta) / pp(i)
         zqsat = min(0.5, zqsat)
-        zcor = 1./(1.-retv*zqsat)
-        zqsat = zqsat*zcor
+        zcor = 1. / (1. - retv * zqsat)
+        zqsat = zqsat * zcor
         zdqsat = foede(pt(i), zdelta, zcvm5, zqsat, zcor)
       ELSE
         IF (pt(i)<t_coup) THEN
-          zqsat = qsats(pt(i))/pp(i)
+          zqsat = qsats(pt(i)) / pp(i)
           zdqsat = dqsats(pt(i), zqsat)
         ELSE
-          zqsat = qsatl(pt(i))/pp(i)
+          zqsat = qsatl(pt(i)) / pp(i)
           zdqsat = dqsatl(pt(i), zqsat)
         END IF
       END IF
-      zcond(i) = (pq(i)-zqsat)/(1.+zdqsat)
+      zcond(i) = (pq(i) - zqsat) / (1. + zdqsat)
       IF (kcall==1) zcond(i) = max(zcond(i), 0.)
       IF (kcall==2) zcond(i) = min(zcond(i), 0.)
-      pt(i) = pt(i) + zldcp*zcond(i)
+      pt(i) = pt(i) + zldcp * zcond(i)
       pq(i) = pq(i) - zcond(i)
     END IF
@@ -1729,36 +1726,39 @@
   DO i = 1, klon
     IF (ldflag(i) .AND. zcond(i)/=0.) THEN
-      zdelta = max(0., sign(1.,rtt-pt(i)))
-      zldcp = rlvtt*(1.-zdelta) + zdelta*rlstt
-      zldcp = zldcp/rcpd/(1.0+rvtmp2*pq(i))
+      zdelta = max(0., sign(1., rtt - pt(i)))
+      zldcp = rlvtt * (1. - zdelta) + zdelta * rlstt
+      zldcp = zldcp / rcpd / (1.0 + rvtmp2 * pq(i))
       IF (thermcep) THEN
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*pq(i))
-        zqsat = r2es*foeew(pt(i), zdelta)/pp(i)
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * pq(i))
+        zqsat = r2es * foeew(pt(i), zdelta) / pp(i)
         zqsat = min(0.5, zqsat)
-        zcor = 1./(1.-retv*zqsat)
-        zqsat = zqsat*zcor
+        zcor = 1. / (1. - retv * zqsat)
+        zqsat = zqsat * zcor
         zdqsat = foede(pt(i), zdelta, zcvm5, zqsat, zcor)
       ELSE
         IF (pt(i)<t_coup) THEN
-          zqsat = qsats(pt(i))/pp(i)
+          zqsat = qsats(pt(i)) / pp(i)
           zdqsat = dqsats(pt(i), zqsat)
         ELSE
-          zqsat = qsatl(pt(i))/pp(i)
+          zqsat = qsatl(pt(i)) / pp(i)
           zdqsat = dqsatl(pt(i), zqsat)
         END IF
       END IF
-      zcond1 = (pq(i)-zqsat)/(1.+zdqsat)
-      pt(i) = pt(i) + zldcp*zcond1
+      zcond1 = (pq(i) - zqsat) / (1. + zdqsat)
+      pt(i) = pt(i) + zldcp * zcond1
       pq(i) = pq(i) - zcond1
     END IF
   END DO
 
-230 CONTINUE
+  230 CONTINUE
 
 END SUBROUTINE adjtq
 SUBROUTINE fiajh(dtime, paprs, pplay, t, q, d_t, d_q, d_ql, rneb, rain, snow, &
-    ibas, itop)
+        ibas, itop)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
 
@@ -1772,5 +1772,5 @@
   REAL t(klon, klev) ! temperature (K)
   REAL q(klon, klev) ! humidite specifique (kg/kg)
-  REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression a inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
 
@@ -1786,7 +1786,7 @@
 
   REAL t_coup
-  PARAMETER (t_coup=234.0)
+  PARAMETER (t_coup = 234.0)
   REAL seuil_vap
-  PARAMETER (seuil_vap=1.0E-10)
+  PARAMETER (seuil_vap = 1.0E-10)
 
   ! Variables locales:
@@ -1813,7 +1813,4 @@
   REAL zdelta, zcor, zcvm5
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
   DO k = 1, klev
     DO i = 1, klon
@@ -1837,24 +1834,24 @@
   DO k = 1, klev
     DO i = 1, klon
-      v_cptt(i, k) = rcpd*local_t(i, k)
+      v_cptt(i, k) = rcpd * local_t(i, k)
       v_t = local_t(i, k)
       v_p = pplay(i, k)
 
       IF (thermcep) THEN
-        zdelta = max(0., sign(1.,rtt-v_t))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*local_q(i,k))
-        v_qs(i, k) = r2es*foeew(v_t, zdelta)/v_p
-        v_qs(i, k) = min(0.5, v_qs(i,k))
-        zcor = 1./(1.-retv*v_qs(i,k))
-        v_qs(i, k) = v_qs(i, k)*zcor
-        v_qsd(i, k) = foede(v_t, zdelta, zcvm5, v_qs(i,k), zcor)
+        zdelta = max(0., sign(1., rtt - v_t))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * local_q(i, k))
+        v_qs(i, k) = r2es * foeew(v_t, zdelta) / v_p
+        v_qs(i, k) = min(0.5, v_qs(i, k))
+        zcor = 1. / (1. - retv * v_qs(i, k))
+        v_qs(i, k) = v_qs(i, k) * zcor
+        v_qsd(i, k) = foede(v_t, zdelta, zcvm5, v_qs(i, k), zcor)
       ELSE
         IF (v_t<t_coup) THEN
-          v_qs(i, k) = qsats(v_t)/v_p
-          v_qsd(i, k) = dqsats(v_t, v_qs(i,k))
+          v_qs(i, k) = qsats(v_t) / v_p
+          v_qsd(i, k) = dqsats(v_t, v_qs(i, k))
         ELSE
-          v_qs(i, k) = qsatl(v_t)/v_p
-          v_qsd(i, k) = dqsatl(v_t, v_qs(i,k))
+          v_qs(i, k) = qsatl(v_t) / v_p
+          v_qsd(i, k) = dqsatl(v_t, v_qs(i, k))
         END IF
       END IF
@@ -1866,10 +1863,10 @@
   DO k = 2, klev
     DO i = 1, klon
-      zdp = paprs(i, k) - paprs(i, k+1)
-      zdpm = paprs(i, k-1) - paprs(i, k)
-      gamcpdz(i, k) = ((rd/rcpd/(zdpm+zdp)*(v_cptt(i,k-1)*zdpm+ &
-        v_cptt(i,k)*zdp)+rlvtt/(zdpm+zdp)*(v_qs(i,k-1)*zdpm+ &
-        v_qs(i,k)*zdp))*(pplay(i,k-1)-pplay(i,k))/paprs(i,k))/(1.0+(v_qsd(i, &
-        k-1)*zdpm+v_qsd(i,k)*zdp)/(zdpm+zdp))
+      zdp = paprs(i, k) - paprs(i, k + 1)
+      zdpm = paprs(i, k - 1) - paprs(i, k)
+      gamcpdz(i, k) = ((rd / rcpd / (zdpm + zdp) * (v_cptt(i, k - 1) * zdpm + &
+              v_cptt(i, k) * zdp) + rlvtt / (zdpm + zdp) * (v_qs(i, k - 1) * zdpm + &
+              v_qs(i, k) * zdp)) * (pplay(i, k - 1) - pplay(i, k)) / paprs(i, k)) / (1.0 + (v_qsd(i, &
+              k - 1) * zdpm + v_qsd(i, k) * zdp) / (zdpm + zdp))
     END DO
   END DO
@@ -1882,47 +1879,47 @@
     k2 = 1
 
-810 CONTINUE ! chercher k1, le bas de la colonne
+    810 CONTINUE ! chercher k1, le bas de la colonne
     k2 = k2 + 1
     IF (k2>klev) GO TO 9999
-    zflo = v_cptt(i, k2-1) - v_cptt(i, k2) - gamcpdz(i, k2)
-    zsat = (local_q(i,k2-1)-v_qs(i,k2-1))*(paprs(i,k2-1)-paprs(i,k2)) + &
-      (local_q(i,k2)-v_qs(i,k2))*(paprs(i,k2)-paprs(i,k2+1))
+    zflo = v_cptt(i, k2 - 1) - v_cptt(i, k2) - gamcpdz(i, k2)
+    zsat = (local_q(i, k2 - 1) - v_qs(i, k2 - 1)) * (paprs(i, k2 - 1) - paprs(i, k2)) + &
+            (local_q(i, k2) - v_qs(i, k2)) * (paprs(i, k2) - paprs(i, k2 + 1))
     IF (zflo<=0.0 .OR. zsat<=0.0) GO TO 810
     k1 = k2 - 1
     itest(i) = .TRUE.
 
-820 CONTINUE ! chercher k2, le haut de la colonne
+    820 CONTINUE ! chercher k2, le haut de la colonne
     IF (k2==klev) GO TO 821
     k2p = k2 + 1
-    zsat = zsat + (paprs(i,k2p)-paprs(i,k2p+1))*(local_q(i,k2p)-v_qs(i,k2p))
-    zflo = v_cptt(i, k2p-1) - v_cptt(i, k2p) - gamcpdz(i, k2p)
+    zsat = zsat + (paprs(i, k2p) - paprs(i, k2p + 1)) * (local_q(i, k2p) - v_qs(i, k2p))
+    zflo = v_cptt(i, k2p - 1) - v_cptt(i, k2p) - gamcpdz(i, k2p)
     IF (zflo<=0.0 .OR. zsat<=0.0) GO TO 821
     k2 = k2p
     GO TO 820
-821 CONTINUE
+    821 CONTINUE
 
     ! ------------------------------------------------------ ajustement local
-830 CONTINUE ! ajustement proprement dit
+    830 CONTINUE ! ajustement proprement dit
     v_cptj(k1) = 0.0
-    zdp = paprs(i, k1) - paprs(i, k1+1)
-    v_cptjk1 = ((1.0+v_qsd(i,k1))*(v_cptt(i,k1)+v_cptj(k1))+rlvtt*(local_q(i, &
-      k1)-v_qs(i,k1)))*zdp
-    v_ssig = zdp*(1.0+v_qsd(i,k1))
+    zdp = paprs(i, k1) - paprs(i, k1 + 1)
+    v_cptjk1 = ((1.0 + v_qsd(i, k1)) * (v_cptt(i, k1) + v_cptj(k1)) + rlvtt * (local_q(i, &
+            k1) - v_qs(i, k1))) * zdp
+    v_ssig = zdp * (1.0 + v_qsd(i, k1))
 
     k1p = k1 + 1
     DO k = k1p, k2
-      zdp = paprs(i, k) - paprs(i, k+1)
-      v_cptj(k) = v_cptj(k-1) + gamcpdz(i, k)
-      v_cptjk1 = v_cptjk1 + zdp*((1.0+v_qsd(i,k))*(v_cptt(i, &
-        k)+v_cptj(k))+rlvtt*(local_q(i,k)-v_qs(i,k)))
-      v_ssig = v_ssig + zdp*(1.0+v_qsd(i,k))
+      zdp = paprs(i, k) - paprs(i, k + 1)
+      v_cptj(k) = v_cptj(k - 1) + gamcpdz(i, k)
+      v_cptjk1 = v_cptjk1 + zdp * ((1.0 + v_qsd(i, k)) * (v_cptt(i, &
+              k) + v_cptj(k)) + rlvtt * (local_q(i, k) - v_qs(i, k)))
+      v_ssig = v_ssig + zdp * (1.0 + v_qsd(i, k))
     END DO
 
     DO k = k1, k2
-      cp_new_t(k) = v_cptjk1/v_ssig - v_cptj(k)
+      cp_new_t(k) = v_cptjk1 / v_ssig - v_cptj(k)
       cp_delta_t(k) = cp_new_t(k) - v_cptt(i, k)
-      new_qb(k) = v_qs(i, k) + v_qsd(i, k)*cp_delta_t(k)/rlvtt
+      new_qb(k) = v_qs(i, k) + v_qsd(i, k) * cp_delta_t(k) / rlvtt
       local_q(i, k) = new_qb(k)
-      local_t(i, k) = cp_new_t(k)/rcpd
+      local_t(i, k) = cp_new_t(k) / rcpd
     END DO
 
@@ -1932,34 +1929,34 @@
 
     DO k = k1, k2
-      v_cptt(i, k) = rcpd*local_t(i, k)
+      v_cptt(i, k) = rcpd * local_t(i, k)
       v_t = local_t(i, k)
       v_p = pplay(i, k)
 
       IF (thermcep) THEN
-        zdelta = max(0., sign(1.,rtt-v_t))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*local_q(i,k))
-        v_qs(i, k) = r2es*foeew(v_t, zdelta)/v_p
-        v_qs(i, k) = min(0.5, v_qs(i,k))
-        zcor = 1./(1.-retv*v_qs(i,k))
-        v_qs(i, k) = v_qs(i, k)*zcor
-        v_qsd(i, k) = foede(v_t, zdelta, zcvm5, v_qs(i,k), zcor)
+        zdelta = max(0., sign(1., rtt - v_t))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * local_q(i, k))
+        v_qs(i, k) = r2es * foeew(v_t, zdelta) / v_p
+        v_qs(i, k) = min(0.5, v_qs(i, k))
+        zcor = 1. / (1. - retv * v_qs(i, k))
+        v_qs(i, k) = v_qs(i, k) * zcor
+        v_qsd(i, k) = foede(v_t, zdelta, zcvm5, v_qs(i, k), zcor)
       ELSE
         IF (v_t<t_coup) THEN
-          v_qs(i, k) = qsats(v_t)/v_p
-          v_qsd(i, k) = dqsats(v_t, v_qs(i,k))
+          v_qs(i, k) = qsats(v_t) / v_p
+          v_qsd(i, k) = dqsats(v_t, v_qs(i, k))
         ELSE
-          v_qs(i, k) = qsatl(v_t)/v_p
-          v_qsd(i, k) = dqsatl(v_t, v_qs(i,k))
+          v_qs(i, k) = qsatl(v_t) / v_p
+          v_qsd(i, k) = dqsatl(v_t, v_qs(i, k))
         END IF
       END IF
     END DO
     DO k = 2, klev
-      zdpm = paprs(i, k-1) - paprs(i, k)
-      zdp = paprs(i, k) - paprs(i, k+1)
-      gamcpdz(i, k) = ((rd/rcpd/(zdpm+zdp)*(v_cptt(i,k-1)*zdpm+ &
-        v_cptt(i,k)*zdp)+rlvtt/(zdpm+zdp)*(v_qs(i,k-1)*zdpm+ &
-        v_qs(i,k)*zdp))*(pplay(i,k-1)-pplay(i,k))/paprs(i,k))/(1.0+(v_qsd(i, &
-        k-1)*zdpm+v_qsd(i,k)*zdp)/(zdpm+zdp))
+      zdpm = paprs(i, k - 1) - paprs(i, k)
+      zdp = paprs(i, k) - paprs(i, k + 1)
+      gamcpdz(i, k) = ((rd / rcpd / (zdpm + zdp) * (v_cptt(i, k - 1) * zdpm + &
+              v_cptt(i, k) * zdp) + rlvtt / (zdpm + zdp) * (v_qs(i, k - 1) * zdpm + &
+              v_qs(i, k) * zdp)) * (pplay(i, k - 1) - pplay(i, k)) / paprs(i, k)) / (1.0 + (v_qsd(i, &
+              k - 1) * zdpm + v_qsd(i, k) * zdp) / (zdpm + zdp))
     END DO
 
@@ -1967,14 +1964,14 @@
 
     IF (k1==1) GO TO 841 ! extension echouee
-    zflo = v_cptt(i, k1-1) - v_cptt(i, k1) - gamcpdz(i, k1)
-    zsat = (local_q(i,k1-1)-v_qs(i,k1-1))*(paprs(i,k1-1)-paprs(i,k1)) + &
-      (local_q(i,k1)-v_qs(i,k1))*(paprs(i,k1)-paprs(i,k1+1))
+    zflo = v_cptt(i, k1 - 1) - v_cptt(i, k1) - gamcpdz(i, k1)
+    zsat = (local_q(i, k1 - 1) - v_qs(i, k1 - 1)) * (paprs(i, k1 - 1) - paprs(i, k1)) + &
+            (local_q(i, k1) - v_qs(i, k1)) * (paprs(i, k1) - paprs(i, k1 + 1))
     IF (zflo<=0.0 .OR. zsat<=0.0) GO TO 841 ! extension echouee
 
-840 CONTINUE
+    840 CONTINUE
     k1 = k1 - 1
     IF (k1==1) GO TO 830 ! GOTO 820 (a tester, Z.X.Li, mars 1995)
-    zsat = zsat + (local_q(i,k1-1)-v_qs(i,k1-1))*(paprs(i,k1-1)-paprs(i,k1))
-    zflo = v_cptt(i, k1-1) - v_cptt(i, k1) - gamcpdz(i, k1)
+    zsat = zsat + (local_q(i, k1 - 1) - v_qs(i, k1 - 1)) * (paprs(i, k1 - 1) - paprs(i, k1))
+    zflo = v_cptt(i, k1 - 1) - v_cptt(i, k1) - gamcpdz(i, k1)
     IF (zflo>0.0 .AND. zsat>0.0) THEN
       GO TO 840
@@ -1982,9 +1979,9 @@
       GO TO 830 ! GOTO 820 (a tester, Z.X.Li, mars 1995)
     END IF
-841 CONTINUE
+    841 CONTINUE
 
     GO TO 810 ! chercher d'autres blocks en haut
 
-9999 END DO ! boucle sur tous les points
+  9999 END DO ! boucle sur tous les points
   ! -----------------------------------------------------------------------
 
@@ -1996,5 +1993,5 @@
       IF (itest(i)) THEN
         delta_q(i, k) = local_q(i, k) - q(i, k)
-        IF (delta_q(i,k)<0.) rneb(i, k) = 1.0
+        IF (delta_q(i, k)<0.) rneb(i, k) = 1.0
       END IF
     END DO
@@ -2014,7 +2011,7 @@
     DO i = 1, klon
       IF (itest(i)) THEN
-        zdp = paprs(i, k) - paprs(i, k+1)
-        zq1(i) = zq1(i) - delta_q(i, k)*zdp
-        zq2(i) = zq2(i) - min(0.0, delta_q(i,k))*zdp
+        zdp = paprs(i, k) - paprs(i, k + 1)
+        zq1(i) = zq1(i) - delta_q(i, k) * zdp
+        zq2(i) = zq2(i) - min(0.0, delta_q(i, k)) * zdp
       END IF
     END DO
@@ -2023,5 +2020,5 @@
     DO i = 1, klon
       IF (itest(i)) THEN
-        IF (zq2(i)/=0.0) d_ql(i, k) = -min(0.0, delta_q(i,k))*zq1(i)/zq2(i)
+        IF (zq2(i)/=0.0) d_ql(i, k) = -min(0.0, delta_q(i, k)) * zq1(i) / zq2(i)
       END IF
     END DO
@@ -2030,5 +2027,5 @@
   DO k = 1, klev
     DO i = 1, klon
-      local_q(i, k) = max(local_q(i,k), seuil_vap)
+      local_q(i, k) = max(local_q(i, k), seuil_vap)
     END DO
   END DO
@@ -2041,9 +2038,11 @@
   END DO
 
-
 END SUBROUTINE fiajh
 SUBROUTINE fiajc(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, d_ql, rneb, &
-    rain, snow, ibas, itop)
+        rain, snow, ibas, itop)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
 
@@ -2053,13 +2052,13 @@
 
   INTEGER plb ! niveau de depart pour la convection
-  PARAMETER (plb=4)
+  PARAMETER (plb = 4)
 
   ! Mystere: cette option n'est pas innocente pour les resultats !
   ! Qui peut resoudre ce mystere ? (Z.X.Li mars 1995)
   LOGICAL vector ! calcul vectorise
-  PARAMETER (vector=.FALSE.)
+  PARAMETER (vector = .FALSE.)
 
   REAL t_coup
-  PARAMETER (t_coup=234.0)
+  PARAMETER (t_coup = 234.0)
 
   ! Arguments:
@@ -2067,5 +2066,5 @@
   REAL q(klon, klev) ! humidite specifique (kg/kg)
   REAL t(klon, klev) ! temperature (K)
-  REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression a inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
   REAL dtime ! intervalle du temps (s)
@@ -2088,7 +2087,4 @@
   REAL zdelta, zcor, zcvm5
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
   ! Initialiser les sorties:
 
@@ -2114,19 +2110,19 @@
       ztt = t(i, k)
       IF (thermcep) THEN
-        zdelta = max(0., sign(1.,rtt-ztt))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + zdelta*r5ies*rlstt
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*q(i,k))
-        zqs(i, k) = r2es*foeew(ztt, zdelta)/pplay(i, k)
-        zqs(i, k) = min(0.5, zqs(i,k))
-        zcor = 1./(1.-retv*zqs(i,k))
-        zqs(i, k) = zqs(i, k)*zcor
-        zdqs(i, k) = foede(ztt, zdelta, zcvm5, zqs(i,k), zcor)
+        zdelta = max(0., sign(1., rtt - ztt))
+        zcvm5 = r5les * rlvtt * (1. - zdelta) + zdelta * r5ies * rlstt
+        zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * q(i, k))
+        zqs(i, k) = r2es * foeew(ztt, zdelta) / pplay(i, k)
+        zqs(i, k) = min(0.5, zqs(i, k))
+        zcor = 1. / (1. - retv * zqs(i, k))
+        zqs(i, k) = zqs(i, k) * zcor
+        zdqs(i, k) = foede(ztt, zdelta, zcvm5, zqs(i, k), zcor)
       ELSE
         IF (ztt<t_coup) THEN
-          zqs(i, k) = qsats(ztt)/pplay(i, k)
-          zdqs(i, k) = dqsats(ztt, zqs(i,k))
+          zqs(i, k) = qsats(ztt) / pplay(i, k)
+          zdqs(i, k) = dqsats(ztt, zqs(i, k))
         ELSE
-          zqs(i, k) = qsatl(ztt)/pplay(i, k)
-          zdqs(i, k) = dqsatl(ztt, zqs(i,k))
+          zqs(i, k) = qsatl(ztt) / pplay(i, k)
+          zdqs(i, k) = dqsatl(ztt, zqs(i, k))
         END IF
       END IF
@@ -2138,13 +2134,13 @@
   DO i = 1, klon
     k = plb
-    zdeh(i, k) = rcpd*(t(i,k-1)-t(i,k)) - rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k &
-      )*(pplay(i,k-1)-pplay(i,k)) + rlvtt*(zqs(i,k-1)-zqs(i,k))
-    zdeh(i, k) = zdeh(i, k)*0.5 ! on prend la moitie
+    zdeh(i, k) = rcpd * (t(i, k - 1) - t(i, k)) - rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k &
+            ) * (pplay(i, k - 1) - pplay(i, k)) + rlvtt * (zqs(i, k - 1) - zqs(i, k))
+    zdeh(i, k) = zdeh(i, k) * 0.5 ! on prend la moitie
   END DO
   DO k = plb + 1, klev
     DO i = 1, klon
-      zdeh(i, k) = zdeh(i, k-1) + rcpd*(t(i,k-1)-t(i,k)) - &
-        rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)*(pplay(i,k-1)-pplay(i,k)) + &
-        rlvtt*(zqs(i,k-1)-zqs(i,k))
+      zdeh(i, k) = zdeh(i, k - 1) + rcpd * (t(i, k - 1) - t(i, k)) - &
+              rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) * (pplay(i, k - 1) - pplay(i, k)) + &
+              rlvtt * (zqs(i, k - 1) - zqs(i, k))
     END DO
   END DO
@@ -2164,7 +2160,7 @@
       IF (nuage(i)) THEN
         kh(i) = k
-        zconv(i) = zconv(i) + conv_q(i, k)*dtime*(paprs(i,k)-paprs(i,k+1))
-        zvirt(i) = zvirt(i) + (zdeh(i,k)/rlvtt+zqs(i,k)-q(i,k))*(paprs(i,k)- &
-          paprs(i,k+1))
+        zconv(i) = zconv(i) + conv_q(i, k) * dtime * (paprs(i, k) - paprs(i, k + 1))
+        zvirt(i) = zvirt(i) + (zdeh(i, k) / rlvtt + zqs(i, k) - q(i, k)) * (paprs(i, k) - &
+                paprs(i, k + 1))
       END IF
     END DO
@@ -2172,5 +2168,4 @@
 
   IF (vector) THEN
-
 
     DO k = plb, klev
@@ -2178,5 +2173,5 @@
         IF (k<=kh(i) .AND. kh(i)>plb .AND. zconv(i)>0.0) THEN
           test(i, k) = .TRUE.
-          zfrac(i) = max(0.0, min(zconv(i)/zvirt(i),1.0))
+          zfrac(i) = max(0.0, min(zconv(i) / zvirt(i), 1.0))
         ELSE
           test(i, k) = .FALSE.
@@ -2187,9 +2182,9 @@
     DO k = plb, klev
       DO i = 1, klon
-        IF (test(i,k)) THEN
-          zvar = zdeh(i, k)/(1.0+zdqs(i,k))
-          d_q(i, k) = (zvar*zdqs(i,k)/rlvtt+zqs(i,k)-q(i,k))*zfrac(i) - &
-            conv_q(i, k)*dtime
-          d_t(i, k) = zvar*zfrac(i)/rcpd
+        IF (test(i, k)) THEN
+          zvar = zdeh(i, k) / (1.0 + zdqs(i, k))
+          d_q(i, k) = (zvar * zdqs(i, k) / rlvtt + zqs(i, k) - q(i, k)) * zfrac(i) - &
+                  conv_q(i, k) * dtime
+          d_t(i, k) = zvar * zfrac(i) / rcpd
         END IF
       END DO
@@ -2202,8 +2197,8 @@
     DO k = plb, klev
       DO i = 1, klon
-        IF (test(i,k)) THEN
-          IF (d_q(i,k)<0.0) rneb(i, k) = zfrac(i)
-          zq1(i) = zq1(i) - d_q(i, k)*(paprs(i,k)-paprs(i,k+1))
-          zq2(i) = zq2(i) - min(0.0, d_q(i,k))*(paprs(i,k)-paprs(i,k+1))
+        IF (test(i, k)) THEN
+          IF (d_q(i, k)<0.0) rneb(i, k) = zfrac(i)
+          zq1(i) = zq1(i) - d_q(i, k) * (paprs(i, k) - paprs(i, k + 1))
+          zq2(i) = zq2(i) - min(0.0, d_q(i, k)) * (paprs(i, k) - paprs(i, k + 1))
         END IF
       END DO
@@ -2212,6 +2207,6 @@
     DO k = plb, klev
       DO i = 1, klon
-        IF (test(i,k)) THEN
-          IF (zq2(i)/=0.) d_ql(i, k) = -min(0.0, d_q(i,k))*zq1(i)/zq2(i)
+        IF (test(i, k)) THEN
+          IF (zq2(i)/=0.) d_ql(i, k) = -min(0.0, d_q(i, k)) * zq1(i) / zq2(i)
         END IF
       END DO
@@ -2224,10 +2219,10 @@
         ! cc         IF (kh(i).LE.plb) GOTO 999 ! il n'y a pas d'instabilite
         ! cc         IF (zconv(i).LE.0.0) GOTO 999 ! convergence insuffisante
-        zfrac(i) = max(0.0, min(zconv(i)/zvirt(i),1.0))
+        zfrac(i) = max(0.0, min(zconv(i) / zvirt(i), 1.0))
         DO k = plb, kh(i)
-          zvar = zdeh(i, k)/(1.0+zdqs(i,k))
-          d_q(i, k) = (zvar*zdqs(i,k)/rlvtt+zqs(i,k)-q(i,k))*zfrac(i) - &
-            conv_q(i, k)*dtime
-          d_t(i, k) = zvar*zfrac(i)/rcpd
+          zvar = zdeh(i, k) / (1.0 + zdqs(i, k))
+          d_q(i, k) = (zvar * zdqs(i, k) / rlvtt + zqs(i, k) - q(i, k)) * zfrac(i) - &
+                  conv_q(i, k) * dtime
+          d_t(i, k) = zvar * zfrac(i) / rcpd
         END DO
 
@@ -2235,10 +2230,10 @@
         zq2(i) = 0.0
         DO k = plb, kh(i)
-          IF (d_q(i,k)<0.0) rneb(i, k) = zfrac(i)
-          zq1(i) = zq1(i) - d_q(i, k)*(paprs(i,k)-paprs(i,k+1))
-          zq2(i) = zq2(i) - min(0.0, d_q(i,k))*(paprs(i,k)-paprs(i,k+1))
+          IF (d_q(i, k)<0.0) rneb(i, k) = zfrac(i)
+          zq1(i) = zq1(i) - d_q(i, k) * (paprs(i, k) - paprs(i, k + 1))
+          zq2(i) = zq2(i) - min(0.0, d_q(i, k)) * (paprs(i, k) - paprs(i, k + 1))
         END DO
         DO k = plb, kh(i)
-          IF (zq2(i)/=0.) d_ql(i, k) = -min(0.0, d_q(i,k))*zq1(i)/zq2(i)
+          IF (zq2(i)/=0.) d_ql(i, k) = -min(0.0, d_q(i, k)) * zq1(i) / zq2(i)
         END DO
       END IF
@@ -2247,4 +2242,3 @@
   END IF ! fin de teste sur vector
 
-
 END SUBROUTINE fiajc
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_enthalpmix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_enthalpmix.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_enthalpmix.F90	(revision 5143)
@@ -1,5 +1,4 @@
 SUBROUTINE cv3_enthalpmix(len, nd, iflag, plim1, plim2, p, ph, &
-                       t, q, u, v, w, &
-                       wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl)
+        t, q, u, v, w, wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl)
   ! **************************************************************
   ! *
@@ -10,5 +9,8 @@
   ! modified by :  Filiberti M-A 06/2005 vectorisation          *
   ! **************************************************************
-USE lmdz_cvthermo
+  USE lmdz_cvthermo
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ==============================================================
@@ -22,51 +24,49 @@
   ! ===============================================================
 
-  include "YOETHF.h"
   include "YOMCST.h"
-  include "FCTTRE.h"
-!inputs:
-  INTEGER, INTENT (IN)                      :: nd, len
-  INTEGER, DIMENSION (len), INTENT (IN)     :: nk
-  REAL, DIMENSION (len), INTENT (IN)        :: plim1, plim2
-  REAL, DIMENSION (len,nd), INTENT (IN)     :: t, q
-  REAL, DIMENSION (len,nd), INTENT (IN)     :: u, v
-  REAL, DIMENSION (nd), INTENT (IN)         :: w
-  REAL, DIMENSION (len,nd), INTENT (IN)     :: p
-  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
-!input/output:
-  INTEGER, DIMENSION (len), INTENT (INOUT)  ::  iflag
-!outputs:
-  REAL, DIMENSION (len), INTENT (OUT)       :: tmix, thmix, qmix
-  REAL, DIMENSION (len), INTENT (OUT)       :: umix, vmix
-  REAL, DIMENSION (len), INTENT (OUT)       :: qsmix
-  REAL, DIMENSION (len), INTENT (OUT)       :: plcl
-  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
-!internal variables :
+  !inputs:
+  INTEGER, INTENT (IN) :: nd, len
+  INTEGER, DIMENSION (len), INTENT (IN) :: nk
+  REAL, DIMENSION (len), INTENT (IN) :: plim1, plim2
+  REAL, DIMENSION (len, nd), INTENT (IN) :: t, q
+  REAL, DIMENSION (len, nd), INTENT (IN) :: u, v
+  REAL, DIMENSION (nd), INTENT (IN) :: w
+  REAL, DIMENSION (len, nd), INTENT (IN) :: p
+  REAL, DIMENSION (len, nd + 1), INTENT (IN) :: ph
+  !input/output:
+  INTEGER, DIMENSION (len), INTENT (INOUT) :: iflag
+  !outputs:
+  REAL, DIMENSION (len), INTENT (OUT) :: tmix, thmix, qmix
+  REAL, DIMENSION (len), INTENT (OUT) :: umix, vmix
+  REAL, DIMENSION (len), INTENT (OUT) :: qsmix
+  REAL, DIMENSION (len), INTENT (OUT) :: plcl
+  REAL, DIMENSION (len, nd), INTENT (OUT) :: wi
+  !internal variables :
   INTEGER i, j
   INTEGER niflag7
-  INTEGER, DIMENSION(len)                   :: j1, j2
-  REAL                                      :: a, b
-  REAL                                      :: cpn
-  REAL                                      :: x, y, p0, p0m1, zdelta, zcor
-  REAL, SAVE                                :: dpmin=1.
-!$OMP THREADPRIVATE(dpmin)
-  REAL, DIMENSION(len)                      :: plim2p  ! = min(plim2(:),plim1(:)-dpmin)
-  REAL, DIMENSION(len)                      :: akm     ! mixture enthalpy
-  REAL, DIMENSION(len)                      :: dpw, coef
-  REAL, DIMENSION(len)                      :: rdcp, a2, b2, pnk
-  REAL, DIMENSION(len)                      :: rh, chi
-  REAL, DIMENSION(len)                      :: eqwght
-  REAL, DIMENSION(len,nd)                   :: p1, p2
-
-
-!!  print *,' ->cv3_vertmix, plim1,plim2 ', plim1,plim2   !jyg
-  plim2p(:) = min(plim2(:),plim1(:)-dpmin)
-  j1(:)=nd
+  INTEGER, DIMENSION(len) :: j1, j2
+  REAL :: a, b
+  REAL :: cpn
+  REAL :: x, y, p0, p0m1, zdelta, zcor
+  REAL, SAVE :: dpmin = 1.
+  !$OMP THREADPRIVATE(dpmin)
+  REAL, DIMENSION(len) :: plim2p  ! = min(plim2(:),plim1(:)-dpmin)
+  REAL, DIMENSION(len) :: akm     ! mixture enthalpy
+  REAL, DIMENSION(len) :: dpw, coef
+  REAL, DIMENSION(len) :: rdcp, a2, b2, pnk
+  REAL, DIMENSION(len) :: rh, chi
+  REAL, DIMENSION(len) :: eqwght
+  REAL, DIMENSION(len, nd) :: p1, p2
+
+
+  !!  print *,' ->cv3_vertmix, plim1,plim2 ', plim1,plim2   !jyg
+  plim2p(:) = min(plim2(:), plim1(:) - dpmin)
+  j1(:) = nd
   j2(:) = 0
   DO j = 1, nd
     DO i = 1, len
-      IF (plim1(i)<=ph(i,j)) j1(i) = j
-!!!      IF (plim2p(i)>=ph(i,j+1) .AND. plim2p(i)<ph(i,j)) j2(i) = j
-      IF (plim2p(i)< ph(i,j)) j2(i) = j
+      IF (plim1(i)<=ph(i, j)) j1(i) = j
+      !!!      IF (plim2p(i)>=ph(i,j+1) .AND. plim2p(i)<ph(i,j)) j2(i) = j
+      IF (plim2p(i)< ph(i, j)) j2(i) = j
     END DO
   END DO
@@ -90,5 +90,5 @@
 
   p0 = 1000.
-  p0m1 = 1./p0
+  p0m1 = 1. / p0
 
   DO i = 1, len
@@ -97,22 +97,22 @@
       eqwght(i) = 1.
     ELSE
-      coef(i) = 1./(plim1(i)-plim2p(i))
+      coef(i) = 1. / (plim1(i) - plim2p(i))
     ENDIF
   END DO
 
-!!  print *,'cv3_vertmix, j1,j2,coef ', j1,j2,coef  !jyg
+  !!  print *,'cv3_vertmix, j1,j2,coef ', j1,j2,coef  !jyg
 
   DO j = 1, nd
     DO i = 1, len
       IF (j>=j1(i) .AND. j<=j2(i)) THEN
-        p1(i, j) = min(ph(i,j), plim1(i))
-        p2(i, j) = max(ph(i,j+1), plim2p(i))
+        p1(i, j) = min(ph(i, j), plim1(i))
+        p2(i, j) = max(ph(i, j + 1), plim2p(i))
         ! CRtest:couplage thermiques: deja normalise
         ! wi(i,j) = w(j)
         ! PRINT*,'wi',wi(i,j)
-        wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i)+eqwght(i)
+        wi(i, j) = w(j) * (p1(i, j) - p2(i, j)) * coef(i) + eqwght(i)
         dpw(i) = dpw(i) + wi(i, j)
 
-!!  print *,'cv3_vertmix, j, wi(1,j),dpw ', j, wi(1,j),dpw  !jyg
+        !!  print *,'cv3_vertmix, j, wi(1,j),dpw ', j, wi(1,j),dpw  !jyg
 
       END IF
@@ -127,9 +127,9 @@
     DO i = 1, len
       IF (j>=j1(i) .AND. j<=j2(i)) THEN
-        wi(i, j) = wi(i, j)/dpw(i)
-        akm(i) = akm(i) + (cpd*(1.-q(i,j))+q(i,j)*cpv)*t(i, j)*wi(i, j)
-        qmix(i) = qmix(i) + q(i, j)*wi(i, j)
-        umix(i) = umix(i) + u(i, j)*wi(i, j)
-        vmix(i) = vmix(i) + v(i, j)*wi(i, j)
+        wi(i, j) = wi(i, j) / dpw(i)
+        akm(i) = akm(i) + (cpd * (1. - q(i, j)) + q(i, j) * cpv) * t(i, j) * wi(i, j)
+        qmix(i) = qmix(i) + q(i, j) * wi(i, j)
+        umix(i) = umix(i) + u(i, j) * wi(i, j)
+        vmix(i) = vmix(i) + v(i, j) * wi(i, j)
       END IF
     END DO
@@ -137,11 +137,9 @@
 
   DO i = 1, len
-    rdcp(i) = (rrd*(1.-qmix(i))+qmix(i)*rrv)/(cpd*(1.-qmix(i))+qmix(i)*cpv)
-  END DO
-
-
-!!  print *,'cv3_vertmix, rdcp ', rdcp  !jyg
-
-
+    rdcp(i) = (rrd * (1. - qmix(i)) + qmix(i) * rrv) / (cpd * (1. - qmix(i)) + qmix(i) * cpv)
+  END DO
+
+
+  !!  print *,'cv3_vertmix, rdcp ', rdcp  !jyg
 
   DO j = 1, nd
@@ -149,7 +147,7 @@
       IF (j>=j1(i) .AND. j<=j2(i)) THEN
         ! c            x=(.5*(p1(i,j)+p2(i,j))*p0m1)**rdcp(i)
-        y = (.5*(p1(i,j)+p2(i,j))/pnk(i))**rdcp(i)
+        y = (.5 * (p1(i, j) + p2(i, j)) / pnk(i))**rdcp(i)
         ! c            a2(i)=a2(i)+(cpd*(1.-qmix(i))+qmix(i)*cpv)*x*wi(i,j)
-        b2(i) = b2(i) + (cpd*(1.-qmix(i))+qmix(i)*cpv)*y*wi(i, j)
+        b2(i) = b2(i) + (cpd * (1. - qmix(i)) + qmix(i) * cpv) * y * wi(i, j)
       END IF
     END DO
@@ -157,6 +155,6 @@
 
   DO i = 1, len
-    tmix(i) = akm(i)/b2(i)
-    thmix(i) = tmix(i)*(p0/pnk(i))**rdcp(i)
+    tmix(i) = akm(i) / b2(i)
+    thmix(i) = tmix(i) * (p0 / pnk(i))**rdcp(i)
     ! PRINT*,'thmix akm',akm(i),b2(i)
     ! PRINT*,'thmix t',tmix(i),p0
@@ -165,9 +163,9 @@
     ! c         thmix(i) = akm(i)/a2(i)
     ! c         tmix(i)= thmix(i)*(pnk(i)*p0m1)**rdcp(i)
-    zdelta = max(0., sign(1.,rtt-tmix(i)))
-    qsmix(i) = r2es*foeew(tmix(i), zdelta)/(pnk(i)*100.)
+    zdelta = max(0., sign(1., rtt - tmix(i)))
+    qsmix(i) = r2es * foeew(tmix(i), zdelta) / (pnk(i) * 100.)
     qsmix(i) = min(0.5, qsmix(i))
-    zcor = 1./(1.-retv*qsmix(i))
-    qsmix(i) = qsmix(i)*zcor
+    zcor = 1. / (1. - retv * qsmix(i))
+    qsmix(i) = qsmix(i) * zcor
   END DO
 
@@ -180,5 +178,4 @@
   b = 122.0 ! convect3
 
-
   niflag7 = 0
   DO i = 1, len
@@ -186,13 +183,13 @@
     IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002
 
-      rh(i) = qmix(i)/qsmix(i)
-      chi(i) = tmix(i)/(a-b*rh(i)-tmix(i)) ! convect3
+      rh(i) = qmix(i) / qsmix(i)
+      chi(i) = tmix(i) / (a - b * rh(i) - tmix(i)) ! convect3
       ! ATTENTION, la LIGNE DESSOUS A ETE RAJOUTEE ARBITRAIREMENT ET
       ! MASQUE UN PB POTENTIEL
       chi(i) = max(chi(i), 0.)
       rh(i) = max(rh(i), 0.)
-      plcl(i) = pnk(i)*(rh(i)**chi(i))
+      plcl(i) = pnk(i) * (rh(i)**chi(i))
       IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) &
-          iflag(i) = 8
+              iflag(i) = 8
 
     ELSE
@@ -207,7 +204,5 @@
   END DO
 
-!!  print *,' cv3_vertmix->'  !jyg
-
-
+  !!  print *,' cv3_vertmix->'  !jyg
 
 END SUBROUTINE cv3_enthalpmix
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_estatmix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_estatmix.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_estatmix.F90	(revision 5143)
@@ -12,4 +12,7 @@
   ! ****************************************************************
 USE lmdz_cvthermo
+USE lmdz_YOETHF
+USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ==============================================================
@@ -23,7 +26,5 @@
   ! ===============================================================
 
-  include "YOETHF.h"
   include "YOMCST.h"
-  include "FCTTRE.h"
 !inputs:
   INTEGER, INTENT (IN)                      :: nd, len
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/diagphy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/diagphy.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/diagphy.F90	(revision 5143)
@@ -48,8 +48,9 @@
 
   USE dimphy
+  USE lmdz_YOETHF
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOETHF.h"
 
   ! Input variables
@@ -205,8 +206,9 @@
 
   USE dimphy
+  USE lmdz_YOETHF
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOETHF.h"
 
   ! Input variables
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5143)
@@ -1318,4 +1318,6 @@
     ! ========================================================
     USE dimphy
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     IMPLICIT NONE
@@ -1339,10 +1341,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
-
-    !  ----------------------------------------
-    !  Statement functions
-    include "FCTTRE.h"
-    !  ----------------------------------------
 
     DO k = 1, klev
@@ -1398,4 +1394,6 @@
     ! ========================================================
     USE dimphy
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     IMPLICIT NONE
@@ -1430,10 +1428,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
-
-    !  ----------------------------------------
-    !  Statement functions
-    include "FCTTRE.h"
-    !  ----------------------------------------
 
     print *, 'dtime, tau ', dtime, tau
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5143)
@@ -32,8 +32,8 @@
 USE lmdz_clesphys
 USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
+USE lmdz_YOETHF
 
 IMPLICIT NONE
 INCLUDE "YOMCST.h"
-INCLUDE "YOETHF.h"
 
 ! Arguments
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/evappot.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/evappot.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/evappot.F90	(revision 5143)
@@ -1,10 +1,10 @@
 SUBROUTINE evappot(klon,nbsrf,ftsol,pplay,cdragh,  &
       t_seri,q_seri,u_seri,v_seri,evap_pot)
+USE lmdz_YOETHF
+USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
 IMPLICIT NONE
 
 INCLUDE "YOMCST.h"
-INCLUDE "YOETHF.h"
-INCLUDE "FCTTRE.h"
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/fisrtilp_tr.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/fisrtilp_tr.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/fisrtilp_tr.F90	(revision 5143)
@@ -11,4 +11,7 @@
   USE dimphy
   USE lmdz_print_control, ONLY: lunout
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -122,6 +125,4 @@
   REAL fallv ! vitesse de chute pour crystaux de glace
   REAL zzz
-  include "YOETHF.h"
-  include "FCTTRE.h"
   fallv(zzz) = 3.29/2.0*((zzz)**0.16)
   ! cc      fallv (zzz) = 3.29/3.0 * ((zzz)**0.16)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90	(revision 5143)
@@ -24,4 +24,6 @@
     USE lmdz_abort_physic, ONLY: abort_physic
     USE lmdz_clesphys
+    USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
 
     CHARACTER (LEN = 20) :: modname = 'flott_gwd_rando'
@@ -33,5 +35,4 @@
     ! include "dimphy.h"
     ! END OF DIFFERENCE ONLINE-OFFLINE
-    include "YOEGWD.h"
 
     ! 0. DECLARATIONS:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90	(revision 5143)
@@ -241,4 +241,5 @@
     USE indice_sol_mod
   USE lmdz_clesphys
+  USE lmdz_YOETHF
 #ifdef ISO
     USE infotrac_phy, ONLY: niso
@@ -248,4 +249,5 @@
 #endif
 #endif
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
         
 ! Routine de traitement de la fonte de la neige dans le cas du traitement
@@ -267,7 +269,5 @@
 !   evap
 
-  INCLUDE "YOETHF.h"
   INCLUDE "YOMCST.h"
-  INCLUDE "FCTTRE.h"
 
 ! Input variables
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5143)
@@ -12,4 +12,6 @@
 !    USE control, ONLY: nvm
 !    USE indice_sol_mod, ONLY: nvm_orch
+    USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
 
     IMPLICIT NONE
@@ -17,5 +19,4 @@
 
     include "YOMCST.h"
-    include "YOEGWD.h"
 
     ! 0. DECLARATIONS:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90	(revision 5143)
@@ -1,8 +1,10 @@
-
 ! $Header$
 
 SUBROUTINE hbtm2l(knon, paprs, pplay, t2m, t10m, q2m, q10m, ustar, flux_t, flux_q, u, v, t, q, pblh, therm, plcl, cape, &
-    cin, eauliq, ctei, d_qt, d_thv, dlt_2, xhis, posint, omega, diagok)
+        cin, eauliq, ctei, d_qt, d_thv, dlt_2, xhis, posint, omega, diagok)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
 
@@ -38,5 +40,5 @@
   REAL q2m(klon), q10m(klon) ! q a 2 et 10m
   REAL ustar(klon)
-  REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression a inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
   REAL flux_t(klon, klev), flux_q(klon, klev) ! Flux
@@ -48,35 +50,35 @@
   INTEGER isommet
   REAL vk
-  PARAMETER (vk=0.35) ! Von Karman => passer a .41 ! cf U.Olgstrom
+  PARAMETER (vk = 0.35) ! Von Karman => passer a .41 ! cf U.Olgstrom
   REAL ricr
-  PARAMETER (ricr=0.4)
+  PARAMETER (ricr = 0.4)
   REAL fak
-  PARAMETER (fak=8.5) ! b calcul du Prandtl et de dTetas
+  PARAMETER (fak = 8.5) ! b calcul du Prandtl et de dTetas
   REAL fakn
-  PARAMETER (fakn=7.2) ! a
+  PARAMETER (fakn = 7.2) ! a
   REAL onet
-  PARAMETER (onet=1.0/3.0)
+  PARAMETER (onet = 1.0 / 3.0)
   REAL betam
-  PARAMETER (betam=15.0) ! pour Phim / h dans la S.L stable
+  PARAMETER (betam = 15.0) ! pour Phim / h dans la S.L stable
   REAL betah
-  PARAMETER (betah=15.0)
+  PARAMETER (betah = 15.0)
   REAL betas
-  PARAMETER (betas=5.0) ! Phit dans la S.L. stable (mais 2 formes / z/OBL<>1
+  PARAMETER (betas = 5.0) ! Phit dans la S.L. stable (mais 2 formes / z/OBL<>1
   REAL sffrac
-  PARAMETER (sffrac=0.1) ! S.L. = z/h < .1
+  PARAMETER (sffrac = 0.1) ! S.L. = z/h < .1
   REAL binm
-  PARAMETER (binm=betam*sffrac)
+  PARAMETER (binm = betam * sffrac)
   REAL binh
-  PARAMETER (binh=betah*sffrac)
+  PARAMETER (binh = betah * sffrac)
 
   REAL q_star, t_star
   REAL b1, b2, b212, b2sr ! Lambert correlations T' q' avec T* q*
-  PARAMETER (b1=70., b2=20.) ! b1 entre 70 et 100
+  PARAMETER (b1 = 70., b2 = 20.) ! b1 entre 70 et 100
 
   REAL z(klon, klev)
   ! AM
   REAL zref, dt0
-  PARAMETER (zref=2.) ! Niveau de ref a 2m
-  PARAMETER (dt0=0.1) ! convergence do while
+  PARAMETER (zref = 2.) ! Niveau de ref a 2m
+  PARAMETER (dt0 = 0.1) ! convergence do while
 
   INTEGER i, k, j
@@ -130,7 +132,4 @@
   REAL missing_val
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
   ! c      missing_val=nf90_fill_real (avec include netcdf)
   missing_val = 0.
@@ -138,10 +137,10 @@
   ! initialisations (Anne)
   isommet = klev
-  b212 = sqrt(b1*b2)
+  b212 = sqrt(b1 * b2)
   b2sr = sqrt(b2)
 
   ! Initialisation thermo
-  rlvcp = rlvtt/rcpd
-  reps = rd/rv
+  rlvcp = rlvtt / rcpd
+  reps = rd / rv
   ! raz
   q_star = 0.
@@ -164,6 +163,6 @@
   ! Calculer les hauteurs de chaque couche
   DO i = 1, knon
-    z(i, 1) = rd*t(i, 1)/(0.5*(paprs(i,1)+pplay(i,1)))*(paprs(i,1)-pplay(i,1))/rg
-    s(i, 1) = (pplay(i,1)/paprs(i,1))**rkappa
+    z(i, 1) = rd * t(i, 1) / (0.5 * (paprs(i, 1) + pplay(i, 1))) * (paprs(i, 1) - pplay(i, 1)) / rg
+    s(i, 1) = (pplay(i, 1) / paprs(i, 1))**rkappa
   END DO
   ! s(k) = [pplay(k)/ps]^kappa
@@ -181,6 +180,6 @@
   DO k = 2, klev
     DO i = 1, knon
-      z(i, k) = z(i, k-1) + rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)*(pplay(i,k-1)-pplay(i,k))/rg
-      s(i, k) = (pplay(i,k)/paprs(i,1))**rkappa
+      z(i, k) = z(i, k - 1) + rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) * (pplay(i, k - 1) - pplay(i, k)) / rg
+      s(i, k) = (pplay(i, k) / paprs(i, 1))**rkappa
     END DO
   END DO
@@ -212,8 +211,8 @@
     ! AM calcul de Ro = paprs(i,1)/Rd zxt
     ! AM convention >0 vers le bas ds lmdz
-    khfs(i) = -flux_t(i, 1)*zxt*rd/(rcpd*paprs(i,1))
-    kqfs(i) = -flux_q(i, 1)*zxt*rd/(paprs(i,1))
+    khfs(i) = -flux_t(i, 1) * zxt * rd / (rcpd * paprs(i, 1))
+    kqfs(i) = -flux_q(i, 1) * zxt * rd / (paprs(i, 1))
     ! AM   verifier que khfs et kqfs sont bien de la forme w'l'
-    heatv(i) = khfs(i) + retv*zxt*kqfs(i)
+    heatv(i) = khfs(i) + retv * zxt * kqfs(i)
     ! a comparer aussi aux sorties de clqh : flux_T/RoCp et flux_q/RoLv
     ! AM ustar est en entree (calcul dans stdlevvar avec t2m q2m)
@@ -233,8 +232,8 @@
     IF (heatv(i)>0.0001) THEN
       ! Lambda = -u*^3 / (alpha.g.kvon.<w'Theta'v>
-      obklen(i) = -t(i, 1)*ustar(i)**3/(rg*vk*heatv(i))
+      obklen(i) = -t(i, 1) * ustar(i)**3 / (rg * vk * heatv(i))
     ELSE
       ! set pblh to the friction high (cf + bas)
-      pblh(i) = 700.0*ustar(i)
+      pblh(i) = 700.0 * ustar(i)
       check(i) = .FALSE.
     END IF
@@ -255,11 +254,11 @@
         zdu2 = max(zdu2, 1.0E-20)
         ! Theta_v environnement
-        zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
-        zthvu = th_th(i)*(1.+retv*qt_th(i))
+        zthvd = t(i, k) / s(i, k) * (1. + retv * q(i, k))
+        zthvu = th_th(i) * (1. + retv * qt_th(i))
         ! Le Ri bulk par Theta_v
-        rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5*(zthvd+zthvu))
-
-        IF (rhino(i,k)>=ricr) THEN
-          pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))/(rhino(i,k-1)-rhino(i,k))
+        rhino(i, k) = (z(i, k) - zref) * rg * (zthvd - zthvu) / (zdu2 * 0.5 * (zthvd + zthvu))
+
+        IF (rhino(i, k)>=ricr) THEN
+          pblh(i) = z(i, k - 1) + (z(i, k - 1) - z(i, k)) * (ricr - rhino(i, k - 1)) / (rhino(i, k - 1) - rhino(i, k))
           ! test04 (la pblh est encore ici sous-estime'e)
           pblh(i) = pblh(i) + 100.
@@ -298,5 +297,5 @@
   DO i = 1, knon
     IF (check(i)) THEN
-      phiminv(i) = (1.-binm*pblh(i)/obklen(i))**onet
+      phiminv(i) = (1. - binm * pblh(i) / obklen(i))**onet
       ! ***************************************************
       ! Wm ? et W* ? c'est la formule pour z/h < .1
@@ -317,5 +316,5 @@
       ! END IF
       ! ***************************************************
-      wm(i) = ustar(i)*phiminv(i)
+      wm(i) = ustar(i) * phiminv(i)
       ! ======================================================================
       ! valeurs de Dominique Lambert de la campagne SEMAPHORE :
@@ -343,12 +342,12 @@
       ! HBTM        therm(i) = heatv(i)*fak/wm(i)
       ! forme Mathieu :
-      q_star = max(0., kqfs(i)/wm(i))
-      t_star = max(0., khfs(i)/wm(i))
+      q_star = max(0., kqfs(i) / wm(i))
+      t_star = max(0., khfs(i) / wm(i))
       ! Al1 Houston, we have a problem : il arrive en effet que heatv soit
       ! positif (=thermique instable) mais pas t_star : avec evaporation
       ! importante, il se peut qu'on refroidisse la 2m Que faire alors ?
       ! Garder le seul terme en q_star^2 ? ou rendre negatif le t_star^2 ?
-      therm(i) = sqrt(b1*(1.+2.*retv*qt_th(i))*t_star**2+(retv*th_th(i))**2*b2*q_star*q_star+2.*retv*th_th(i)*b212* &
-        q_star*t_star)
+      therm(i) = sqrt(b1 * (1. + 2. * retv * qt_th(i)) * t_star**2 + (retv * th_th(i))**2 * b2 * q_star * q_star + 2. * retv * th_th(i) * b212 * &
+              q_star * t_star)
 
       ! Theta et qT du thermique (forme H&B) avec exces
@@ -356,5 +355,5 @@
       ! pourquoi pas sqrt(b1)*t_star ?
       ! dqs = b2sr*kqfs(i)/wm(i)
-      qt_th(i) = qt_th(i) + b2sr*q_star
+      qt_th(i) = qt_th(i) + b2sr * q_star
       rhino(i, 1) = 0.0
     END IF
@@ -375,18 +374,18 @@
         zdu2 = max(zdu2, 1.0E-20)
         ! Theta_v environnement
-        zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
+        zthvd = t(i, k) / s(i, k) * (1. + retv * q(i, k))
 
         ! et therm Theta_v (avec hypothese de constance de H&B,
         ! qui assimile qT a vapeur)
-        zthvu = th_th(i)*(1.+retv*qt_th(i)) + therm(i)
+        zthvu = th_th(i) * (1. + retv * qt_th(i)) + therm(i)
 
 
         ! Le Ri par Theta_v
         ! AM Niveau de ref 2m
-        rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5*(zthvd+zthvu))
+        rhino(i, k) = (z(i, k) - zref) * rg * (zthvd - zthvu) / (zdu2 * 0.5 * (zthvd + zthvu))
 
         ! Niveau critique atteint
-        IF (rhino(i,k)>=ricr) THEN
-          pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))/(rhino(i,k-1)-rhino(i,k))
+        IF (rhino(i, k)>=ricr) THEN
+          pblh(i) = z(i, k - 1) + (z(i, k - 1) - z(i, k)) * (ricr - rhino(i, k - 1)) / (rhino(i, k - 1) - rhino(i, k))
           ! test04
           pblh(i) = pblh(i) + 100.
@@ -418,10 +417,10 @@
   ! Al1 calcul de pblT dans ce cas
   DO i = 1, knon
-    pblmin = 700.0*ustar(i)
+    pblmin = 700.0 * ustar(i)
     IF (pblh(i)<pblmin) check(i) = .TRUE.
   END DO
   DO i = 1, knon
     IF (check(i)) THEN
-      pblh(i) = 700.0*ustar(i)
+      pblh(i) = 700.0 * ustar(i)
       ! et par exemple :
       ! pblT(i) = t(i,2) + (t(i,3)-t(i,2)) *
@@ -445,8 +444,8 @@
     IF (unstbl(i)) THEN
       ! Al pblh a change', on recalcule :
-      zxt = (th_th(i)-zref*0.5*rg/rcpd/(1.+rvtmp2*qt_th(i)))*(1.+retv*qt_th(i))
-      phiminv(i) = (1.-binm*pblh(i)/obklen(i))**onet
-      phihinv(i) = sqrt(1.-binh*pblh(i)/obklen(i))
-      wm(i) = ustar(i)*phiminv(i)
+      zxt = (th_th(i) - zref * 0.5 * rg / rcpd / (1. + rvtmp2 * qt_th(i))) * (1. + retv * qt_th(i))
+      phiminv(i) = (1. - binm * pblh(i) / obklen(i))**onet
+      phihinv(i) = sqrt(1. - binh * pblh(i) / obklen(i))
+      wm(i) = ustar(i) * phiminv(i)
     END IF
   END DO
@@ -476,10 +475,10 @@
       omega(i) = 0.
 
-      phiminv(i) = (1.-binm*pblh(i)/obklen(i))**onet
-      wm(i) = ustar(i)*phiminv(i)
-      q_star = max(0., kqfs(i)/wm(i))
-      t_star = max(0., khfs(i)/wm(i))
-      therm(i) = sqrt(b1*(1.+2.*retv*qt_th(i))*t_star**2+(retv*th_th(i))**2*b2*q_star*q_star+2.*retv*th_th(i)*b212* &
-        q_star*t_star)
+      phiminv(i) = (1. - binm * pblh(i) / obklen(i))**onet
+      wm(i) = ustar(i) * phiminv(i)
+      q_star = max(0., kqfs(i) / wm(i))
+      t_star = max(0., khfs(i) / wm(i))
+      therm(i) = sqrt(b1 * (1. + 2. * retv * qt_th(i)) * t_star**2 + (retv * th_th(i))**2 * b2 * q_star * q_star + 2. * retv * th_th(i) * b212 * &
+              q_star * t_star)
       ! Al1diag
       ! trmb1(i) = b1*(1.+2.*RETV*qT_th(i))*t_star**2
@@ -494,18 +493,18 @@
       ! trmb3(i) = phiminv(i)
       ! and computes Theta_e for thermal
-      the_th(i) = th_th(i) + rlvcp*qt_th(i)
+      the_th(i) = th_th(i) + rlvcp * qt_th(i)
     END IF ! unstbl
     ! Al1 compute a first guess of Plcl with the Bolton/Emanuel formula
     t2 = th_th(i)
     ! thermodyn functions
-    zdelta = max(0., sign(1.,rtt-t2))
-    qsat = r2es*foeew(t2, zdelta)/paprs(i, 1)
+    zdelta = max(0., sign(1., rtt - t2))
+    qsat = r2es * foeew(t2, zdelta) / paprs(i, 1)
     qsat = min(0.5, qsat)
-    zcor = 1./(1.-retv*qsat)
-    qsat = qsat*zcor
+    zcor = 1. / (1. - retv * qsat)
+    qsat = qsat * zcor
     ! relative humidity of thermal at 2m
-    rh = qt_th(i)/qsat
-    chi = t2/(1669.0-122.0*rh-t2)
-    plcl(i) = paprs(i, 1)*(rh**chi)
+    rh = qt_th(i) / qsat
+    chi = t2 / (1669.0 - 122.0 * rh - t2)
+    plcl(i) = paprs(i, 1) * (rh**chi)
     ! al1diag
     ! ctei(i) = Plcl(i)
@@ -525,5 +524,5 @@
       IF (check(i) .OR. omegafl(i)) THEN
         ! CC         if (pplay(i,k) .le. plcl(i)) THEN
-        zm(i) = z(i, k-1)
+        zm(i) = z(i, k - 1)
         zp(i) = z(i, k)
         ! Environnement : calcul de Tv1 a partir de t(:,:)== T liquide
@@ -531,32 +530,32 @@
         tl1 = t(i, k)
         t1 = tl1
-        zdelta = max(0., sign(1.,rtt-t1))
-        qsat = r2es*foeew(t1, zdelta)/pplay(i, k)
+        zdelta = max(0., sign(1., rtt - t1))
+        qsat = r2es * foeew(t1, zdelta) / pplay(i, k)
         qsat = min(0.5, qsat)
-        zcor = 1./(1.-retv*qsat)
-        qsat = qsat*zcor
-        q1 = min(q(i,k), qsat)
-        ql1 = max(0., q(i,k)-q1)
+        zcor = 1. / (1. - retv * qsat)
+        qsat = qsat * zcor
+        q1 = min(q(i, k), qsat)
+        ql1 = max(0., q(i, k) - q1)
         ! thermodyn function (Tl2Tql)
-        dt = rlvcp*ql1
+        dt = rlvcp * ql1
         DO WHILE (abs(dt)>=dt0)
           t1 = t1 + dt
-          zdelta = max(0., sign(1.,rtt-t1))
-          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-          qsat = r2es*foeew(t1, zdelta)/pplay(i, k)
+          zdelta = max(0., sign(1., rtt - t1))
+          zcvm5 = r5les * (1. - zdelta) + r5ies * zdelta
+          qsat = r2es * foeew(t1, zdelta) / pplay(i, k)
           qsat = min(0.5, qsat)
-          zcor = 1./(1.-retv*qsat)
-          qsat = qsat*zcor
+          zcor = 1. / (1. - retv * qsat)
+          qsat = qsat * zcor
           dqsat_dt = foede(t1, zdelta, zcvm5, qsat, zcor)
           ! correction lineaire pour conserver Tl env
           ! << Tl = T1 + DT - RLvCp*(ql1 - dqsat/dT*DT >>
-          denom = 1. + rlvcp*dqsat_dt
-          q1 = min(q(i,k), qsat)
+          denom = 1. + rlvcp * dqsat_dt
+          q1 = min(q(i, k), qsat)
           ql1 = q(i, k) - q1 ! can be negative
-          rnum = tl1 - t1 + rlvcp*ql1
-          dt = rnum/denom
+          rnum = tl1 - t1 + rlvcp * ql1
+          dt = rnum / denom
         END DO
         ql1 = max(0., ql1)
-        tv1 = t1*(1.+retv*q1-ql1)
+        tv1 = t1 * (1. + retv * q1 - ql1)
         ! Thermique    : on atteint le seuil B/E de condensation
         ! ==============
@@ -564,25 +563,25 @@
         IF (.NOT. zsat(i)) THEN
           ! first guess from The_th(i) = Th_th(i) + RLvCp* [qv=qT_th(i)]
-          t2 = s(i, k)*the_th(i) - rlvcp*qt_th(i)
-          zdelta = max(0., sign(1.,rtt-t2))
-          qsat = r2es*foeew(t2, zdelta)/pplay(i, k)
+          t2 = s(i, k) * the_th(i) - rlvcp * qt_th(i)
+          zdelta = max(0., sign(1., rtt - t2))
+          qsat = r2es * foeew(t2, zdelta) / pplay(i, k)
           qsat = min(0.5, qsat)
-          zcor = 1./(1.-retv*qsat)
-          qsat = qsat*zcor
+          zcor = 1. / (1. - retv * qsat)
+          qsat = qsat * zcor
           q2 = min(qt_th(i), qsat)
-          ql2 = max(0., qt_th(i)-q2)
+          ql2 = max(0., qt_th(i) - q2)
           IF (ql2>0.0001) zsat(i) = .TRUE.
           tbef(i) = t2
           ! a PBLH non sature
           IF (zm(i)<pblh(i) .AND. zp(i)>=pblh(i)) THEN
-            reduc = (pblh(i)-zm(i))/(zp(i)-zm(i))
-            spblh = s(i, k-1) + reduc*(s(i,k)-s(i,k-1))
+            reduc = (pblh(i) - zm(i)) / (zp(i) - zm(i))
+            spblh = s(i, k - 1) + reduc * (s(i, k) - s(i, k - 1))
             ! lmdz : qT1 et Thv1
-            t1 = (t(i,k-1)+reduc*(t(i,k)-t(i,k-1)))
-            thv1 = t1*(1.+retv*q(i,k))/spblh
+            t1 = (t(i, k - 1) + reduc * (t(i, k) - t(i, k - 1)))
+            thv1 = t1 * (1. + retv * q(i, k)) / spblh
             ! on calcule pour le cas sans nuage un ctei en Delta Thv
-            thv2 = t2/spblh*(1.+retv*qt_th(i))
+            thv2 = t2 / spblh * (1. + retv * qt_th(i))
             ctei(i) = thv1 - thv2
-            tv2 = t2*(1.+retv*q2-ql2)
+            tv2 = t2 * (1. + retv * q2 - ql2)
             ! diag
             ! dTv21(i,k) = Tv2-Tv1
@@ -596,22 +595,22 @@
           t2 = tbef(i)
           dt = 1.
-          te2 = s(i, k)*the_th(i)
+          te2 = s(i, k) * the_th(i)
           DO WHILE (abs(dt)>=dt0)
-            zdelta = max(0., sign(1.,rtt-t2))
-            zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-            qsat = r2es*foeew(t2, zdelta)/pplay(i, k)
+            zdelta = max(0., sign(1., rtt - t2))
+            zcvm5 = r5les * (1. - zdelta) + r5ies * zdelta
+            qsat = r2es * foeew(t2, zdelta) / pplay(i, k)
             qsat = min(0.5, qsat)
-            zcor = 1./(1.-retv*qsat)
-            qsat = qsat*zcor
+            zcor = 1. / (1. - retv * qsat)
+            qsat = qsat * zcor
             dqsat_dt = foede(t2, zdelta, zcvm5, qsat, zcor)
             ! correction lineaire pour conserver Te_th
             ! << Te = T2 + DT + RLvCp*(qsatbef + dq/dT*DT >>
-            denom = 1. + rlvcp*dqsat_dt
-            rnum = te2 - t2 - rlvcp*qsat
-            dt = rnum/denom
+            denom = 1. + rlvcp * dqsat_dt
+            rnum = te2 - t2 - rlvcp * qsat
+            dt = rnum / denom
             t2 = t2 + dt
           END DO
           q2 = min(qt_th(i), qsat)
-          ql2 = max(0., qt_th(i)-q2)
+          ql2 = max(0., qt_th(i) - q2)
           ! jusqu'a PBLH y compris
           IF (zm(i)<pblh(i)) THEN
@@ -619,14 +618,14 @@
             ! mais a PBLH, interpolation et complements
             IF (zp(i)>=pblh(i)) THEN
-              reduc = (pblh(i)-zm(i))/(zp(i)-zm(i))
-              spblh = s(i, k-1) + reduc*(s(i,k)-s(i,k-1))
+              reduc = (pblh(i) - zm(i)) / (zp(i) - zm(i))
+              spblh = s(i, k - 1) + reduc * (s(i, k) - s(i, k - 1))
               ! CAPE et EauLiq a pblH
-              cape(i) = kape(i) + reduc*(zp(i)-zm(i))*rg*.5/(tv2+tv1)*max(0., (tv2-tv1))
-              eauliq(i) = eauliq(i) + reduc*(paprs(i,k-1)-paprs(i,k))*ql2/rg
+              cape(i) = kape(i) + reduc * (zp(i) - zm(i)) * rg * .5 / (tv2 + tv1) * max(0., (tv2 - tv1))
+              eauliq(i) = eauliq(i) + reduc * (paprs(i, k - 1) - paprs(i, k)) * ql2 / rg
               ! CTEI
-              the2 = (t2+rlvcp*q2)/spblh
+              the2 = (t2 + rlvcp * q2) / spblh
               ! T1 est en realite la Tl env (on a donc strict The1)
-              t1 = (t(i,k-1)+reduc*(t(i,k)-t(i,k-1)))
-              the1 = (t1+rlvcp*q(i,k))/spblh
+              t1 = (t(i, k - 1) + reduc * (t(i, k) - t(i, k - 1)))
+              the1 = (t1 + rlvcp * q(i, k)) / spblh
               ! Calcul de la Cloud Top Entrainement Instability
               ! cf Mathieu Lahellec QJRMS (2005) Comments to DYCOMS-II
@@ -635,24 +634,24 @@
               delt_qt = q(i, k) - qt_th(i) ! negatif
               d_qt(i) = -delt_qt
-              dlt_2(i) = .63*delt_the - the2*delt_qt
+              dlt_2(i) = .63 * delt_the - the2 * delt_qt
               ! init ctei(i)
               ctei(i) = dlt_2(i)
               IF (dlt_2(i)<-0.1) THEN
                 ! integrale de Peter :
-                aa = delt_the - delt_qt*(rlvcp-retv*the2)
-                bb = (rlvcp-(1.+retv)*the2)*ql2
+                aa = delt_the - delt_qt * (rlvcp - retv * the2)
+                bb = (rlvcp - (1. + retv) * the2) * ql2
                 d_thv(i) = aa - bb
                 ! approx de Xhi_s et de l'integrale Xint=ctei(i)
-                xhis(i) = bb/(aa-dlt_2(i))
+                xhis(i) = bb / (aa - dlt_2(i))
                 ! trmb1(i) = xhis
                 ! trmb3(i) = dlt_2
-                xnull = bb/aa
+                xnull = bb / aa
                 IF (xhis(i)>0.1) THEN
-                  ctei(i) = dlt_2(i)*xhis(i) + aa*(1.-xhis(i)) + bb*alog(xhis(i))
+                  ctei(i) = dlt_2(i) * xhis(i) + aa * (1. - xhis(i)) + bb * alog(xhis(i))
                 ELSE
-                  ctei(i) = .5*(dlt_2(i)+aa-bb)
+                  ctei(i) = .5 * (dlt_2(i) + aa - bb)
                 END IF
                 IF (xnull>0.) THEN
-                  posint(i) = aa - bb + bb*alog(xnull)
+                  posint(i) = aa - bb + bb * alog(xnull)
                 ELSE
                   posint(i) = 0.
@@ -665,5 +664,5 @@
               omegafl(i) = .TRUE.
             END IF ! end a pblh
-            IF (check(i)) eauliq(i) = eauliq(i) + (paprs(i,k)-paprs(i,k+1))*ql2/rg
+            IF (check(i)) eauliq(i) = eauliq(i) + (paprs(i, k) - paprs(i, k + 1)) * ql2 / rg
           END IF
 
@@ -671,19 +670,19 @@
 
         ! KAPE : thermique / environnement
-        tv2 = t2*(1.+retv*q2-ql2)
+        tv2 = t2 * (1. + retv * q2 - ql2)
         ! diag
         ! dTv21(i,k) = Tv2-Tv1
         ! Kape courante
-        kape(i) = kape(i) + (zp(i)-zm(i))*rg*.5/(tv2+tv1)*max(0., (tv2-tv1))
+        kape(i) = kape(i) + (zp(i) - zm(i)) * rg * .5 / (tv2 + tv1) * max(0., (tv2 - tv1))
         ! Cin
-        IF (zcin(i) .AND. tv2-tv1>0.) THEN
+        IF (zcin(i) .AND. tv2 - tv1>0.) THEN
           zcin(i) = .FALSE.
           cin(i) = kin(i)
         END IF
-        IF (.NOT. zcin(i) .AND. tv2-tv1<0.) THEN
+        IF (.NOT. zcin(i) .AND. tv2 - tv1<0.) THEN
           zcin(i) = .TRUE.
-          kin(i) = kin(i) + (zp(i)-zm(i))*rg*.5/(tv2+tv1)*min(0., (tv2-tv1))
+          kin(i) = kin(i) + (zp(i) - zm(i)) * rg * .5 / (tv2 + tv1) * min(0., (tv2 - tv1))
         END IF
-        IF (kape(i)+kin(i)<0.) THEN
+        IF (kape(i) + kin(i)<0.) THEN
           omega(i) = zm(i)
           ! trmb3(i) = paprs(i,k)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90	(revision 5143)
@@ -6,7 +6,9 @@
 
   SUBROUTINE hbtm(knon, paprs, pplay, t2m, t10m, q2m, q10m, ustar, wstar, &
-       flux_t, flux_q, u, v, t, q, pblh, cape, eauliq, ctei, pblt, therm, &
-       trmb1, trmb2, trmb3, plcl)
+          flux_t, flux_q, u, v, t, q, pblh, cape, eauliq, ctei, pblt, therm, &
+          trmb1, trmb2, trmb3, plcl)
     USE dimphy
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     ! ***************************************************************
@@ -38,8 +40,4 @@
     ! forme de HB avec le 1er niveau modele etait conservee)
 
-
-
-
-
     include "YOMCST.h"
     REAL rlvcp, reps
@@ -52,5 +50,5 @@
     REAL ustar(klon)
     REAL wstar(klon) ! w*, convective velocity scale
-    REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
+    REAL paprs(klon, klev + 1) ! pression a inter-couche (Pa)
     REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
     REAL flux_t(klon, klev), flux_q(klon, klev) ! Flux
@@ -68,5 +66,5 @@
     REAL, PARAMETER :: fak = 8.5 ! b calcul du Prandtl et de dTetas
     REAL, PARAMETER :: fakn = 7.2 ! a
-    REAL, PARAMETER :: onet = 1.0/3.0
+    REAL, PARAMETER :: onet = 1.0 / 3.0
     REAL, PARAMETER :: t_coup = 273.15
     REAL, PARAMETER :: zkmin = 0.01
@@ -79,7 +77,7 @@
     REAL, PARAMETER :: sffrac = 0.1 ! S.L. = z/h < .1
     REAL, PARAMETER :: usmin = 1.E-12
-    REAL, PARAMETER :: binm = betam*sffrac
-    REAL, PARAMETER :: binh = betah*sffrac
-    REAL, PARAMETER :: ccon = fak*sffrac*vk
+    REAL, PARAMETER :: binm = betam * sffrac
+    REAL, PARAMETER :: binh = betah * sffrac
+    REAL, PARAMETER :: ccon = fak * sffrac * vk
     REAL, PARAMETER :: b1 = 70., b2 = 20.
     REAL, PARAMETER :: zref = 2. ! Niveau de ref a 2m peut eventuellement
@@ -114,5 +112,5 @@
     ! AM      REAL ztvd, ztvu,
     REAL zdu2
-    REAL, INTENT(OUT):: therm(:) ! (klon) thermal virtual temperature excess
+    REAL, INTENT(OUT) :: therm(:) ! (klon) thermal virtual temperature excess
     REAL trmb1(klon), trmb2(klon), trmb3(klon)
     ! Algorithme thermique
@@ -153,9 +151,4 @@
     REAL fac, pblmin, zmzp, term
 
-    include "YOETHF.h"
-    include "FCTTRE.h"
-
-
-
     ! initialisations (Anne)
     isommet = klev
@@ -165,5 +158,5 @@
     therm = 0.
 
-    b212 = sqrt(b1*b2)
+    b212 = sqrt(b1 * b2)
     b2sr = sqrt(b2)
 
@@ -191,6 +184,6 @@
 
     ! Initialisation
-    rlvcp = rlvtt/rcpd
-    reps = rd/rv
+    rlvcp = rlvtt / rcpd
+    reps = rd / rv
 
 
@@ -213,7 +206,7 @@
     ! pourquoi ne pas utiliser Phi/RG ?
     DO i = 1, knon
-       z(i, 1) = rd*t(i, 1)/(0.5*(paprs(i,1)+pplay(i,1)))&
-            *(paprs(i,1)-pplay(i,1))/rg
-       s(i, 1) = (pplay(i,1)/paprs(i,1))**rkappa
+      z(i, 1) = rd * t(i, 1) / (0.5 * (paprs(i, 1) + pplay(i, 1)))&
+              * (paprs(i, 1) - pplay(i, 1)) / rg
+      s(i, 1) = (pplay(i, 1) / paprs(i, 1))**rkappa
     END DO
     ! s(k) = [pplay(k)/ps]^kappa
@@ -230,9 +223,9 @@
 
     DO k = 2, klev
-       DO i = 1, knon
-          z(i, k) = z(i, k-1) + rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)&
-               *(pplay(i,k-1)-pplay(i,k))/rg
-          s(i, k) = (pplay(i,k)/paprs(i,1))**rkappa
-       END DO
+      DO i = 1, knon
+        z(i, k) = z(i, k - 1) + rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k)&
+                * (pplay(i, k - 1) - pplay(i, k)) / rg
+        s(i, k) = (pplay(i, k) / paprs(i, 1))**rkappa
+      END DO
     END DO
     ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -242,93 +235,93 @@
     ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     DO i = 1, knon
-       ! AM         IF (thermcep) THEN
-       ! AM           zdelta=MAX(0.,SIGN(1.,RTT-tsol(i)))
-       ! zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-       ! zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1))
-       ! AM           zxqs= r2es * FOEEW(tsol(i),zdelta)/paprs(i,1)
-       ! AM           zxqs=MIN(0.5,zxqs)
-       ! AM           zcor=1./(1.-retv*zxqs)
-       ! AM           zxqs=zxqs*zcor
-       ! AM         ELSE
-       ! AM           IF (tsol(i).LT.t_coup) THEN
-       ! AM              zxqs = qsats(tsol(i)) / paprs(i,1)
-       ! AM           ELSE
-       ! AM              zxqs = qsatl(tsol(i)) / paprs(i,1)
-       ! AM           ENDIF
-       ! AM         ENDIF
-       ! niveau de reference bulk; mais ici, c,a pourrait etre le niveau de ref
-       ! du thermique
-       ! AM        zx_alf1 = 1.0
-       ! AM        zx_alf2 = 1.0 - zx_alf1
-       ! AM        zxt = (t(i,1)+z(i,1)*RG/RCPD/(1.+RVTMP2*q(i,1)))
-       ! AM     .        *(1.+RETV*q(i,1))*zx_alf1
-       ! AM     .      + (t(i,2)+z(i,2)*RG/RCPD/(1.+RVTMP2*q(i,2)))
-       ! AM     .        *(1.+RETV*q(i,2))*zx_alf2
-       ! AM        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
-       ! AM        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
-       ! AM        zxq = q(i,1)*zx_alf1+q(i,2)*zx_alf2
-       ! AM
-       ! AMAM           zxu = u10m(i)
-       ! AMAM           zxv = v10m(i)
-       ! AMAM           zxmod = 1.0+SQRT(zxu**2+zxv**2)
-       ! AM Niveau de ref choisi a 2m
-       zxt = t2m(i)
-
-       ! ***************************************************
-       ! attention, il doit s'agir de <w'theta'>
-       ! ;Calcul de tcls virtuel et de w'theta'virtuel
-       ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ! tcls=tcls*(1+.608*qcls)
-
-       ! ;Pour avoir w'theta',
-       ! ; il faut diviser par ro.Cp
-       ! Cp=Cpd*(1+0.84*qcls)
-       ! fcs=fcs/(ro_surf*Cp)
-       ! ;On transforme w'theta' en w'thetav'
-       ! Lv=(2.501-0.00237*(tcls-273.15))*1.E6
-       ! xle=xle/(ro_surf*Lv)
-       ! fcsv=fcs+.608*xle*tcls
-       ! ***************************************************
-       ! AM        khfs(i) = (tsol(i)*(1.+RETV*q(i,1))-zxt) *zxmod*cd_h(i)
-       ! AM        kqfs(i) = (zxqs-zxq) *zxmod*cd_h(i) * beta(i)
-       ! AM
-       ! dif khfs est deja w't'_v / heatv(i) = khfs(i) + RETV*zxt*kqfs(i)
-       ! AM calcule de Ro = paprs(i,1)/Rd zxt
-       ! AM convention >0 vers le bas ds lmdz
-       khfs(i) = -flux_t(i, 1)*zxt*rd/(rcpd*paprs(i,1))
-       kqfs(i) = -flux_q(i, 1)*zxt*rd/(paprs(i,1))
-       ! AM   verifier que khfs et kqfs sont bien de la forme w'l'
-       heatv(i) = khfs(i) + 0.608*zxt*kqfs(i)
-       ! a comparer aussi aux sorties de clqh : flux_T/RoCp et flux_q/RoLv
-       ! AM        heatv(i) = khfs(i)
-       ! AM ustar est en entree
-       ! AM        taux = zxu *zxmod*cd_m(i)
-       ! AM        tauy = zxv *zxmod*cd_m(i)
-       ! AM        ustar(i) = SQRT(taux**2+tauy**2)
-       ! AM        ustar(i) = MAX(SQRT(ustar(i)),0.01)
-       ! Theta et qT du thermique sans exces (interpolin vers surf)
-       ! chgt de niveau du thermique (jeudi 30/12/1999)
-       ! (interpolation lineaire avant integration phi_h)
-       ! AM        qT_th(i) = zxqs*beta(i) + 4./z(i,1)*(q(i,1)-zxqs*beta(i))
-       ! AM        qT_th(i) = max(qT_th(i),q(i,1))
-       qt_th(i) = q2m(i)
-       ! n The_th restera la Theta du thermique sans exces jusqu'a 2eme calcul
-       ! n reste a regler convention P) pour Theta
-       ! The_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
-       ! -                      + RLvCp*qT_th(i)
-       ! AM        Th_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
-       th_th(i) = t2m(i)
-    END DO
-
-    DO i = 1, knon
-       rhino(i, 1) = 0.0 ! Global Richardson
-       check(i) = .TRUE.
-       pblh(i) = z(i, 1) ! on initialise pblh a l'altitude du 1er niveau
-       plcl(i) = 6000.
-       ! Lambda = -u*^3 / (alpha.g.kvon.<w'Theta'v>
-       unsobklen(i) = -rg*vk*heatv(i)/(t(i,1)*max(ustar(i),usmin)**3)
-       trmb1(i) = 0.
-       trmb2(i) = 0.
-       trmb3(i) = 0.
+      ! AM         IF (thermcep) THEN
+      ! AM           zdelta=MAX(0.,SIGN(1.,RTT-tsol(i)))
+      ! zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
+      ! zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1))
+      ! AM           zxqs= r2es * FOEEW(tsol(i),zdelta)/paprs(i,1)
+      ! AM           zxqs=MIN(0.5,zxqs)
+      ! AM           zcor=1./(1.-retv*zxqs)
+      ! AM           zxqs=zxqs*zcor
+      ! AM         ELSE
+      ! AM           IF (tsol(i).LT.t_coup) THEN
+      ! AM              zxqs = qsats(tsol(i)) / paprs(i,1)
+      ! AM           ELSE
+      ! AM              zxqs = qsatl(tsol(i)) / paprs(i,1)
+      ! AM           ENDIF
+      ! AM         ENDIF
+      ! niveau de reference bulk; mais ici, c,a pourrait etre le niveau de ref
+      ! du thermique
+      ! AM        zx_alf1 = 1.0
+      ! AM        zx_alf2 = 1.0 - zx_alf1
+      ! AM        zxt = (t(i,1)+z(i,1)*RG/RCPD/(1.+RVTMP2*q(i,1)))
+      ! AM     .        *(1.+RETV*q(i,1))*zx_alf1
+      ! AM     .      + (t(i,2)+z(i,2)*RG/RCPD/(1.+RVTMP2*q(i,2)))
+      ! AM     .        *(1.+RETV*q(i,2))*zx_alf2
+      ! AM        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
+      ! AM        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
+      ! AM        zxq = q(i,1)*zx_alf1+q(i,2)*zx_alf2
+      ! AM
+      ! AMAM           zxu = u10m(i)
+      ! AMAM           zxv = v10m(i)
+      ! AMAM           zxmod = 1.0+SQRT(zxu**2+zxv**2)
+      ! AM Niveau de ref choisi a 2m
+      zxt = t2m(i)
+
+      ! ***************************************************
+      ! attention, il doit s'agir de <w'theta'>
+      ! ;Calcul de tcls virtuel et de w'theta'virtuel
+      ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ! tcls=tcls*(1+.608*qcls)
+
+      ! ;Pour avoir w'theta',
+      ! ; il faut diviser par ro.Cp
+      ! Cp=Cpd*(1+0.84*qcls)
+      ! fcs=fcs/(ro_surf*Cp)
+      ! ;On transforme w'theta' en w'thetav'
+      ! Lv=(2.501-0.00237*(tcls-273.15))*1.E6
+      ! xle=xle/(ro_surf*Lv)
+      ! fcsv=fcs+.608*xle*tcls
+      ! ***************************************************
+      ! AM        khfs(i) = (tsol(i)*(1.+RETV*q(i,1))-zxt) *zxmod*cd_h(i)
+      ! AM        kqfs(i) = (zxqs-zxq) *zxmod*cd_h(i) * beta(i)
+      ! AM
+      ! dif khfs est deja w't'_v / heatv(i) = khfs(i) + RETV*zxt*kqfs(i)
+      ! AM calcule de Ro = paprs(i,1)/Rd zxt
+      ! AM convention >0 vers le bas ds lmdz
+      khfs(i) = -flux_t(i, 1) * zxt * rd / (rcpd * paprs(i, 1))
+      kqfs(i) = -flux_q(i, 1) * zxt * rd / (paprs(i, 1))
+      ! AM   verifier que khfs et kqfs sont bien de la forme w'l'
+      heatv(i) = khfs(i) + 0.608 * zxt * kqfs(i)
+      ! a comparer aussi aux sorties de clqh : flux_T/RoCp et flux_q/RoLv
+      ! AM        heatv(i) = khfs(i)
+      ! AM ustar est en entree
+      ! AM        taux = zxu *zxmod*cd_m(i)
+      ! AM        tauy = zxv *zxmod*cd_m(i)
+      ! AM        ustar(i) = SQRT(taux**2+tauy**2)
+      ! AM        ustar(i) = MAX(SQRT(ustar(i)),0.01)
+      ! Theta et qT du thermique sans exces (interpolin vers surf)
+      ! chgt de niveau du thermique (jeudi 30/12/1999)
+      ! (interpolation lineaire avant integration phi_h)
+      ! AM        qT_th(i) = zxqs*beta(i) + 4./z(i,1)*(q(i,1)-zxqs*beta(i))
+      ! AM        qT_th(i) = max(qT_th(i),q(i,1))
+      qt_th(i) = q2m(i)
+      ! n The_th restera la Theta du thermique sans exces jusqu'a 2eme calcul
+      ! n reste a regler convention P) pour Theta
+      ! The_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
+      ! -                      + RLvCp*qT_th(i)
+      ! AM        Th_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
+      th_th(i) = t2m(i)
+    END DO
+
+    DO i = 1, knon
+      rhino(i, 1) = 0.0 ! Global Richardson
+      check(i) = .TRUE.
+      pblh(i) = z(i, 1) ! on initialise pblh a l'altitude du 1er niveau
+      plcl(i) = 6000.
+      ! Lambda = -u*^3 / (alpha.g.kvon.<w'Theta'v>
+      unsobklen(i) = -rg * vk * heatv(i) / (t(i, 1) * max(ustar(i), usmin)**3)
+      trmb1(i) = 0.
+      trmb2(i) = 0.
+      trmb3(i) = 0.
     END DO
 
@@ -342,37 +335,37 @@
     fac = 100.0
     DO k = 2, isommet
-       DO i = 1, knon
-          IF (check(i)) THEN
-             ! pourquoi / niveau 1 (au lieu du sol) et le terme en u*^2 ?
-             ! test     zdu2 =
-             ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
-             zdu2 = u(i, k)**2 + v(i, k)**2
-             zdu2 = max(zdu2, 1.0E-20)
-             ! Theta_v environnement
-             zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
-
-             ! therm Theta_v sans exces (avec hypothese fausse de H&B, sinon,
-             ! passer par Theta_e et virpot)
-             ! zthvu=t(i,1)/s(i,1)*(1.+RETV*q(i,1))
-             ! AM         zthvu = Th_th(i)*(1.+RETV*q(i,1))
-             zthvu = th_th(i)*(1.+retv*qt_th(i))
-             ! Le Ri par Theta_v
-             ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
-             ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
-             ! AM On a nveau de ref a 2m ???
-             rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5&
-                  *(zthvd+zthvu))
-
-             IF (rhino(i,k)>=ricr) THEN
-                pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))&
-                     /(rhino(i,k-1)-rhino(i,k))
-                ! test04
-                pblh(i) = pblh(i) + 100.
-                pblt(i) = t(i, k-1) + (t(i,k)-t(i,k-1))*(pblh(i)-z(i,k-1))&
-                     /(z(i,k)- z(i,k-1))
-                check(i) = .FALSE.
-             END IF
+      DO i = 1, knon
+        IF (check(i)) THEN
+          ! pourquoi / niveau 1 (au lieu du sol) et le terme en u*^2 ?
+          ! test     zdu2 =
+          ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
+          zdu2 = u(i, k)**2 + v(i, k)**2
+          zdu2 = max(zdu2, 1.0E-20)
+          ! Theta_v environnement
+          zthvd = t(i, k) / s(i, k) * (1. + retv * q(i, k))
+
+          ! therm Theta_v sans exces (avec hypothese fausse de H&B, sinon,
+          ! passer par Theta_e et virpot)
+          ! zthvu=t(i,1)/s(i,1)*(1.+RETV*q(i,1))
+          ! AM         zthvu = Th_th(i)*(1.+RETV*q(i,1))
+          zthvu = th_th(i) * (1. + retv * qt_th(i))
+          ! Le Ri par Theta_v
+          ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
+          ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
+          ! AM On a nveau de ref a 2m ???
+          rhino(i, k) = (z(i, k) - zref) * rg * (zthvd - zthvu) / (zdu2 * 0.5&
+                  * (zthvd + zthvu))
+
+          IF (rhino(i, k)>=ricr) THEN
+            pblh(i) = z(i, k - 1) + (z(i, k - 1) - z(i, k)) * (ricr - rhino(i, k - 1))&
+                    / (rhino(i, k - 1) - rhino(i, k))
+            ! test04
+            pblh(i) = pblh(i) + 100.
+            pblt(i) = t(i, k - 1) + (t(i, k) - t(i, k - 1)) * (pblh(i) - z(i, k - 1))&
+                    / (z(i, k) - z(i, k - 1))
+            check(i) = .FALSE.
           END IF
-       END DO
+        END IF
+      END DO
     END DO
 
@@ -382,5 +375,5 @@
 
     DO i = 1, knon
-       IF (check(i)) pblh(i) = z(i, isommet)
+      IF (check(i)) pblh(i) = z(i, isommet)
     END DO
 
@@ -389,11 +382,11 @@
 
     DO i = 1, knon
-       IF (heatv(i)>0.) THEN
-          unstbl(i) = .TRUE.
-          check(i) = .TRUE.
-       ELSE
-          unstbl(i) = .FALSE.
-          check(i) = .FALSE.
-       END IF
+      IF (heatv(i)>0.) THEN
+        unstbl(i) = .TRUE.
+        check(i) = .TRUE.
+      ELSE
+        unstbl(i) = .FALSE.
+        check(i) = .FALSE.
+      END IF
     END DO
 
@@ -402,96 +395,96 @@
 
     DO i = 1, knon
-       IF (check(i)) THEN
-          phiminv(i) = (1.-binm*pblh(i)*unsobklen(i))**onet
-          ! ***************************************************
-          ! Wm ? et W* ? c'est la formule pour z/h < .1
-          ! ;Calcul de w* ;;
-          ! ;;;;;;;;;;;;;;;;
-          ! w_star=((g/tcls)*fcsv*z(ind))^(1/3.) [ou prendre la premiere approx
-          ! de h)
-          ! ;; CALCUL DE wm ;;
-          ! ;;;;;;;;;;;;;;;;;;
-          ! ; Ici on considerera que l'on est dans la couche de surf jusqu'a
-          ! 100 m
-          ! ; On prend svt couche de surface=0.1*h mais on ne connait pas h
-          ! ;;;;;;;;;;;Dans la couche de surface
-          ! if (z(ind) le 20) then begin
-          ! Phim=(1.-15.*(z(ind)/L))^(-1/3.)
-          ! wm=u_star/Phim
-          ! ;;;;;;;;;;;En dehors de la couche de surface
-          ! END IF ELSE IF (z(ind) gt 20) then begin
-          ! wm=(u_star^3+c1*w_star^3)^(1/3.)
-          ! END IF
-          ! ***************************************************
-          wm(i) = ustar(i)*phiminv(i)
-          ! ===================================================================
-          ! valeurs de Dominique Lambert de la campagne SEMAPHORE :
-          ! <T'^2> = 100.T*^2; <q'^2> = 20.q*^2 a 10m
-          ! <Tv'^2> = (1+1.2q).100.T* + 1.2Tv.sqrt(20*100).T*.q* +
-          ! (.608*Tv)^2*20.q*^2;
-          ! et dTetavS = sqrt(<Tv'^2>) ainsi calculee.
-          ! avec : T*=<w'T'>_s/w* et q*=<w'q'>/w*
-          ! !!! on peut donc utiliser w* pour les fluctuations <-> Lambert
-          ! (leur corellation pourrait dependre de beta par ex)
-          ! if fcsv(i,j) gt 0 then begin
-          ! dTetavs=b1*(1.+2.*.608*q_10(i,j))*(fcs(i,j)/wm(i,j))^2+$
-          ! (.608*Thetav_10(i,j))^2*b2*(xle(i,j)/wm(i,j))^2+$
-          ! 2.*.608*thetav_10(i,j)*sqrt(b1*b2)*(xle(i,j)/wm(i,j))*(fcs(i,j)
-          ! /wm(i,j))
-          ! dqs=b2*(xle(i,j)/wm(i,j))^2
-          ! theta_s(i,j)=thetav_10(i,j)+sqrt(dTetavs)
-          ! q_s(i,j)=q_10(i,j)+sqrt(dqs)
-          ! END IF else begin
-          ! Theta_s(i,j)=thetav_10(i,j)
-          ! q_s(i,j)=q_10(i,j)
-          ! endelse
-          ! ===================================================================
-
-          ! HBTM        therm(i) = heatv(i)*fak/wm(i)
-          ! forme Mathieu :
-          q_star = kqfs(i)/wm(i)
-          t_star = khfs(i)/wm(i)
-          ! IM 091204 BEG
-          IF (1==0) THEN
-             IF (t_star<0. .OR. q_star<0.) THEN
-                PRINT *, 'i t_star q_star khfs kqfs wm', i, t_star, q_star, &
-                     khfs(i), kqfs(i), wm(i)
-             END IF
+      IF (check(i)) THEN
+        phiminv(i) = (1. - binm * pblh(i) * unsobklen(i))**onet
+        ! ***************************************************
+        ! Wm ? et W* ? c'est la formule pour z/h < .1
+        ! ;Calcul de w* ;;
+        ! ;;;;;;;;;;;;;;;;
+        ! w_star=((g/tcls)*fcsv*z(ind))^(1/3.) [ou prendre la premiere approx
+        ! de h)
+        ! ;; CALCUL DE wm ;;
+        ! ;;;;;;;;;;;;;;;;;;
+        ! ; Ici on considerera que l'on est dans la couche de surf jusqu'a
+        ! 100 m
+        ! ; On prend svt couche de surface=0.1*h mais on ne connait pas h
+        ! ;;;;;;;;;;;Dans la couche de surface
+        ! if (z(ind) le 20) then begin
+        ! Phim=(1.-15.*(z(ind)/L))^(-1/3.)
+        ! wm=u_star/Phim
+        ! ;;;;;;;;;;;En dehors de la couche de surface
+        ! END IF ELSE IF (z(ind) gt 20) then begin
+        ! wm=(u_star^3+c1*w_star^3)^(1/3.)
+        ! END IF
+        ! ***************************************************
+        wm(i) = ustar(i) * phiminv(i)
+        ! ===================================================================
+        ! valeurs de Dominique Lambert de la campagne SEMAPHORE :
+        ! <T'^2> = 100.T*^2; <q'^2> = 20.q*^2 a 10m
+        ! <Tv'^2> = (1+1.2q).100.T* + 1.2Tv.sqrt(20*100).T*.q* +
+        ! (.608*Tv)^2*20.q*^2;
+        ! et dTetavS = sqrt(<Tv'^2>) ainsi calculee.
+        ! avec : T*=<w'T'>_s/w* et q*=<w'q'>/w*
+        ! !!! on peut donc utiliser w* pour les fluctuations <-> Lambert
+        ! (leur corellation pourrait dependre de beta par ex)
+        ! if fcsv(i,j) gt 0 then begin
+        ! dTetavs=b1*(1.+2.*.608*q_10(i,j))*(fcs(i,j)/wm(i,j))^2+$
+        ! (.608*Thetav_10(i,j))^2*b2*(xle(i,j)/wm(i,j))^2+$
+        ! 2.*.608*thetav_10(i,j)*sqrt(b1*b2)*(xle(i,j)/wm(i,j))*(fcs(i,j)
+        ! /wm(i,j))
+        ! dqs=b2*(xle(i,j)/wm(i,j))^2
+        ! theta_s(i,j)=thetav_10(i,j)+sqrt(dTetavs)
+        ! q_s(i,j)=q_10(i,j)+sqrt(dqs)
+        ! END IF else begin
+        ! Theta_s(i,j)=thetav_10(i,j)
+        ! q_s(i,j)=q_10(i,j)
+        ! endelse
+        ! ===================================================================
+
+        ! HBTM        therm(i) = heatv(i)*fak/wm(i)
+        ! forme Mathieu :
+        q_star = kqfs(i) / wm(i)
+        t_star = khfs(i) / wm(i)
+        ! IM 091204 BEG
+        IF (1==0) THEN
+          IF (t_star<0. .OR. q_star<0.) THEN
+            PRINT *, 'i t_star q_star khfs kqfs wm', i, t_star, q_star, &
+                    khfs(i), kqfs(i), wm(i)
           END IF
-          ! IM 091204 END
-          ! AM Nveau cde ref 2m =>
-          ! AM        therm(i) = sqrt( b1*(1.+2.*RETV*q(i,1))*t_star**2
-          ! AM     +             + (RETV*T(i,1))**2*b2*q_star**2
-          ! AM     +             + 2.*RETV*T(i,1)*b212*q_star*t_star
-          ! AM     +                 )
-          ! IM 091204 BEG
-          a1 = b1*(1.+2.*retv*qt_th(i))*t_star**2
-          a2 = (retv*th_th(i))**2*b2*q_star*q_star
-          a3 = 2.*retv*th_th(i)*b212*q_star*t_star
-          aa = a1 + a2 + a3
-          IF (1==0) THEN
-             IF (aa<0.) THEN
-                PRINT *, 'i a1 a2 a3 aa', i, a1, a2, a3, aa
-                PRINT *, 'i qT_th Th_th t_star q_star RETV b1 b2 b212', i, &
-                     qt_th(i), th_th(i), t_star, q_star, retv, b1, b2, b212
-             END IF
+        END IF
+        ! IM 091204 END
+        ! AM Nveau cde ref 2m =>
+        ! AM        therm(i) = sqrt( b1*(1.+2.*RETV*q(i,1))*t_star**2
+        ! AM     +             + (RETV*T(i,1))**2*b2*q_star**2
+        ! AM     +             + 2.*RETV*T(i,1)*b212*q_star*t_star
+        ! AM     +                 )
+        ! IM 091204 BEG
+        a1 = b1 * (1. + 2. * retv * qt_th(i)) * t_star**2
+        a2 = (retv * th_th(i))**2 * b2 * q_star * q_star
+        a3 = 2. * retv * th_th(i) * b212 * q_star * t_star
+        aa = a1 + a2 + a3
+        IF (1==0) THEN
+          IF (aa<0.) THEN
+            PRINT *, 'i a1 a2 a3 aa', i, a1, a2, a3, aa
+            PRINT *, 'i qT_th Th_th t_star q_star RETV b1 b2 b212', i, &
+                    qt_th(i), th_th(i), t_star, q_star, retv, b1, b2, b212
           END IF
-          ! IM 091204 END
-          therm(i) = sqrt(b1*(1.+2.*retv*qt_th(i))*t_star**2+(retv*th_th( &
-               i))**2*b2*q_star*q_star &  ! IM 101204  +             +
-                                ! 2.*RETV*Th_th(i)*b212*q_star*t_star
-               +max(0.,2.*retv*th_th(i)*b212*q_star*t_star))
-
-          ! Theta et qT du thermique (forme H&B) avec exces
-          ! (attention, on ajoute therm(i) qui est virtuelle ...)
-          ! pourquoi pas sqrt(b1)*t_star ?
-          ! dqs = b2sr*kqfs(i)/wm(i)
-          qt_th(i) = qt_th(i) + b2sr*q_star
-          ! new on differre le calcul de Theta_e
-          ! The_th(i) = The_th(i) + therm(i) + RLvCp*qT_th(i)
-          ! ou:    The_th(i) = The_th(i) + sqrt(b1)*khfs(i)/wm(i) +
-          ! RLvCp*qT_th(i)
-          rhino(i, 1) = 0.0
-       END IF
+        END IF
+        ! IM 091204 END
+        therm(i) = sqrt(b1 * (1. + 2. * retv * qt_th(i)) * t_star**2 + (retv * th_th(&
+                i))**2 * b2 * q_star * q_star &  ! IM 101204  +             +
+                ! 2.*RETV*Th_th(i)*b212*q_star*t_star
+                + max(0., 2. * retv * th_th(i) * b212 * q_star * t_star))
+
+        ! Theta et qT du thermique (forme H&B) avec exces
+        ! (attention, on ajoute therm(i) qui est virtuelle ...)
+        ! pourquoi pas sqrt(b1)*t_star ?
+        ! dqs = b2sr*kqfs(i)/wm(i)
+        qt_th(i) = qt_th(i) + b2sr * q_star
+        ! new on differre le calcul de Theta_e
+        ! The_th(i) = The_th(i) + therm(i) + RLvCp*qT_th(i)
+        ! ou:    The_th(i) = The_th(i) + sqrt(b1)*khfs(i)/wm(i) +
+        ! RLvCp*qT_th(i)
+        rhino(i, 1) = 0.0
+      END IF
     END DO
 
@@ -504,58 +497,57 @@
 
     DO k = 2, isommet
-       DO i = 1, knon
-          IF (check(i)) THEN
-             ! test     zdu2 =
-             ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
-             zdu2 = u(i, k)**2 + v(i, k)**2
-             zdu2 = max(zdu2, 1.0E-20)
-             ! Theta_v environnement
-             zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
-
-             ! et therm Theta_v (avec hypothese de constance de H&B,
-             ! zthvu=(t(i,1)+therm(i))/s(i,1)*(1.+RETV*q(i,1))
-             zthvu = th_th(i)*(1.+retv*qt_th(i)) + therm(i)
-
-
-             ! Le Ri par Theta_v
-             ! AM Niveau de ref 2m
-             ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
-             ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
-             rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5&
-                  *(zthvd+zthvu))
-
-
-             IF (rhino(i,k)>=ricr) THEN
-                pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))&
-                     /(rhino(i,k-1)-rhino(i,k))
-                ! test04
-                pblh(i) = pblh(i) + 100.
-                pblt(i) = t(i, k-1) + (t(i,k)-t(i,k-1))*(pblh(i)-z(i,k-1))&
-                     /(z(i,k)- z(i,k-1))
-                check(i) = .FALSE.
-                ! IM 170305 BEG
-                IF (1==0) THEN
-                   ! debug print -120;34       -34-        58 et    0;26 wamp
-                   IF (i==950 .OR. i==192 .OR. i==624 .OR. i==118) THEN
-                      PRINT *, ' i,Th_th,Therm,qT :', i, th_th(i), therm(i), &
-                           qt_th(i)
-                      q_star = kqfs(i)/wm(i)
-                      t_star = khfs(i)/wm(i)
-                      PRINT *, 'q* t*, b1,b2,b212 ', q_star, t_star, &
-                           b1*(1.+2.*retv*qt_th(i))*t_star**2, &
-                           (retv*th_th(i))**2*b2*q_star**2, 2.*retv*th_th(i)&
-                           *b212*q_star *t_star
-                      PRINT *, 'zdu2 ,100.*ustar(i)**2', zdu2, fac*ustar(i)**2
-                   END IF
-                END IF !(1.EQ.0) THEN
-                ! IM 170305 END
-                ! q_star = kqfs(i)/wm(i)
-                ! t_star = khfs(i)/wm(i)
-                ! trmb1(i) = b1*(1.+2.*RETV*q(i,1))*t_star**2
-                ! trmb2(i) = (RETV*T(i,1))**2*b2*q_star**2
-                ! Omega now   trmb3(i) = 2.*RETV*T(i,1)*b212*q_star*t_star
-             END IF
+      DO i = 1, knon
+        IF (check(i)) THEN
+          ! test     zdu2 =
+          ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
+          zdu2 = u(i, k)**2 + v(i, k)**2
+          zdu2 = max(zdu2, 1.0E-20)
+          ! Theta_v environnement
+          zthvd = t(i, k) / s(i, k) * (1. + retv * q(i, k))
+
+          ! et therm Theta_v (avec hypothese de constance de H&B,
+          ! zthvu=(t(i,1)+therm(i))/s(i,1)*(1.+RETV*q(i,1))
+          zthvu = th_th(i) * (1. + retv * qt_th(i)) + therm(i)
+
+
+          ! Le Ri par Theta_v
+          ! AM Niveau de ref 2m
+          ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
+          ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
+          rhino(i, k) = (z(i, k) - zref) * rg * (zthvd - zthvu) / (zdu2 * 0.5&
+                  * (zthvd + zthvu))
+
+          IF (rhino(i, k)>=ricr) THEN
+            pblh(i) = z(i, k - 1) + (z(i, k - 1) - z(i, k)) * (ricr - rhino(i, k - 1))&
+                    / (rhino(i, k - 1) - rhino(i, k))
+            ! test04
+            pblh(i) = pblh(i) + 100.
+            pblt(i) = t(i, k - 1) + (t(i, k) - t(i, k - 1)) * (pblh(i) - z(i, k - 1))&
+                    / (z(i, k) - z(i, k - 1))
+            check(i) = .FALSE.
+            ! IM 170305 BEG
+            IF (1==0) THEN
+              ! debug print -120;34       -34-        58 et    0;26 wamp
+              IF (i==950 .OR. i==192 .OR. i==624 .OR. i==118) THEN
+                PRINT *, ' i,Th_th,Therm,qT :', i, th_th(i), therm(i), &
+                        qt_th(i)
+                q_star = kqfs(i) / wm(i)
+                t_star = khfs(i) / wm(i)
+                PRINT *, 'q* t*, b1,b2,b212 ', q_star, t_star, &
+                        b1 * (1. + 2. * retv * qt_th(i)) * t_star**2, &
+                        (retv * th_th(i))**2 * b2 * q_star**2, 2. * retv * th_th(i)&
+                        * b212 * q_star * t_star
+                PRINT *, 'zdu2 ,100.*ustar(i)**2', zdu2, fac * ustar(i)**2
+              END IF
+            END IF !(1.EQ.0) THEN
+            ! IM 170305 END
+            ! q_star = kqfs(i)/wm(i)
+            ! t_star = khfs(i)/wm(i)
+            ! trmb1(i) = b1*(1.+2.*RETV*q(i,1))*t_star**2
+            ! trmb2(i) = (RETV*T(i,1))**2*b2*q_star**2
+            ! Omega now   trmb3(i) = 2.*RETV*T(i,1)*b212*q_star*t_star
           END IF
-       END DO
+        END IF
+      END DO
     END DO
 
@@ -564,5 +556,5 @@
 
     DO i = 1, knon
-       IF (check(i)) pblh(i) = z(i, isommet)
+      IF (check(i)) pblh(i) = z(i, isommet)
     END DO
 
@@ -579,8 +571,8 @@
 
     DO i = 1, knon
-       pblmin = 700.0*ustar(i)
-       pblh(i) = max(pblh(i), pblmin)
-       ! par exemple :
-       pblt(i) = t(i, 2) + (t(i,3)-t(i,2))*(pblh(i)-z(i,2))/(z(i,3)-z(i,2))
+      pblmin = 700.0 * ustar(i)
+      pblh(i) = max(pblh(i), pblmin)
+      ! par exemple :
+      pblt(i) = t(i, 2) + (t(i, 3) - t(i, 2)) * (pblh(i) - z(i, 2)) / (z(i, 3) - z(i, 2))
     END DO
 
@@ -589,37 +581,37 @@
     ! ********************************************************************
     DO i = 1, knon
-       check(i) = .TRUE.
-       zsat(i) = .FALSE.
-       ! omegafl utilise pour prolongement CAPE
-       omegafl(i) = .FALSE.
-       cape(i) = 0.
-       kape(i) = 0.
-       eauliq(i) = 0.
-       ctei(i) = 0.
-       pblk(i) = 0.0
-       fak1(i) = ustar(i)*pblh(i)*vk
-
-       ! Do additional preparation for unstable cases only, set temperature
-       ! and moisture perturbations depending on stability.
-       ! *** Rq: les formule sont prises dans leur forme CS ***
-       IF (unstbl(i)) THEN
-          ! AM Niveau de ref du thermique
-          ! AM          zxt=(t(i,1)-z(i,1)*0.5*RG/RCPD/(1.+RVTMP2*q(i,1)))
-          ! AM     .         *(1.+RETV*q(i,1))
-          zxt = (th_th(i)-zref*0.5*rg/rcpd/(1.+rvtmp2*qt_th(i)))* &
-               (1.+retv*qt_th(i))
-          phiminv(i) = (1.-binm*pblh(i)*unsobklen(i))**onet
-          phihinv(i) = sqrt(1.-binh*pblh(i)*unsobklen(i))
-          wm(i) = ustar(i)*phiminv(i)
-          fak2(i) = wm(i)*pblh(i)*vk
-          wstar(i) = (heatv(i)*rg*pblh(i)/zxt)**onet
-          fak3(i) = fakn*wstar(i)/wm(i)
-       ELSE
-          wstar(i) = 0.
-       END IF
-       ! Computes Theta_e for thermal (all cases : to be modified)
-       ! attention ajout therm(i) = virtuelle
-       the_th(i) = th_th(i) + therm(i) + rlvcp*qt_th(i)
-       ! ou:    The_th(i) = Th_th(i) + sqrt(b1)*khfs(i)/wm(i) + RLvCp*qT_th(i)
+      check(i) = .TRUE.
+      zsat(i) = .FALSE.
+      ! omegafl utilise pour prolongement CAPE
+      omegafl(i) = .FALSE.
+      cape(i) = 0.
+      kape(i) = 0.
+      eauliq(i) = 0.
+      ctei(i) = 0.
+      pblk(i) = 0.0
+      fak1(i) = ustar(i) * pblh(i) * vk
+
+      ! Do additional preparation for unstable cases only, set temperature
+      ! and moisture perturbations depending on stability.
+      ! *** Rq: les formule sont prises dans leur forme CS ***
+      IF (unstbl(i)) THEN
+        ! AM Niveau de ref du thermique
+        ! AM          zxt=(t(i,1)-z(i,1)*0.5*RG/RCPD/(1.+RVTMP2*q(i,1)))
+        ! AM     .         *(1.+RETV*q(i,1))
+        zxt = (th_th(i) - zref * 0.5 * rg / rcpd / (1. + rvtmp2 * qt_th(i))) * &
+                (1. + retv * qt_th(i))
+        phiminv(i) = (1. - binm * pblh(i) * unsobklen(i))**onet
+        phihinv(i) = sqrt(1. - binh * pblh(i) * unsobklen(i))
+        wm(i) = ustar(i) * phiminv(i)
+        fak2(i) = wm(i) * pblh(i) * vk
+        wstar(i) = (heatv(i) * rg * pblh(i) / zxt)**onet
+        fak3(i) = fakn * wstar(i) / wm(i)
+      ELSE
+        wstar(i) = 0.
+      END IF
+      ! Computes Theta_e for thermal (all cases : to be modified)
+      ! attention ajout therm(i) = virtuelle
+      the_th(i) = th_th(i) + therm(i) + rlvcp * qt_th(i)
+      ! ou:    The_th(i) = Th_th(i) + sqrt(b1)*khfs(i)/wm(i) + RLvCp*qT_th(i)
     END DO
 
@@ -629,137 +621,137 @@
     DO k = 2, isommet
 
-       ! Find levels within boundary layer:
-
-       DO i = 1, knon
-          unslev(i) = .FALSE.
-          stblev(i) = .FALSE.
-          zm(i) = z(i, k-1)
-          zp(i) = z(i, k)
-          IF (zkmin==0.0 .AND. zp(i)>pblh(i)) zp(i) = pblh(i)
-          IF (zm(i)<pblh(i)) THEN
-             zmzp = 0.5*(zm(i)+zp(i))
-             ! debug
-             ! if (i.EQ.1864) THEN
-             ! PRINT*,'i,pblh(1864),obklen(1864)',i,pblh(i),obklen(i)
-             ! END IF
-
-             zh(i) = zmzp/pblh(i)
-             zl(i) = zmzp*unsobklen(i)
-             zzh(i) = 0.
-             IF (zh(i)<=1.0) zzh(i) = (1.-zh(i))**2
-
-             ! stblev for points zm < plbh and stable and neutral
-             ! unslev for points zm < plbh and unstable
-
-             IF (unstbl(i)) THEN
-                unslev(i) = .TRUE.
-             ELSE
-                stblev(i) = .TRUE.
-             END IF
+      ! Find levels within boundary layer:
+
+      DO i = 1, knon
+        unslev(i) = .FALSE.
+        stblev(i) = .FALSE.
+        zm(i) = z(i, k - 1)
+        zp(i) = z(i, k)
+        IF (zkmin==0.0 .AND. zp(i)>pblh(i)) zp(i) = pblh(i)
+        IF (zm(i)<pblh(i)) THEN
+          zmzp = 0.5 * (zm(i) + zp(i))
+          ! debug
+          ! if (i.EQ.1864) THEN
+          ! PRINT*,'i,pblh(1864),obklen(1864)',i,pblh(i),obklen(i)
+          ! END IF
+
+          zh(i) = zmzp / pblh(i)
+          zl(i) = zmzp * unsobklen(i)
+          zzh(i) = 0.
+          IF (zh(i)<=1.0) zzh(i) = (1. - zh(i))**2
+
+          ! stblev for points zm < plbh and stable and neutral
+          ! unslev for points zm < plbh and unstable
+
+          IF (unstbl(i)) THEN
+            unslev(i) = .TRUE.
+          ELSE
+            stblev(i) = .TRUE.
           END IF
-       END DO
-       ! PRINT*,'fin calcul niveaux'
-
-       ! Stable and neutral points; set diffusivities; counter-gradient
-       ! terms zero for stable case:
-
-       DO i = 1, knon
-          IF (stblev(i)) THEN
-             IF (zl(i)<=1.) THEN
-                pblk(i) = fak1(i)*zh(i)*zzh(i)/(1.+betas*zl(i))
-             ELSE
-                pblk(i) = fak1(i)*zh(i)*zzh(i)/(betas+zl(i))
-             END IF
-             ! pcfm(i,k) = pblk(i)
-             ! pcfh(i,k) = pcfm(i,k)
+        END IF
+      END DO
+      ! PRINT*,'fin calcul niveaux'
+
+      ! Stable and neutral points; set diffusivities; counter-gradient
+      ! terms zero for stable case:
+
+      DO i = 1, knon
+        IF (stblev(i)) THEN
+          IF (zl(i)<=1.) THEN
+            pblk(i) = fak1(i) * zh(i) * zzh(i) / (1. + betas * zl(i))
+          ELSE
+            pblk(i) = fak1(i) * zh(i) * zzh(i) / (betas + zl(i))
           END IF
-       END DO
-
-       ! unssrf, unstable within surface layer of pbl
-       ! unsout, unstable within outer   layer of pbl
-
-       DO i = 1, knon
-          unssrf(i) = .FALSE.
-          unsout(i) = .FALSE.
-          IF (unslev(i)) THEN
-             IF (zh(i)<sffrac) THEN
-                unssrf(i) = .TRUE.
-             ELSE
-                unsout(i) = .TRUE.
-             END IF
+          ! pcfm(i,k) = pblk(i)
+          ! pcfh(i,k) = pcfm(i,k)
+        END IF
+      END DO
+
+      ! unssrf, unstable within surface layer of pbl
+      ! unsout, unstable within outer   layer of pbl
+
+      DO i = 1, knon
+        unssrf(i) = .FALSE.
+        unsout(i) = .FALSE.
+        IF (unslev(i)) THEN
+          IF (zh(i)<sffrac) THEN
+            unssrf(i) = .TRUE.
+          ELSE
+            unsout(i) = .TRUE.
           END IF
-       END DO
-
-       ! Unstable for surface layer; counter-gradient terms zero
-
-       DO i = 1, knon
-          IF (unssrf(i)) THEN
-             term = (1.-betam*zl(i))**onet
-             pblk(i) = fak1(i)*zh(i)*zzh(i)*term
-             pr(i) = term/sqrt(1.-betah*zl(i))
+        END IF
+      END DO
+
+      ! Unstable for surface layer; counter-gradient terms zero
+
+      DO i = 1, knon
+        IF (unssrf(i)) THEN
+          term = (1. - betam * zl(i))**onet
+          pblk(i) = fak1(i) * zh(i) * zzh(i) * term
+          pr(i) = term / sqrt(1. - betah * zl(i))
+        END IF
+      END DO
+      ! PRINT*,'fin counter-gradient terms zero'
+
+      ! Unstable for outer layer; counter-gradient terms non-zero:
+
+      DO i = 1, knon
+        IF (unsout(i)) THEN
+          pblk(i) = fak2(i) * zh(i) * zzh(i)
+          ! cgs(i,k) = fak3(i)/(pblh(i)*wm(i))
+          ! cgh(i,k) = khfs(i)*cgs(i,k)
+          pr(i) = phiminv(i) / phihinv(i) + ccon * fak3(i) / fak
+          ! cgq(i,k) = kqfs(i)*cgs(i,k)
+        END IF
+      END DO
+      ! PRINT*,'fin counter-gradient terms non zero'
+
+      ! For all unstable layers, compute diffusivities and ctrgrad ter m
+
+      ! DO i = 1, knon
+      ! IF (unslev(i)) THEN
+      ! pcfm(i,k) = pblk(i)
+      ! pcfh(i,k) = pblk(i)/pr(i)
+      ! etc cf original
+      ! ENDIF
+      ! ENDDO
+
+      ! For all layers, compute integral info and CTEI
+
+      DO i = 1, knon
+        IF (check(i) .OR. omegafl(i)) THEN
+          IF (.NOT. zsat(i)) THEN
+            ! Th2 = The_th(i) - RLvCp*qT_th(i)
+            th2 = th_th(i)
+            t2 = th2 * s(i, k)
+            ! thermodyn functions
+            zdelta = max(0., sign(1., rtt - t2))
+            qqsat = r2es * foeew(t2, zdelta) / pplay(i, k)
+            qqsat = min(0.5, qqsat)
+            zcor = 1. / (1. - retv * qqsat)
+            qqsat = qqsat * zcor
+
+            IF (qqsat<qt_th(i)) THEN
+              ! on calcule lcl
+              IF (k==2) THEN
+                plcl(i) = z(i, k)
+              ELSE
+                plcl(i) = z(i, k - 1) + (z(i, k - 1) - z(i, k)) * (qt_th(i)&
+                        - qsatbef(i)) / (qsatbef(i) - qqsat)
+              END IF
+              zsat(i) = .TRUE.
+              tbef(i) = t2
+            END IF
+
+            qsatbef(i) = qqsat ! bug dans la version orig ???
           END IF
-       END DO
-       ! PRINT*,'fin counter-gradient terms zero'
-
-       ! Unstable for outer layer; counter-gradient terms non-zero:
-
-       DO i = 1, knon
-          IF (unsout(i)) THEN
-             pblk(i) = fak2(i)*zh(i)*zzh(i)
-             ! cgs(i,k) = fak3(i)/(pblh(i)*wm(i))
-             ! cgh(i,k) = khfs(i)*cgs(i,k)
-             pr(i) = phiminv(i)/phihinv(i) + ccon*fak3(i)/fak
-             ! cgq(i,k) = kqfs(i)*cgs(i,k)
-          END IF
-       END DO
-       ! PRINT*,'fin counter-gradient terms non zero'
-
-       ! For all unstable layers, compute diffusivities and ctrgrad ter m
-
-       ! DO i = 1, knon
-       ! IF (unslev(i)) THEN
-       ! pcfm(i,k) = pblk(i)
-       ! pcfh(i,k) = pblk(i)/pr(i)
-       ! etc cf original
-       ! ENDIF
-       ! ENDDO
-
-       ! For all layers, compute integral info and CTEI
-
-       DO i = 1, knon
-          IF (check(i) .OR. omegafl(i)) THEN
-             IF (.NOT. zsat(i)) THEN
-                ! Th2 = The_th(i) - RLvCp*qT_th(i)
-                th2 = th_th(i)
-                t2 = th2*s(i, k)
-                ! thermodyn functions
-                zdelta = max(0., sign(1.,rtt-t2))
-                qqsat = r2es*foeew(t2, zdelta)/pplay(i, k)
-                qqsat = min(0.5, qqsat)
-                zcor = 1./(1.-retv*qqsat)
-                qqsat = qqsat*zcor
-
-                IF (qqsat<qt_th(i)) THEN
-                   ! on calcule lcl
-                   IF (k==2) THEN
-                      plcl(i) = z(i, k)
-                   ELSE
-                      plcl(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(qt_th(i)&
-                           -qsatbef(i))/(qsatbef(i)-qqsat)
-                   END IF
-                   zsat(i) = .TRUE.
-                   tbef(i) = t2
-                END IF
-
-                qsatbef(i) = qqsat ! bug dans la version orig ???
-             END IF
-             ! amn ???? cette ligne a deja ete faite normalement ?
-          END IF
-          ! PRINT*,'hbtm2 i,k=',i,k
-       END DO
+          ! amn ???? cette ligne a deja ete faite normalement ?
+        END IF
+        ! PRINT*,'hbtm2 i,k=',i,k
+      END DO
     END DO ! end of level loop
     ! IM 170305 BEG
     IF (1==0) THEN
-       PRINT *, 'hbtm2  ok'
+      PRINT *, 'hbtm2  ok'
     END IF !(1.EQ.0) THEN
     ! IM 170305 END
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90	(revision 5143)
@@ -14,7 +14,9 @@
 
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
-  include "YOEGWD.h"
   include "YOMCST.h"
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ice_sursat_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ice_sursat_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ice_sursat_mod.F90	(revision 5143)
@@ -1,906 +1,904 @@
 MODULE ice_sursat_mod
 
-IMPLICIT NONE
-
-!--flight inventories
-
-REAL, SAVE, ALLOCATABLE :: flight_m(:,:)    !--flown distance m s-1 per cell
-!$OMP THREADPRIVATE(flight_m)
-REAL, SAVE, ALLOCATABLE :: flight_h2o(:,:)  !--emitted kg H2O s-1 per cell
-!$OMP THREADPRIVATE(flight_h2o)
-
-!--Fixed Parameters
-
-!--safety parameters for ERF function
-REAL, PARAMETER :: erf_lim = 5., eps = 1.e-10
-
-!--Tuning parameters (and their default values)
-
-!--chi gère la répartition statistique de la longueur des frontières
-!  entre les zones nuages et ISSR/ciel clair sous-saturé. Gamme de valeur :
-!  chi > 1, je n'ai pas regardé de limite max (pour chi = 1, la longueur de
-!  la frontière entre ne nuage et l'ISSR est proportionnelle à la
-!  répartition ISSR/ciel clair sous-sat dans la maille, i.e. il n'y a pas
-!  de favorisation de la localisation de l'ISSR près de nuage. Pour chi = inf, 
-!  le nuage n'est en contact qu'avec de l'ISSR, quelle que soit la taille 
-!  de l'ISSR dans la maille.)
-
-!--l_turb est la longueur de mélange pour la turbulence. 
-!  dans les tests, ça n'a jamais été modifié pour l'instant. 
-
-!--tun_N est le paramètre qui contrôle l'importance relative de N_2 par rapport à N_1. 
-!  La valeur est comprise entre 1 et 2 (tun_N = 1 => N_1 = N_2)
-
-!--tun_ratqs : paramètre qui modifie ratqs en fonction de la valeur de
-!  alpha_cld selon la formule ratqs_new = ratqs_old / ( 1 + tun_ratqs *
-!  alpha_cld ). Dans le rapport il est appelé beta. Il varie entre 0 et 5
-!  (tun_ratqs = 0 => pas de modification de ratqs).
-
-!--gamma0 and Tgamma: define RHcrit limit above which heterogeneous freezing occurs as a function of T
-!--Karcher and Lohmann (2002)
-!--gamma = 2.583 - t / 207.83
-!--Ren and MacKenzie (2005) reused by Kärcher
-!--gamma = 2.349 - t / 259.0
-
-!--N_cld: number of clouds in cell (needs to be parametrized at some point)
-
-!--contrail cross section: typical value found in Freudenthaler et al, GRL, 22, 3501-3504, 1995
-!--in m2, 1000x200 = 200 000 m2 after 15 min
-
-REAL, SAVE :: chi=1.1, l_turb=50.0, tun_N=1.3, tun_ratqs=3.0
-REAL, SAVE :: gamma0=2.349, Tgamma=259.0, N_cld=100, contrail_cross_section=200000.0
-!$OMP THREADPRIVATE(chi,l_turb,tun_N,tun_ratqs,gamma0,Tgamma,N_cld,contrail_cross_section)
+  IMPLICIT NONE
+
+  !--flight inventories
+
+  REAL, SAVE, ALLOCATABLE :: flight_m(:, :)    !--flown distance m s-1 per cell
+  !$OMP THREADPRIVATE(flight_m)
+  REAL, SAVE, ALLOCATABLE :: flight_h2o(:, :)  !--emitted kg H2O s-1 per cell
+  !$OMP THREADPRIVATE(flight_h2o)
+
+  !--Fixed Parameters
+
+  !--safety parameters for ERF function
+  REAL, PARAMETER :: erf_lim = 5., eps = 1.e-10
+
+  !--Tuning parameters (and their default values)
+
+  !--chi gère la répartition statistique de la longueur des frontières
+  !  entre les zones nuages et ISSR/ciel clair sous-saturé. Gamme de valeur :
+  !  chi > 1, je n'ai pas regardé de limite max (pour chi = 1, la longueur de
+  !  la frontière entre ne nuage et l'ISSR est proportionnelle à la
+  !  répartition ISSR/ciel clair sous-sat dans la maille, i.e. il n'y a pas
+  !  de favorisation de la localisation de l'ISSR près de nuage. Pour chi = inf,
+  !  le nuage n'est en contact qu'avec de l'ISSR, quelle que soit la taille
+  !  de l'ISSR dans la maille.)
+
+  !--l_turb est la longueur de mélange pour la turbulence.
+  !  dans les tests, ça n'a jamais été modifié pour l'instant.
+
+  !--tun_N est le paramètre qui contrôle l'importance relative de N_2 par rapport à N_1.
+  !  La valeur est comprise entre 1 et 2 (tun_N = 1 => N_1 = N_2)
+
+  !--tun_ratqs : paramètre qui modifie ratqs en fonction de la valeur de
+  !  alpha_cld selon la formule ratqs_new = ratqs_old / ( 1 + tun_ratqs *
+  !  alpha_cld ). Dans le rapport il est appelé beta. Il varie entre 0 et 5
+  !  (tun_ratqs = 0 => pas de modification de ratqs).
+
+  !--gamma0 and Tgamma: define RHcrit limit above which heterogeneous freezing occurs as a function of T
+  !--Karcher and Lohmann (2002)
+  !--gamma = 2.583 - t / 207.83
+  !--Ren and MacKenzie (2005) reused by Kärcher
+  !--gamma = 2.349 - t / 259.0
+
+  !--N_cld: number of clouds in cell (needs to be parametrized at some point)
+
+  !--contrail cross section: typical value found in Freudenthaler et al, GRL, 22, 3501-3504, 1995
+  !--in m2, 1000x200 = 200 000 m2 after 15 min
+
+  REAL, SAVE :: chi = 1.1, l_turb = 50.0, tun_N = 1.3, tun_ratqs = 3.0
+  REAL, SAVE :: gamma0 = 2.349, Tgamma = 259.0, N_cld = 100, contrail_cross_section = 200000.0
+  !$OMP THREADPRIVATE(chi,l_turb,tun_N,tun_ratqs,gamma0,Tgamma,N_cld,contrail_cross_section)
 
 CONTAINS
 
-!*******************************************************************
-
-SUBROUTINE ice_sursat_init()
-
-  USE lmdz_print_control, ONLY: lunout
-  USE lmdz_ioipsl_getin_p, ONLY: getin_p
-
-  IMPLICIT NONE
-
-  CALL getin_p('flag_chi',chi)
-  CALL getin_p('flag_l_turb',l_turb)
-  CALL getin_p('flag_tun_N',tun_N)
-  CALL getin_p('flag_tun_ratqs',tun_ratqs)
-  CALL getin_p('gamma0',gamma0)
-  CALL getin_p('Tgamma',Tgamma)
-  CALL getin_p('N_cld',N_cld)
-  CALL getin_p('contrail_cross_section',contrail_cross_section)
-
-  WRITE(lunout,*) 'Parameters for ice_sursat param'
-  WRITE(lunout,*) 'flag_chi = ', chi
-  WRITE(lunout,*) 'flag_l_turb = ', l_turb
-  WRITE(lunout,*) 'flag_tun_N = ', tun_N
-  WRITE(lunout,*) 'flag_tun_ratqs = ', tun_ratqs
-  WRITE(lunout,*) 'gamma0 = ', gamma0
-  WRITE(lunout,*) 'Tgamma = ', Tgamma
-  WRITE(lunout,*) 'N_cld = ', N_cld
-  WRITE(lunout,*) 'contrail_cross_section = ', contrail_cross_section
-
-END SUBROUTINE ice_sursat_init
-
-!*******************************************************************
-
-SUBROUTINE airplane(debut,pphis,pplay,paprs,t_seri)
-
-  USE dimphy
-  USE lmdz_grid_phy,  ONLY: klon_glo
-  USE lmdz_geometry, ONLY: cell_area
-  USE phys_cal_mod, ONLY: mth_cur
-  USE lmdz_phys_mpi_data, ONLY: is_mpi_root
-  USE lmdz_phys_omp_data, ONLY: is_omp_root
-  USE lmdz_phys_para, ONLY: scatter, bcast
-  USE lmdz_print_control, ONLY: lunout
-  USE netcdf, ONLY: nf90_get_var, nf90_inq_varid, nf90_inquire_dimension, nf90_inq_dimid, &
-      nf90_open, nf90_noerr
-  USE lmdz_abort_physic, ONLY: abort_physic
-
-  IMPLICIT NONE
-
-  INCLUDE "YOMCST.h"
-
-  !--------------------------------------------------------
-  !--input variables 
-  !--------------------------------------------------------
-  LOGICAL, INTENT(IN) :: debut
-  REAL, INTENT(IN)    :: pphis(klon), pplay(klon,klev), paprs(klon,klev+1), t_seri(klon,klev)
-
-  !--------------------------------------------------------
-  !	... Local variables
-  !--------------------------------------------------------
-
-  CHARACTER (LEN=20) :: modname='airplane_mod'
-  INTEGER :: i, k, kori, iret, varid, error, ncida, klona
-  INTEGER,SAVE :: nleva, ntimea
-!$OMP THREADPRIVATE(nleva,ntimea)
-  REAL, ALLOCATABLE :: pkm_airpl_glo(:,:,:)    !--km/s
-  REAL, ALLOCATABLE :: ph2o_airpl_glo(:,:,:)   !--molec H2O/cm3/s
-  REAL, ALLOCATABLE, SAVE :: zmida(:), zinta(:)
-  REAL, ALLOCATABLE, SAVE :: pkm_airpl(:,:,:)
-  REAL, ALLOCATABLE, SAVE :: ph2o_airpl(:,:,:)
-!$OMP THREADPRIVATE(pkm_airpl,ph2o_airpl,zmida,zinta)
-  REAL :: zalt(klon,klev+1)
-  REAL :: zrho, zdz(klon,klev), zfrac
-
-  IF (debut) THEN
-  !--------------------------------------------------------------------------------
-  !       ... Open the file and read airplane emissions
-  !--------------------------------------------------------------------------------
-
-  IF (is_mpi_root .AND. is_omp_root) THEN
-
-      iret = nf90_open('aircraft_phy.nc', 0, ncida)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to open aircraft_phy.nc file',1)
-      ! ... Get lengths
-      iret = nf90_inq_dimid(ncida, 'time', varid)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get time dimid in aircraft_phy.nc file',1)
-      iret = nf90_inquire_dimension(ncida, varid,len= ntimea)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get time dimlen aircraft_phy.nc file',1)
-      iret = nf90_inq_dimid(ncida, 'vector', varid)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get vector dimid aircraft_phy.nc file',1)
-      iret = nf90_inquire_dimension(ncida, varid,len= klona)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get vector dimlen aircraft_phy.nc file',1)
-      iret = nf90_inq_dimid(ncida, 'lev', varid)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get lev dimid aircraft_phy.nc file',1)
-      iret = nf90_inquire_dimension(ncida, varid,len= nleva)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get lev dimlen aircraft_phy.nc file',1)
-
-      IF ( klona /= klon_glo ) THEN
-        WRITE(lunout,*) 'klona & klon_glo =', klona, klon_glo
-        CALL abort_physic(modname,'problem klon in aircraft_phy.nc file',1)
-      ENDIF
-
-      IF ( ntimea /= 12 ) THEN
-        WRITE(lunout,*) 'ntimea=', ntimea
-        CALL abort_physic(modname,'problem ntime<>12 in aircraft_phy.nc file',1)
-      ENDIF
-
-      ALLOCATE(zmida(nleva), STAT=error)
-      IF (error /= 0) CALL abort_physic(modname,'problem to allocate zmida',1)
-      ALLOCATE(pkm_airpl_glo(klona,nleva,ntimea), STAT=error)
-      IF (error /= 0) CALL abort_physic(modname,'problem to allocate pkm_airpl_glo',1)
-      ALLOCATE(ph2o_airpl_glo(klona,nleva,ntimea), STAT=error)
-      IF (error /= 0) CALL abort_physic(modname,'problem to allocate ph2o_airpl_glo',1)
-
-      iret = nf90_inq_varid(ncida, 'lev', varid)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get lev dimid aircraft_phy.nc file',1)
-      iret = nf90_get_var(ncida, varid, zmida)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to read zmida file',1)
-
-      iret = nf90_inq_varid(ncida, 'emi_co2_aircraft', varid)  !--CO2 as a proxy for m flown -
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get emi_distance dimid aircraft_phy.nc file',1)
-      iret = nf90_get_var(ncida, varid, pkm_airpl_glo)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to read pkm_airpl file',1)
-
-      iret = nf90_inq_varid(ncida, 'emi_h2o_aircraft', varid)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to get emi_h2o_aircraft dimid aircraft_phy.nc file',1)
-      iret = nf90_get_var(ncida, varid, ph2o_airpl_glo)
-      IF (iret /= nf90_noerr) CALL abort_physic(modname,'problem to read ph2o_airpl file',1)
-
-     ENDIF    !--is_mpi_root and is_omp_root
-
-     CALL bcast(nleva)
-     CALL bcast(ntimea)
-
-     IF (.NOT.ALLOCATED(zmida)) ALLOCATE(zmida(nleva), STAT=error)
-     IF (.NOT.ALLOCATED(zinta)) ALLOCATE(zinta(nleva+1), STAT=error)
-
-     ALLOCATE(pkm_airpl(klon,nleva,ntimea))
-     ALLOCATE(ph2o_airpl(klon,nleva,ntimea))
-
-     ALLOCATE(flight_m(klon,klev))
-     ALLOCATE(flight_h2o(klon,klev))
-
-     CALL bcast(zmida)
-     zinta(1)=0.0                                   !--surface
-     DO k=2, nleva
-       zinta(k) = (zmida(k-1)+zmida(k))/2.0*1000.0  !--conversion from km to m
-     ENDDO
-     zinta(nleva+1)=zinta(nleva)+(zmida(nleva)-zmida(nleva-1))*1000.0 !--extrapolation for last interface
-     !print *,'zinta=', zinta
-
-     CALL scatter(pkm_airpl_glo,pkm_airpl)
-     CALL scatter(ph2o_airpl_glo,ph2o_airpl)
-
-!$OMP MASTER
-     IF (is_mpi_root .AND. is_omp_root) THEN
+  !*******************************************************************
+
+  SUBROUTINE ice_sursat_init()
+
+    USE lmdz_print_control, ONLY: lunout
+    USE lmdz_ioipsl_getin_p, ONLY: getin_p
+
+    IMPLICIT NONE
+
+    CALL getin_p('flag_chi', chi)
+    CALL getin_p('flag_l_turb', l_turb)
+    CALL getin_p('flag_tun_N', tun_N)
+    CALL getin_p('flag_tun_ratqs', tun_ratqs)
+    CALL getin_p('gamma0', gamma0)
+    CALL getin_p('Tgamma', Tgamma)
+    CALL getin_p('N_cld', N_cld)
+    CALL getin_p('contrail_cross_section', contrail_cross_section)
+
+    WRITE(lunout, *) 'Parameters for ice_sursat param'
+    WRITE(lunout, *) 'flag_chi = ', chi
+    WRITE(lunout, *) 'flag_l_turb = ', l_turb
+    WRITE(lunout, *) 'flag_tun_N = ', tun_N
+    WRITE(lunout, *) 'flag_tun_ratqs = ', tun_ratqs
+    WRITE(lunout, *) 'gamma0 = ', gamma0
+    WRITE(lunout, *) 'Tgamma = ', Tgamma
+    WRITE(lunout, *) 'N_cld = ', N_cld
+    WRITE(lunout, *) 'contrail_cross_section = ', contrail_cross_section
+
+  END SUBROUTINE ice_sursat_init
+
+  !*******************************************************************
+
+  SUBROUTINE airplane(debut, pphis, pplay, paprs, t_seri)
+
+    USE dimphy
+    USE lmdz_grid_phy, ONLY: klon_glo
+    USE lmdz_geometry, ONLY: cell_area
+    USE phys_cal_mod, ONLY: mth_cur
+    USE lmdz_phys_mpi_data, ONLY: is_mpi_root
+    USE lmdz_phys_omp_data, ONLY: is_omp_root
+    USE lmdz_phys_para, ONLY: scatter, bcast
+    USE lmdz_print_control, ONLY: lunout
+    USE netcdf, ONLY: nf90_get_var, nf90_inq_varid, nf90_inquire_dimension, nf90_inq_dimid, &
+            nf90_open, nf90_noerr
+    USE lmdz_abort_physic, ONLY: abort_physic
+
+    IMPLICIT NONE
+
+    INCLUDE "YOMCST.h"
+
+    !--------------------------------------------------------
+    !--input variables
+    !--------------------------------------------------------
+    LOGICAL, INTENT(IN) :: debut
+    REAL, INTENT(IN) :: pphis(klon), pplay(klon, klev), paprs(klon, klev + 1), t_seri(klon, klev)
+
+    !--------------------------------------------------------
+    !	... Local variables
+    !--------------------------------------------------------
+
+    CHARACTER (LEN = 20) :: modname = 'airplane_mod'
+    INTEGER :: i, k, kori, iret, varid, error, ncida, klona
+    INTEGER, SAVE :: nleva, ntimea
+    !$OMP THREADPRIVATE(nleva,ntimea)
+    REAL, ALLOCATABLE :: pkm_airpl_glo(:, :, :)    !--km/s
+    REAL, ALLOCATABLE :: ph2o_airpl_glo(:, :, :)   !--molec H2O/cm3/s
+    REAL, ALLOCATABLE, SAVE :: zmida(:), zinta(:)
+    REAL, ALLOCATABLE, SAVE :: pkm_airpl(:, :, :)
+    REAL, ALLOCATABLE, SAVE :: ph2o_airpl(:, :, :)
+    !$OMP THREADPRIVATE(pkm_airpl,ph2o_airpl,zmida,zinta)
+    REAL :: zalt(klon, klev + 1)
+    REAL :: zrho, zdz(klon, klev), zfrac
+
+    IF (debut) THEN
+      !--------------------------------------------------------------------------------
+      !       ... Open the file and read airplane emissions
+      !--------------------------------------------------------------------------------
+
+      IF (is_mpi_root .AND. is_omp_root) THEN
+
+        iret = nf90_open('aircraft_phy.nc', 0, ncida)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to open aircraft_phy.nc file', 1)
+        ! ... Get lengths
+        iret = nf90_inq_dimid(ncida, 'time', varid)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get time dimid in aircraft_phy.nc file', 1)
+        iret = nf90_inquire_dimension(ncida, varid, len = ntimea)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get time dimlen aircraft_phy.nc file', 1)
+        iret = nf90_inq_dimid(ncida, 'vector', varid)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get vector dimid aircraft_phy.nc file', 1)
+        iret = nf90_inquire_dimension(ncida, varid, len = klona)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get vector dimlen aircraft_phy.nc file', 1)
+        iret = nf90_inq_dimid(ncida, 'lev', varid)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get lev dimid aircraft_phy.nc file', 1)
+        iret = nf90_inquire_dimension(ncida, varid, len = nleva)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get lev dimlen aircraft_phy.nc file', 1)
+
+        IF (klona /= klon_glo) THEN
+          WRITE(lunout, *) 'klona & klon_glo =', klona, klon_glo
+          CALL abort_physic(modname, 'problem klon in aircraft_phy.nc file', 1)
+        ENDIF
+
+        IF (ntimea /= 12) THEN
+          WRITE(lunout, *) 'ntimea=', ntimea
+          CALL abort_physic(modname, 'problem ntime<>12 in aircraft_phy.nc file', 1)
+        ENDIF
+
+        ALLOCATE(zmida(nleva), STAT = error)
+        IF (error /= 0) CALL abort_physic(modname, 'problem to allocate zmida', 1)
+        ALLOCATE(pkm_airpl_glo(klona, nleva, ntimea), STAT = error)
+        IF (error /= 0) CALL abort_physic(modname, 'problem to allocate pkm_airpl_glo', 1)
+        ALLOCATE(ph2o_airpl_glo(klona, nleva, ntimea), STAT = error)
+        IF (error /= 0) CALL abort_physic(modname, 'problem to allocate ph2o_airpl_glo', 1)
+
+        iret = nf90_inq_varid(ncida, 'lev', varid)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get lev dimid aircraft_phy.nc file', 1)
+        iret = nf90_get_var(ncida, varid, zmida)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to read zmida file', 1)
+
+        iret = nf90_inq_varid(ncida, 'emi_co2_aircraft', varid)  !--CO2 as a proxy for m flown -
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get emi_distance dimid aircraft_phy.nc file', 1)
+        iret = nf90_get_var(ncida, varid, pkm_airpl_glo)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to read pkm_airpl file', 1)
+
+        iret = nf90_inq_varid(ncida, 'emi_h2o_aircraft', varid)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to get emi_h2o_aircraft dimid aircraft_phy.nc file', 1)
+        iret = nf90_get_var(ncida, varid, ph2o_airpl_glo)
+        IF (iret /= nf90_noerr) CALL abort_physic(modname, 'problem to read ph2o_airpl file', 1)
+
+      ENDIF    !--is_mpi_root and is_omp_root
+
+      CALL bcast(nleva)
+      CALL bcast(ntimea)
+
+      IF (.NOT.ALLOCATED(zmida)) ALLOCATE(zmida(nleva), STAT = error)
+      IF (.NOT.ALLOCATED(zinta)) ALLOCATE(zinta(nleva + 1), STAT = error)
+
+      ALLOCATE(pkm_airpl(klon, nleva, ntimea))
+      ALLOCATE(ph2o_airpl(klon, nleva, ntimea))
+
+      ALLOCATE(flight_m(klon, klev))
+      ALLOCATE(flight_h2o(klon, klev))
+
+      CALL bcast(zmida)
+      zinta(1) = 0.0                                   !--surface
+      DO k = 2, nleva
+        zinta(k) = (zmida(k - 1) + zmida(k)) / 2.0 * 1000.0  !--conversion from km to m
+      ENDDO
+      zinta(nleva + 1) = zinta(nleva) + (zmida(nleva) - zmida(nleva - 1)) * 1000.0 !--extrapolation for last interface
+      !print *,'zinta=', zinta
+
+      CALL scatter(pkm_airpl_glo, pkm_airpl)
+      CALL scatter(ph2o_airpl_glo, ph2o_airpl)
+
+      !$OMP MASTER
+      IF (is_mpi_root .AND. is_omp_root) THEN
         DEALLOCATE(pkm_airpl_glo)
         DEALLOCATE(ph2o_airpl_glo)
-     ENDIF   !--is_mpi_root
-!$OMP END MASTER
-
-  ENDIF !--debut
-
-!--compute altitude of model level interfaces
-
-  DO i = 1, klon
-    zalt(i,1)=pphis(i)/RG         !--in m
-  ENDDO
-
-  DO k=1, klev
+      ENDIF   !--is_mpi_root
+      !$OMP END MASTER
+
+    ENDIF !--debut
+
+    !--compute altitude of model level interfaces
+
     DO i = 1, klon
-      zrho=pplay(i,k)/t_seri(i,k)/RD
-      zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho/RG
-      zalt(i,k+1)=zalt(i,k)+zdz(i,k)   !--in m
+      zalt(i, 1) = pphis(i) / RG         !--in m
     ENDDO
-  ENDDO
-
-!--vertical reprojection 
-
-  flight_m(:,:)=0.0 
-  flight_h2o(:,:)=0.0 
-
-  DO k=1, klev
-    DO kori=1, nleva 
-      DO i=1, klon
-        !--fraction of layer kori included in layer k
-        zfrac=max(0.0,min(zalt(i,k+1),zinta(kori+1))-max(zalt(i,k),zinta(kori)))/(zinta(kori+1)-zinta(kori))
-        !--reproject
-        flight_m(i,k)=flight_m(i,k) + pkm_airpl(i,kori,mth_cur)*zfrac 
-        !--reproject
-        flight_h2o(i,k)=flight_h2o(i,k) + ph2o_airpl(i,kori,mth_cur)*zfrac   
+
+    DO k = 1, klev
+      DO i = 1, klon
+        zrho = pplay(i, k) / t_seri(i, k) / RD
+        zdz(i, k) = (paprs(i, k) - paprs(i, k + 1)) / zrho / RG
+        zalt(i, k + 1) = zalt(i, k) + zdz(i, k)   !--in m
       ENDDO
     ENDDO
-  ENDDO
-
-  DO k=1, klev
-    DO i=1, klon
-      !--molec.cm-3.s-1 / (molec/mol) * kg CO2/mol * m2 * m * cm3/m3 / (kg CO2/m) => m s-1 per cell
-      flight_m(i,k)=flight_m(i,k)/RNAVO*44.e-3*cell_area(i)*zdz(i,k)*1.e6/16.37e-3
-      flight_m(i,k)=flight_m(i,k)*100.0  !--x100 to augment signal to noise 
-      !--molec.cm-3.s-1 / (molec/mol) * kg H2O/mol * m2 * m * cm3/m3 => kg H2O s-1 per cell
-      flight_h2o(i,k)=flight_h2o(i,k)/RNAVO*18.e-3*cell_area(i)*zdz(i,k)*1.e6
+
+    !--vertical reprojection
+
+    flight_m(:, :) = 0.0
+    flight_h2o(:, :) = 0.0
+
+    DO k = 1, klev
+      DO kori = 1, nleva
+        DO i = 1, klon
+          !--fraction of layer kori included in layer k
+          zfrac = max(0.0, min(zalt(i, k + 1), zinta(kori + 1)) - max(zalt(i, k), zinta(kori))) / (zinta(kori + 1) - zinta(kori))
+          !--reproject
+          flight_m(i, k) = flight_m(i, k) + pkm_airpl(i, kori, mth_cur) * zfrac
+          !--reproject
+          flight_h2o(i, k) = flight_h2o(i, k) + ph2o_airpl(i, kori, mth_cur) * zfrac
+        ENDDO
+      ENDDO
     ENDDO
-  ENDDO
-
-END SUBROUTINE airplane
-
-!********************************************************************
-! simple routine to initialise flight_m and test a flight corridor
-!--Olivier Boucher - 2021 
-
-SUBROUTINE flight_init()
-  USE dimphy
-  USE lmdz_geometry, ONLY: cell_area, latitude_deg, longitude_deg
-  IMPLICIT NONE
-  INTEGER :: i
-
-  ALLOCATE(flight_m(klon,klev))
-  ALLOCATE(flight_h2o(klon,klev))
-
-  flight_m(:,:) = 0.0    !--initialisation
-  flight_h2o(:,:) = 0.0  !--initialisation
-
-  DO i=1, klon
-   IF (latitude_deg(i)>=42.0.AND.latitude_deg(i)<=48.0) THEN
-     flight_m(i,38) = 50000.0  !--5000 m of flight/second in grid cell x 10 scaling
-   ENDIF
-  ENDDO
-  
-
-END SUBROUTINE flight_init
-
-!*******************************************************************
-!--Routine to deal with ice supersaturation
-!--Determines the respective fractions of unsaturated clear sky, ice supersaturated clear sky and cloudy sky
-!--Diagnoses regions prone for non-persistent and persistent contrail formation
-
-!--Audran Borella - 2021 
-
-SUBROUTINE ice_sursat(pplay, dpaprs, dtime, i, k, t, q, gamma_ss, &
-                      qsat, t_actuel, rneb_seri, ratqs, rneb, qincld,   &
-                      rnebss, qss, Tcontr, qcontr, qcontr2, fcontrN, fcontrP)
-
-  USE dimphy
-  USE lmdz_print_control,    ONLY: prt_level, lunout
-  USE phys_state_var_mod,   ONLY: pbl_tke, t_ancien 
-  USE phys_local_var_mod,   ONLY: N1_ss, N2_ss
-  USE phys_local_var_mod,   ONLY: drneb_sub, drneb_con, drneb_tur, drneb_avi
-!!  USE phys_local_var_mod,   ONLY: Tcontr, qcontr, fcontrN, fcontrP
-  USE indice_sol_mod,       ONLY: is_ave 
-  USE lmdz_geometry,         ONLY: cell_area
-  USE lmdz_clesphys
-
-  IMPLICIT NONE
-  INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
-  INCLUDE "FCTTRE.h"
-
-  ! Input
-  ! Beware: this routine works on a gridpoint!
-
-  REAL,     INTENT(IN)    :: pplay     ! layer pressure (Pa)
-  REAL,     INTENT(IN)    :: dpaprs    ! layer delta pressure (Pa)
-  REAL,     INTENT(IN)    :: dtime     ! intervalle du temps (s)
-  REAL,     INTENT(IN)    :: t         ! température advectée (K)
-  REAL,     INTENT(IN)    :: qsat      ! vapeur de saturation
-  REAL,     INTENT(IN)    :: t_actuel  ! temperature actuelle de la maille (K)
-  REAL,     INTENT(IN)    :: rneb_seri ! fraction nuageuse en memoire
-  INTEGER,  INTENT(IN)    :: i, k
-
-  !  Input/output
-
-  REAL,     INTENT(INOUT) :: q         ! vapeur de la maille (=zq)
-  REAL,     INTENT(INOUT) :: ratqs     ! determine la largeur de distribution de vapeur
-  REAL,     INTENT(INOUT) :: Tcontr, qcontr, qcontr2, fcontrN, fcontrP
-
-  !  Output
-
-  REAL,     INTENT(OUT)   :: gamma_ss  !
-  REAL,     INTENT(OUT)   :: rneb      !  cloud fraction
-  REAL,     INTENT(OUT)   :: qincld    !  in-cloud total water
-  REAL,     INTENT(OUT)   :: rnebss    !  ISSR fraction
-  REAL,     INTENT(OUT)   :: qss       !  in-ISSR total water
-
-  ! Local
-
-  REAL PI
-  PARAMETER (PI=4.*ATAN(1.))
-  REAL rnebclr, gamma_prec
-  REAL qclr, qvc, qcld, qi
-  REAL zrho, zdz, zrhodz
-  REAL pdf_N, pdf_N1, pdf_N2
-  REAL pdf_a, pdf_b
-  REAL pdf_e1, pdf_e2, pdf_k
-  REAL drnebss, drnebclr, dqss, dqclr, sum_rneb_rnebss, dqss_avi
-  REAL V_cell !--volume of the cell 
-  REAL M_cell !--dry mass of the cell 
-  REAL tke, sig, L_tur, b_tur, q_eq
-  REAL V_env, V_cld, V_ss, V_clr
-  REAL zcor
-
-  !--more local variables for diagnostics
-  !--imported from YOMCST.h 
-  !--eps_w = 0.622 = ratio of molecular masses of water and dry air (kg H2O kg air -1)
-  !--RCPD = 1004 J kg air−1 K−1 = the isobaric heat capacity of air
-  !--values from Schumann, Meteorol Zeitschrift, 1996
-  !--EiH2O = 1.25 / 2.24 / 8.94 kg H2O / kg fuel for kerosene / methane / dihydrogen
-  !--Qheat = 43.  /  50. / 120. MJ / kg fuel for kerosene / methane / dihydrogen
-  REAL, PARAMETER :: EiH2O=1.25  !--emission index of water vapour for kerosene (kg kg-1)
-  REAL, PARAMETER :: Qheat=43.E6 !--specific combustion heat for kerosene (J kg-1) 
-  REAL, PARAMETER :: eta=0.3     !--average propulsion efficiency of the aircraft
-  !--Gcontr is the slope of the mean phase trajectory in the turbulent exhaust field on an absolute 
-  !--temperature versus water vapor partial pressure diagram. G has the unit of Pa K−1. Rap et al JGR 2010.
-  REAL :: Gcontr
-  !--Tcontr = critical temperature for contrail formation (T_LM in Schumann 1996, Eq 31 in appendix 2) 
-  !--qsatliqcontr = e_L(T_LM) in Schumann 1996 but expressed in specific humidity (kg kg humid air-1)
-  REAL :: qsatliqcontr
-
-     ! Initialisations
-     zrho = pplay / t / RD            !--dry density kg m-3
-     zrhodz = dpaprs / RG             !--dry air mass kg m-2
-     zdz = zrhodz / zrho              !--cell thickness m
-     V_cell = zdz * cell_area(i)      !--cell volume m3
-     M_cell = zrhodz * cell_area(i)   !--cell dry air mass kg
-
-     ! Recuperation de la memoire sur la couverture nuageuse
-     rneb = rneb_seri
-
-     ! Ajout des émissions de H2O dues à l'aviation
-     ! q is the specific humidity (kg/kg humid air) hence the complicated equation to update q
-     ! qnew = ( m_humid_air * qold + dm_H2O ) / ( m_humid_air + dm_H2O )  
-     !      = ( m_dry_air * qold + dm_h2O * (1-qold) ) / (m_dry_air + dm_H2O * (1-qold) ) 
-     ! The equation is derived by writing m_humid_air = m_dry_air + m_H2O = m_dry_air / (1-q) 
-     ! flight_h2O is in kg H2O / s / cell
-
-     IF (ok_plane_h2o) THEN 
-       q = ( M_cell*q + flight_h2o(i,k)*dtime*(1.-q) ) / (M_cell + flight_h2o(i,k)*dtime*(1.-q) ) 
-     ENDIF
-
-     !--Estimating gamma 
-     gamma_ss = MAX(1.0, gamma0 - t_actuel/Tgamma)
-     !gamma_prec = MAX(1.0, gamma0 - t_ancien(i,k)/Tgamma)      !--formulation initiale d Audran
-     gamma_prec = MAX(1.0, gamma0 - t/Tgamma)                   !--autre formulation possible basée sur le T du pas de temps
-
-     ! Initialisation de qvc : q_sat du pas de temps precedent
-     !qvc = R2ES*FOEEW(t_ancien(i,k),1.)/pplay      !--formulation initiale d Audran
-     qvc = R2ES*FOEEW(t,1.)/pplay                   !--autre formulation possible basée sur le T du pas de temps
-     qvc = min(0.5,qvc)
-     zcor = 1./(1.-RETV*qvc)
-     qvc = qvc*zcor
-
-     ! Modification de ratqs selon formule proposee : ksi_new = ksi_old/(1+beta*alpha_cld)
-     ratqs = ratqs / (tun_ratqs*rneb_seri + 1.)
-
-     ! Calcul de N
-     pdf_k = -sqrt(log(1.+ratqs**2.))
-     pdf_a = log(qvc/q)/(pdf_k*sqrt(2.))
-     pdf_b = pdf_k/(2.*sqrt(2.))
-     pdf_e1 = pdf_a+pdf_b
-     IF (abs(pdf_e1)>=erf_lim) THEN
-        pdf_e1 = sign(1.,pdf_e1)
-        pdf_N = max(0.,sign(rneb,pdf_e1))
-     ELSE
+
+    DO k = 1, klev
+      DO i = 1, klon
+        !--molec.cm-3.s-1 / (molec/mol) * kg CO2/mol * m2 * m * cm3/m3 / (kg CO2/m) => m s-1 per cell
+        flight_m(i, k) = flight_m(i, k) / RNAVO * 44.e-3 * cell_area(i) * zdz(i, k) * 1.e6 / 16.37e-3
+        flight_m(i, k) = flight_m(i, k) * 100.0  !--x100 to augment signal to noise
+        !--molec.cm-3.s-1 / (molec/mol) * kg H2O/mol * m2 * m * cm3/m3 => kg H2O s-1 per cell
+        flight_h2o(i, k) = flight_h2o(i, k) / RNAVO * 18.e-3 * cell_area(i) * zdz(i, k) * 1.e6
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE airplane
+
+  !********************************************************************
+  ! simple routine to initialise flight_m and test a flight corridor
+  !--Olivier Boucher - 2021
+
+  SUBROUTINE flight_init()
+    USE dimphy
+    USE lmdz_geometry, ONLY: cell_area, latitude_deg, longitude_deg
+    IMPLICIT NONE
+    INTEGER :: i
+
+    ALLOCATE(flight_m(klon, klev))
+    ALLOCATE(flight_h2o(klon, klev))
+
+    flight_m(:, :) = 0.0    !--initialisation
+    flight_h2o(:, :) = 0.0  !--initialisation
+
+    DO i = 1, klon
+      IF (latitude_deg(i)>=42.0.AND.latitude_deg(i)<=48.0) THEN
+        flight_m(i, 38) = 50000.0  !--5000 m of flight/second in grid cell x 10 scaling
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE flight_init
+
+  !*******************************************************************
+  !--Routine to deal with ice supersaturation
+  !--Determines the respective fractions of unsaturated clear sky, ice supersaturated clear sky and cloudy sky
+  !--Diagnoses regions prone for non-persistent and persistent contrail formation
+
+  !--Audran Borella - 2021
+
+  SUBROUTINE ice_sursat(pplay, dpaprs, dtime, i, k, t, q, gamma_ss, &
+          qsat, t_actuel, rneb_seri, ratqs, rneb, qincld, &
+          rnebss, qss, Tcontr, qcontr, qcontr2, fcontrN, fcontrP)
+
+    USE dimphy
+    USE lmdz_print_control, ONLY: prt_level, lunout
+    USE phys_state_var_mod, ONLY: pbl_tke, t_ancien
+    USE phys_local_var_mod, ONLY: N1_ss, N2_ss
+    USE phys_local_var_mod, ONLY: drneb_sub, drneb_con, drneb_tur, drneb_avi
+    !!  USE phys_local_var_mod,   ONLY: Tcontr, qcontr, fcontrN, fcontrP
+    USE indice_sol_mod, ONLY: is_ave
+    USE lmdz_geometry, ONLY: cell_area
+    USE lmdz_clesphys
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
+    IMPLICIT NONE
+    INCLUDE "YOMCST.h"
+
+    ! Input
+    ! Beware: this routine works on a gridpoint!
+
+    REAL, INTENT(IN) :: pplay     ! layer pressure (Pa)
+    REAL, INTENT(IN) :: dpaprs    ! layer delta pressure (Pa)
+    REAL, INTENT(IN) :: dtime     ! intervalle du temps (s)
+    REAL, INTENT(IN) :: t         ! température advectée (K)
+    REAL, INTENT(IN) :: qsat      ! vapeur de saturation
+    REAL, INTENT(IN) :: t_actuel  ! temperature actuelle de la maille (K)
+    REAL, INTENT(IN) :: rneb_seri ! fraction nuageuse en memoire
+    INTEGER, INTENT(IN) :: i, k
+
+    !  Input/output
+
+    REAL, INTENT(INOUT) :: q         ! vapeur de la maille (=zq)
+    REAL, INTENT(INOUT) :: ratqs     ! determine la largeur de distribution de vapeur
+    REAL, INTENT(INOUT) :: Tcontr, qcontr, qcontr2, fcontrN, fcontrP
+
+    !  Output
+
+    REAL, INTENT(OUT) :: gamma_ss  !
+    REAL, INTENT(OUT) :: rneb      !  cloud fraction
+    REAL, INTENT(OUT) :: qincld    !  in-cloud total water
+    REAL, INTENT(OUT) :: rnebss    !  ISSR fraction
+    REAL, INTENT(OUT) :: qss       !  in-ISSR total water
+
+    ! Local
+
+    REAL PI
+    PARAMETER (PI = 4. * ATAN(1.))
+    REAL rnebclr, gamma_prec
+    REAL qclr, qvc, qcld, qi
+    REAL zrho, zdz, zrhodz
+    REAL pdf_N, pdf_N1, pdf_N2
+    REAL pdf_a, pdf_b
+    REAL pdf_e1, pdf_e2, pdf_k
+    REAL drnebss, drnebclr, dqss, dqclr, sum_rneb_rnebss, dqss_avi
+    REAL V_cell !--volume of the cell
+    REAL M_cell !--dry mass of the cell
+    REAL tke, sig, L_tur, b_tur, q_eq
+    REAL V_env, V_cld, V_ss, V_clr
+    REAL zcor
+
+    !--more local variables for diagnostics
+    !--imported from YOMCST.h
+    !--eps_w = 0.622 = ratio of molecular masses of water and dry air (kg H2O kg air -1)
+    !--RCPD = 1004 J kg air−1 K−1 = the isobaric heat capacity of air
+    !--values from Schumann, Meteorol Zeitschrift, 1996
+    !--EiH2O = 1.25 / 2.24 / 8.94 kg H2O / kg fuel for kerosene / methane / dihydrogen
+    !--Qheat = 43.  /  50. / 120. MJ / kg fuel for kerosene / methane / dihydrogen
+    REAL, PARAMETER :: EiH2O = 1.25  !--emission index of water vapour for kerosene (kg kg-1)
+    REAL, PARAMETER :: Qheat = 43.E6 !--specific combustion heat for kerosene (J kg-1)
+    REAL, PARAMETER :: eta = 0.3     !--average propulsion efficiency of the aircraft
+    !--Gcontr is the slope of the mean phase trajectory in the turbulent exhaust field on an absolute
+    !--temperature versus water vapor partial pressure diagram. G has the unit of Pa K−1. Rap et al JGR 2010.
+    REAL :: Gcontr
+    !--Tcontr = critical temperature for contrail formation (T_LM in Schumann 1996, Eq 31 in appendix 2)
+    !--qsatliqcontr = e_L(T_LM) in Schumann 1996 but expressed in specific humidity (kg kg humid air-1)
+    REAL :: qsatliqcontr
+
+    ! Initialisations
+    zrho = pplay / t / RD            !--dry density kg m-3
+    zrhodz = dpaprs / RG             !--dry air mass kg m-2
+    zdz = zrhodz / zrho              !--cell thickness m
+    V_cell = zdz * cell_area(i)      !--cell volume m3
+    M_cell = zrhodz * cell_area(i)   !--cell dry air mass kg
+
+    ! Recuperation de la memoire sur la couverture nuageuse
+    rneb = rneb_seri
+
+    ! Ajout des émissions de H2O dues à l'aviation
+    ! q is the specific humidity (kg/kg humid air) hence the complicated equation to update q
+    ! qnew = ( m_humid_air * qold + dm_H2O ) / ( m_humid_air + dm_H2O )
+    !      = ( m_dry_air * qold + dm_h2O * (1-qold) ) / (m_dry_air + dm_H2O * (1-qold) )
+    ! The equation is derived by writing m_humid_air = m_dry_air + m_H2O = m_dry_air / (1-q)
+    ! flight_h2O is in kg H2O / s / cell
+
+    IF (ok_plane_h2o) THEN
+      q = (M_cell * q + flight_h2o(i, k) * dtime * (1. - q)) / (M_cell + flight_h2o(i, k) * dtime * (1. - q))
+    ENDIF
+
+    !--Estimating gamma
+    gamma_ss = MAX(1.0, gamma0 - t_actuel / Tgamma)
+    !gamma_prec = MAX(1.0, gamma0 - t_ancien(i,k)/Tgamma)      !--formulation initiale d Audran
+    gamma_prec = MAX(1.0, gamma0 - t / Tgamma)                   !--autre formulation possible basée sur le T du pas de temps
+
+    ! Initialisation de qvc : q_sat du pas de temps precedent
+    !qvc = R2ES*FOEEW(t_ancien(i,k),1.)/pplay      !--formulation initiale d Audran
+    qvc = R2ES * FOEEW(t, 1.) / pplay                   !--autre formulation possible basée sur le T du pas de temps
+    qvc = min(0.5, qvc)
+    zcor = 1. / (1. - RETV * qvc)
+    qvc = qvc * zcor
+
+    ! Modification de ratqs selon formule proposee : ksi_new = ksi_old/(1+beta*alpha_cld)
+    ratqs = ratqs / (tun_ratqs * rneb_seri + 1.)
+
+    ! Calcul de N
+    pdf_k = -sqrt(log(1. + ratqs**2.))
+    pdf_a = log(qvc / q) / (pdf_k * sqrt(2.))
+    pdf_b = pdf_k / (2. * sqrt(2.))
+    pdf_e1 = pdf_a + pdf_b
+    IF (abs(pdf_e1)>=erf_lim) THEN
+      pdf_e1 = sign(1., pdf_e1)
+      pdf_N = max(0., sign(rneb, pdf_e1))
+    ELSE
+      pdf_e1 = erf(pdf_e1)
+      pdf_e1 = 0.5 * (1. + pdf_e1)
+      pdf_N = max(0., rneb / pdf_e1)
+    ENDIF
+
+    ! On calcule ensuite N1 et N2. Il y a deux cas : N > 1 et N <= 1
+    ! Cas 1 : N > 1. N'arrive en theorie jamais, c'est une barriere
+    ! On perd la memoire sur la temperature (sur qvc) pour garder
+    ! celle sur alpha_cld
+    IF (pdf_N>1.) THEN
+      ! On inverse alpha_cld = int_qvc^infty P(q) dq
+      ! pour determiner qvc = f(alpha_cld)
+      ! On approxime en serie entiere erf-1(x)
+      qvc = 2. * rneb - 1.
+      qvc = qvc + PI / 12. * qvc**3 + 7. * PI**2 / 480. * qvc**5 &
+              + 127. * PI**3 / 40320. * qvc**7 + 4369. * PI**4 / 5806080. * qvc**9 &
+              + 34807. * PI**5 / 182476800. * qvc**11
+      qvc = sqrt(PI) / 2. * qvc
+      qvc = (qvc - pdf_b) * pdf_k * sqrt(2.)
+      qvc = q * exp(qvc)
+
+      ! On met a jour rneb avec la nouvelle valeur de qvc
+      ! La maj est necessaire a cause de la serie entiere approximative
+      pdf_a = log(qvc / q) / (pdf_k * sqrt(2.))
+      pdf_e1 = pdf_a + pdf_b
+      IF (abs(pdf_e1)>=erf_lim) THEN
+        pdf_e1 = sign(1., pdf_e1)
+      ELSE
         pdf_e1 = erf(pdf_e1)
-        pdf_e1 = 0.5*(1.+pdf_e1)
-        pdf_N = max(0.,rneb/pdf_e1)
-     ENDIF
-
-     ! On calcule ensuite N1 et N2. Il y a deux cas : N > 1 et N <= 1
-     ! Cas 1 : N > 1. N'arrive en theorie jamais, c'est une barriere
-     ! On perd la memoire sur la temperature (sur qvc) pour garder
-     ! celle sur alpha_cld
-     IF (pdf_N>1.) THEN
-        ! On inverse alpha_cld = int_qvc^infty P(q) dq
-        ! pour determiner qvc = f(alpha_cld)
-        ! On approxime en serie entiere erf-1(x)
-        qvc = 2.*rneb-1.
-        qvc = qvc + PI/12.*qvc**3 + 7.*PI**2/480.*qvc**5 &
-             + 127.*PI**3/40320.*qvc**7 + 4369.*PI**4/5806080.*qvc**9 &
-             + 34807.*PI**5/182476800.*qvc**11
-        qvc = sqrt(PI)/2.*qvc
-        qvc = (qvc-pdf_b)*pdf_k*sqrt(2.)
-        qvc = q*exp(qvc)
-
-        ! On met a jour rneb avec la nouvelle valeur de qvc
-        ! La maj est necessaire a cause de la serie entiere approximative
-        pdf_a = log(qvc/q)/(pdf_k*sqrt(2.))
-        pdf_e1 = pdf_a+pdf_b
-        IF (abs(pdf_e1)>=erf_lim) THEN
-           pdf_e1 = sign(1.,pdf_e1)
+      ENDIF
+      pdf_e1 = 0.5 * (1. + pdf_e1)
+      rneb = pdf_e1
+
+      ! Si N > 1, N1 et N2 = 1
+      pdf_N1 = 1.
+      pdf_N2 = 1.
+
+      ! Cas 2 : N <= 1
+    ELSE
+      ! D'abord on calcule N2 avec le tuning
+      pdf_N2 = min(1., pdf_N * tun_N)
+
+      ! Puis N1 pour assurer la conservation de alpha_cld
+      pdf_a = log(qvc * gamma_prec / q) / (pdf_k * sqrt(2.))
+      pdf_e2 = pdf_a + pdf_b
+      IF (abs(pdf_e2)>=erf_lim) THEN
+        pdf_e2 = sign(1., pdf_e2)
+      ELSE
+        pdf_e2 = erf(pdf_e2)
+      ENDIF
+      pdf_e2 = 0.5 * (1. + pdf_e2) ! integrale sous P pour q > gamma qsat
+
+      IF (abs(pdf_e1 - pdf_e2)<eps) THEN
+        pdf_N1 = pdf_N2
+      ELSE
+        pdf_N1 = (rneb - pdf_N2 * pdf_e2) / (pdf_e1 - pdf_e2)
+      ENDIF
+
+      ! Barriere qui traite le cas gamma_prec = 1.
+      IF (pdf_N1<=0.) THEN
+        pdf_N1 = 0.
+        IF (pdf_e2>eps) THEN
+          pdf_N2 = rneb / pdf_e2
         ELSE
-           pdf_e1 = erf(pdf_e1)
+          pdf_N2 = 0.
         ENDIF
-        pdf_e1 = 0.5*(1.+pdf_e1)
-        rneb = pdf_e1
-        
-        ! Si N > 1, N1 et N2 = 1
-        pdf_N1 = 1.
-        pdf_N2 = 1.
-        
-     ! Cas 2 : N <= 1
-     ELSE
-        ! D'abord on calcule N2 avec le tuning
-        pdf_N2 = min(1.,pdf_N*tun_N)
-        
-        ! Puis N1 pour assurer la conservation de alpha_cld
-        pdf_a = log(qvc*gamma_prec/q)/(pdf_k*sqrt(2.))
-        pdf_e2 = pdf_a+pdf_b
-        IF (abs(pdf_e2)>=erf_lim) THEN
-           pdf_e2 = sign(1.,pdf_e2)
-        ELSE
-           pdf_e2 = erf(pdf_e2)
+      ENDIF
+    ENDIF
+
+    ! Physique 1
+    ! Sublimation
+    IF (qvc<qsat) THEN
+      pdf_a = log(qvc / q) / (pdf_k * sqrt(2.))
+      pdf_e1 = pdf_a + pdf_b
+      IF (abs(pdf_e1)>=erf_lim) THEN
+        pdf_e1 = sign(1., pdf_e1)
+      ELSE
+        pdf_e1 = erf(pdf_e1)
+      ENDIF
+
+      pdf_a = log(qsat / q) / (pdf_k * sqrt(2.))
+      pdf_e2 = pdf_a + pdf_b
+      IF (abs(pdf_e2)>=erf_lim) THEN
+        pdf_e2 = sign(1., pdf_e2)
+      ELSE
+        pdf_e2 = erf(pdf_e2)
+      ENDIF
+
+      pdf_e1 = 0.5 * pdf_N1 * (pdf_e1 - pdf_e2)
+
+      ! Calcul et ajout de la tendance
+      drneb_sub(i, k) = - pdf_e1 / dtime    !--unit [s-1]
+      rneb = rneb + drneb_sub(i, k) * dtime
+    ELSE
+      drneb_sub(i, k) = 0.
+    ENDIF
+
+    ! NOTE : verifier si ca marche bien pour gamma proche de 1.
+
+    ! Condensation
+    IF (gamma_ss * qsat<gamma_prec * qvc) THEN
+
+      pdf_a = log(gamma_ss * qsat / q) / (pdf_k * sqrt(2.))
+      pdf_e1 = pdf_a + pdf_b
+      IF (abs(pdf_e1)>=erf_lim) THEN
+        pdf_e1 = sign(1., pdf_e1)
+      ELSE
+        pdf_e1 = erf(pdf_e1)
+      ENDIF
+
+      pdf_a = log(gamma_prec * qvc / q) / (pdf_k * sqrt(2.))
+      pdf_e2 = pdf_a + pdf_b
+      IF (abs(pdf_e2)>=erf_lim) THEN
+        pdf_e2 = sign(1., pdf_e2)
+      ELSE
+        pdf_e2 = erf(pdf_e2)
+      ENDIF
+
+      pdf_e1 = 0.5 * (1. - pdf_N1) * (pdf_e1 - pdf_e2)
+      pdf_e2 = 0.5 * (1. - pdf_N2) * (1. + pdf_e2)
+
+      ! Calcul et ajout de la tendance
+      drneb_con(i, k) = (pdf_e1 + pdf_e2) / dtime         !--unit [s-1]
+      rneb = rneb + drneb_con(i, k) * dtime
+
+    ELSE
+
+      pdf_a = log(gamma_ss * qsat / q) / (pdf_k * sqrt(2.))
+      pdf_e1 = pdf_a + pdf_b
+      IF (abs(pdf_e1)>=erf_lim) THEN
+        pdf_e1 = sign(1., pdf_e1)
+      ELSE
+        pdf_e1 = erf(pdf_e1)
+      ENDIF
+      pdf_e1 = 0.5 * (1. - pdf_N2) * (1. + pdf_e1)
+
+      ! Calcul et ajout de la tendance
+      drneb_con(i, k) = pdf_e1 / dtime         !--unit [s-1]
+      rneb = rneb + drneb_con(i, k) * dtime
+
+    ENDIF
+
+    ! Calcul des grandeurs diagnostiques
+    ! Determination des grandeurs ciel clair
+    pdf_a = log(qsat / q) / (pdf_k * sqrt(2.))
+    pdf_e1 = pdf_a + pdf_b
+    IF (abs(pdf_e1)>=erf_lim) THEN
+      pdf_e1 = sign(1., pdf_e1)
+    ELSE
+      pdf_e1 = erf(pdf_e1)
+    ENDIF
+    pdf_e1 = 0.5 * (1. - pdf_e1)
+
+    pdf_e2 = pdf_a - pdf_b
+    IF (abs(pdf_e2)>=erf_lim) THEN
+      pdf_e2 = sign(1., pdf_e2)
+    ELSE
+      pdf_e2 = erf(pdf_e2)
+    ENDIF
+    pdf_e2 = 0.5 * q * (1. - pdf_e2)
+
+    rnebclr = pdf_e1
+    qclr = pdf_e2
+
+    ! Determination de q_cld
+    ! Partie 1
+    pdf_a = log(max(qsat, qvc) / q) / (pdf_k * sqrt(2.))
+    pdf_e1 = pdf_a - pdf_b
+    IF (abs(pdf_e1)>=erf_lim) THEN
+      pdf_e1 = sign(1., pdf_e1)
+    ELSE
+      pdf_e1 = erf(pdf_e1)
+    ENDIF
+
+    pdf_a = log(min(gamma_ss * qsat, gamma_prec * qvc) / q) / (pdf_k * sqrt(2.))
+    pdf_e2 = pdf_a - pdf_b
+    IF (abs(pdf_e2)>=erf_lim) THEN
+      pdf_e2 = sign(1., pdf_e2)
+    ELSE
+      pdf_e2 = erf(pdf_e2)
+    ENDIF
+
+    pdf_e1 = 0.5 * q * pdf_N1 * (pdf_e1 - pdf_e2)
+
+    qcld = pdf_e1
+
+    ! Partie 2 (sous condition)
+    IF (gamma_ss * qsat>gamma_prec * qvc) THEN
+      pdf_a = log(gamma_ss * qsat / q) / (pdf_k * sqrt(2.))
+      pdf_e1 = pdf_a - pdf_b
+      IF (abs(pdf_e1)>=erf_lim) THEN
+        pdf_e1 = sign(1., pdf_e1)
+      ELSE
+        pdf_e1 = erf(pdf_e1)
+      ENDIF
+
+      pdf_e2 = 0.5 * q * pdf_N2 * (pdf_e2 - pdf_e1)
+
+      qcld = qcld + pdf_e2
+
+      pdf_e2 = pdf_e1
+    ENDIF
+
+    ! Partie 3
+    pdf_e2 = 0.5 * q * (1. + pdf_e2)
+
+    qcld = qcld + pdf_e2
+
+    ! Fin du calcul de q_cld
+
+    ! Determination des grandeurs ISSR via les equations de conservation
+    rneb = MIN(rneb, 1. - rnebclr - eps)      !--ajout OB - barrière
+    rnebss = MAX(0.0, 1. - rnebclr - rneb)  !--ajout OB
+    qss = MAX(0.0, q - qclr - qcld)         !--ajout OB
+
+    ! Physique 2 : Turbulence
+    IF (rneb>eps.AND.rneb<1. - eps) THEN ! rneb != 0 and != 1
+
+      tke = pbl_tke(i, k, is_ave)
+      ! A MODIFIER formule a revoir
+      L_tur = min(l_turb, sqrt(tke) * dtime)
+
+      ! On fait pour l'instant l'hypothese a = 3b. V = 4/3 pi a b**2 = alpha_cld
+      ! donc b = alpha_cld/4pi **1/3.
+      b_tur = (rneb * V_cell / 4. / PI / N_cld)**(1. / 3.)
+      ! On verifie que la longeur de melange n'est pas trop grande
+      IF (L_tur>b_tur) THEN
+        L_tur = b_tur
+      ENDIF
+
+      V_env = N_cld * 4. * PI * (3. * (b_tur**2.) * L_tur + L_tur**3. + 3. * b_tur * (L_tur**2.))
+      V_cld = N_cld * 4. * PI * (3. * (b_tur**2.) * L_tur + L_tur**3. - 3. * b_tur * (L_tur**2.))
+      V_cld = abs(V_cld)
+
+      ! Repartition statistique des zones de contact nuage-ISSR et nuage-ciel clair
+      sig = rnebss / (chi * rnebclr + rnebss)
+      V_ss = MIN(sig * V_env, rnebss * V_cell)
+      V_clr = MIN((1. - sig) * V_env, rnebclr * V_cell)
+      V_cld = MIN(V_cld, rneb * V_cell)
+      V_env = V_ss + V_clr
+
+      ! ISSR => rneb
+      drnebss = -1. * V_ss / V_cell
+      dqss = drnebss * qss / MAX(eps, rnebss)
+
+      ! Clear sky <=> rneb
+      q_eq = V_env * qclr / MAX(eps, rnebclr) + V_cld * qcld / MAX(eps, rneb)
+      q_eq = q_eq / (V_env + V_cld)
+
+      IF (q_eq>qsat) THEN
+        drnebclr = - V_clr / V_cell
+        dqclr = drnebclr * qclr / MAX(eps, rnebclr)
+      ELSE
+        drnebclr = V_cld / V_cell
+        dqclr = drnebclr * qcld / MAX(eps, rneb)
+      ENDIF
+
+      ! Maj des variables avec les tendances
+      rnebclr = MAX(0.0, rnebclr + drnebclr)   !--OB ajout d'un max avec eps (il faudrait modified drnebclr pour le diag)
+      qclr = MAX(0.0, qclr + dqclr)           !--OB ajout d'un max avec 0
+
+      rneb = rneb - drnebclr - drnebss
+      qcld = qcld - dqclr - dqss
+
+      rnebss = MAX(0.0, rnebss + drnebss)     !--OB ajout d'un max avec eps (il faudrait modifier drnebss pour le diag)
+      qss = MAX(0.0, qss + dqss)             !--OB ajout d'un max avec 0
+
+      ! Tendances pour le diagnostic
+      drneb_tur(i, k) = (drnebclr + drnebss) / dtime  !--unit [s-1]
+
+    ENDIF ! rneb
+
+    !--add a source of cirrus from aviation contrails
+    IF (ok_plane_contrail) THEN
+      drneb_avi(i, k) = rnebss * flight_m(i, k) * contrail_cross_section / V_cell    !--tendency rneb due to aviation [s-1]
+      drneb_avi(i, k) = MIN(drneb_avi(i, k), rnebss / dtime)                     !--majoration
+      dqss_avi = qss * drneb_avi(i, k) / MAX(eps, rnebss)                          !--tendency q aviation [kg kg-1 s-1]
+      rneb = rneb + drneb_avi(i, k) * dtime                                     !--add tendency to rneb
+      qcld = qcld + dqss_avi * dtime                                           !--add tendency to qcld
+      rnebss = rnebss - drneb_avi(i, k) * dtime                                 !--add tendency to rnebss
+      qss = qss - dqss_avi * dtime                                             !--add tendency to qss
+    ELSE
+      drneb_avi(i, k) = 0.0
+    ENDIF
+
+    ! Barrieres
+    ! ISSR trop petite
+    IF (rnebss<eps) THEN
+      rneb = MIN(rneb + rnebss, 1.0 - eps) !--ajout OB barriere
+      qcld = qcld + qss
+      rnebss = 0.
+      qss = 0.
+    ENDIF
+
+    ! le nuage est trop petit
+    IF (rneb<eps) THEN
+      ! s'il y a une ISSR on met tout dans l'ISSR, sinon dans le
+      ! clear sky
+      IF (rnebss<eps) THEN
+        rnebclr = 1.
+        rnebss = 0. !--ajout OB
+        qclr = q
+      ELSE
+        rnebss = MIN(rnebss + rneb, 1.0 - eps) !--ajout OB barriere
+        qss = qss + qcld
+      ENDIF
+      rneb = 0.
+      qcld = 0.
+      qincld = qsat * gamma_ss
+    ELSE
+      qincld = qcld / rneb
+    ENDIF
+
+    !--OB ajout borne superieure
+    sum_rneb_rnebss = rneb + rnebss
+    rneb = rneb * MIN(1. - eps, sum_rneb_rnebss) / MAX(eps, sum_rneb_rnebss)
+    rnebss = rnebss * MIN(1. - eps, sum_rneb_rnebss) / MAX(eps, sum_rneb_rnebss)
+
+    ! On ecrit dans la memoire
+    N1_ss(i, k) = pdf_N1
+    N2_ss(i, k) = pdf_N2
+
+    !--Diagnostics only used from last iteration
+    !--test
+    !!Tcontr(i,k)=200.
+    !!fcontrN(i,k)=1.0
+    !!fcontrP(i,k)=0.5
+
+    !--slope of dilution line in exhaust
+    !--kg H2O/kg fuel * J kg air-1 K-1 * Pa / (kg H2O / kg air * J kg fuel-1)
+    Gcontr = EiH2O * RCPD * pplay / (eps_w * Qheat * (1. - eta))             !--Pa K-1
+    !--critical T_LM below which no liquid contrail can form in exhaust
+    !Tcontr(i,k) = 226.69+9.43*log(Gcontr-0.053)+0.72*(log(Gcontr-0.053))**2 !--K
+    IF (Gcontr > 0.1) THEN
+
+      Tcontr = 226.69 + 9.43 * log(Gcontr - 0.053) + 0.72 * (log(Gcontr - 0.053))**2 !--K
+      !print *,'Tcontr=',iter,i,k,eps_w,pplay,Gcontr,Tcontr(i,k)
+      !--Psat with index 0 in FOEEW to get saturation wrt liquid water corresponding to Tcontr
+      !qsatliqcontr = RESTT*FOEEW(Tcontr(i,k),0.)                               !--Pa
+      qsatliqcontr = RESTT * FOEEW(Tcontr, 0.)                               !--Pa
+      !--Critical water vapour above which there is contrail formation for ambiant temperature
+      !qcontr(i,k) = Gcontr*(t-Tcontr(i,k)) + qsatliqcontr                      !--Pa
+      qcontr = Gcontr * (t - Tcontr) + qsatliqcontr                      !--Pa
+      !--Conversion of qcontr in specific humidity - method 1
+      !qcontr(i,k) = RD/RV*qcontr(i,k)/pplay      !--so as to return to something similar to R2ES*FOEEW/pplay
+      qcontr2 = RD / RV * qcontr / pplay      !--so as to return to something similar to R2ES*FOEEW/pplay
+      !qcontr(i,k) = min(0.5,qcontr(i,k))         !--and then we apply the same correction term as for qsat
+      qcontr2 = min(0.5, qcontr2)         !--and then we apply the same correction term as for qsat
+      !zcor = 1./(1.-RETV*qcontr(i,k))            !--for consistency with qsat but is it correct at all?
+      zcor = 1. / (1. - RETV * qcontr2)            !--for consistency with qsat but is it correct at all as p is dry?
+      !zcor = 1./(1.+qcontr2)                 !--for consistency with qsat
+      !qcontr(i,k) = qcontr(i,k)*zcor
+      qcontr2 = qcontr2 * zcor
+      qcontr2 = MAX(1.e-10, qcontr2)            !--eliminate negative values due to extrapolation on dilution curve
+      !--Conversion of qcontr in specific humidity - method 2
+      !qcontr(i,k) = eps_w*qcontr(i,k) / (pplay+eps_w*qcontr(i,k))
+      !qcontr=MAX(1.E-10,qcontr)
+      !qcontr2 = eps_w*qcontr / (pplay+eps_w*qcontr)
+
+      IF (t < Tcontr) THEN !--contrail formation is possible
+
+        !--compute fractions of persistent (P) and non-persistent(N) contrail potential regions
+        !!IF (qcontr(i,k).GE.qsat) THEN
+        IF (qcontr2>=qsat) THEN
+          !--none of the unsaturated clear sky is prone for contrail formation
+          !!fcontrN(i,k) = 0.0
+          fcontrN = 0.0
+
+          !--integral of P(q) from qsat to qcontr in ISSR
+          pdf_a = log(qsat / q) / (pdf_k * sqrt(2.))
+          pdf_e1 = pdf_a + pdf_b
+          IF (abs(pdf_e1)>=erf_lim) THEN
+            pdf_e1 = sign(1., pdf_e1)
+          ELSE
+            pdf_e1 = erf(pdf_e1)
+          ENDIF
+
+          !!pdf_a = log(MIN(qcontr(i,k),qvc)/q)/(pdf_k*sqrt(2.))
+          pdf_a = log(MIN(qcontr2, qvc) / q) / (pdf_k * sqrt(2.))
+          pdf_e2 = pdf_a + pdf_b
+          IF (abs(pdf_e2)>=erf_lim) THEN
+            pdf_e2 = sign(1., pdf_e2)
+          ELSE
+            pdf_e2 = erf(pdf_e2)
+          ENDIF
+
+          !!fcontrP(i,k) = MAX(0., 0.5*(pdf_e1-pdf_e2))
+          fcontrP = MAX(0., 0.5 * (pdf_e1 - pdf_e2))
+
+          pdf_a = log(qsat / q) / (pdf_k * sqrt(2.))
+          pdf_e1 = pdf_a + pdf_b
+          IF (abs(pdf_e1)>=erf_lim) THEN
+            pdf_e1 = sign(1., pdf_e1)
+          ELSE
+            pdf_e1 = erf(pdf_e1)
+          ENDIF
+
+          !!pdf_a = log(MIN(qcontr(i,k),qvc)/q)/(pdf_k*sqrt(2.))
+          pdf_a = log(MIN(qcontr2, qvc) / q) / (pdf_k * sqrt(2.))
+          pdf_e2 = pdf_a + pdf_b
+          IF (abs(pdf_e2)>=erf_lim) THEN
+            pdf_e2 = sign(1., pdf_e2)
+          ELSE
+            pdf_e2 = erf(pdf_e2)
+          ENDIF
+
+          !!fcontrP(i,k) = MAX(0., 0.5*(pdf_e1-pdf_e2))
+          fcontrP = MAX(0., 0.5 * (pdf_e1 - pdf_e2))
+
+          pdf_a = log(MAX(qsat, qvc) / q) / (pdf_k * sqrt(2.))
+          pdf_e1 = pdf_a + pdf_b
+          IF (abs(pdf_e1)>=erf_lim) THEN
+            pdf_e1 = sign(1., pdf_e1)
+          ELSE
+            pdf_e1 = erf(pdf_e1)
+          ENDIF
+
+          !!pdf_a = log(MIN(qcontr(i,k),MIN(gamma_prec*qvc,gamma_ss*qsat))/q)/(pdf_k*sqrt(2.))
+          pdf_a = log(MIN(qcontr2, MIN(gamma_prec * qvc, gamma_ss * qsat)) / q) / (pdf_k * sqrt(2.))
+          pdf_e2 = pdf_a + pdf_b
+          IF (abs(pdf_e2)>=erf_lim) THEN
+            pdf_e2 = sign(1., pdf_e2)
+          ELSE
+            pdf_e2 = erf(pdf_e2)
+          ENDIF
+
+          !!fcontrP(i,k) = fcontrP(i,k) + MAX(0., 0.5*(1-pdf_N1)*(pdf_e1-pdf_e2))
+          fcontrP = fcontrP + MAX(0., 0.5 * (1 - pdf_N1) * (pdf_e1 - pdf_e2))
+
+          pdf_a = log(gamma_prec * qvc / q) / (pdf_k * sqrt(2.))
+          pdf_e1 = pdf_a + pdf_b
+          IF (abs(pdf_e1)>=erf_lim) THEN
+            pdf_e1 = sign(1., pdf_e1)
+          ELSE
+            pdf_e1 = erf(pdf_e1)
+          ENDIF
+
+          !!pdf_a = log(MIN(qcontr(i,k),gamma_ss*qsat)/q)/(pdf_k*sqrt(2.))
+          pdf_a = log(MIN(qcontr2, gamma_ss * qsat) / q) / (pdf_k * sqrt(2.))
+          pdf_e2 = pdf_a + pdf_b
+          IF (abs(pdf_e2)>=erf_lim) THEN
+            pdf_e2 = sign(1., pdf_e2)
+          ELSE
+            pdf_e2 = erf(pdf_e2)
+          ENDIF
+
+          !!fcontrP(i,k) = fcontrP(i,k) + MAX(0., 0.5*(1-pdf_N2)*(pdf_e1-pdf_e2))
+          fcontrP = fcontrP + MAX(0., 0.5 * (1 - pdf_N2) * (pdf_e1 - pdf_e2))
+
+        ELSE  !--qcontr LT qsat
+
+          !--all of ISSR is prone for contrail formation
+          !!fcontrP(i,k) = rnebss
+          fcontrP = rnebss
+
+          !--integral of zq from qcontr to qsat in unsaturated clear-sky region
+          !!pdf_a = log(qcontr(i,k)/q)/(pdf_k*sqrt(2.))
+          pdf_a = log(qcontr2 / q) / (pdf_k * sqrt(2.))
+          pdf_e1 = pdf_a + pdf_b   !--normalement pdf_b est deja defini
+          IF (abs(pdf_e1)>=erf_lim) THEN
+            pdf_e1 = sign(1., pdf_e1)
+          ELSE
+            pdf_e1 = erf(pdf_e1)
+          ENDIF
+
+          pdf_a = log(qsat / q) / (pdf_k * sqrt(2.))
+          pdf_e2 = pdf_a + pdf_b
+          IF (abs(pdf_e2)>=erf_lim) THEN
+            pdf_e2 = sign(1., pdf_e2)
+          ELSE
+            pdf_e2 = erf(pdf_e2)
+          ENDIF
+
+          !!fcontrN(i,k) = 0.5*(pdf_e1-pdf_e2)
+          fcontrN = 0.5 * (pdf_e1 - pdf_e2)
+          !!fcontrN=2.0
+
         ENDIF
-        pdf_e2 = 0.5*(1.+pdf_e2) ! integrale sous P pour q > gamma qsat
-
-        IF (abs(pdf_e1-pdf_e2)<eps) THEN
-           pdf_N1 = pdf_N2
-        ELSE
-           pdf_N1 = (rneb-pdf_N2*pdf_e2)/(pdf_e1-pdf_e2)
-        ENDIF
-
-        ! Barriere qui traite le cas gamma_prec = 1.
-        IF (pdf_N1<=0.) THEN
-           pdf_N1 = 0.
-           IF (pdf_e2>eps) THEN
-              pdf_N2 = rneb/pdf_e2
-           ELSE
-              pdf_N2 = 0.
-           ENDIF
-        ENDIF
-     ENDIF
-
-     ! Physique 1
-     ! Sublimation
-     IF (qvc<qsat) THEN
-        pdf_a = log(qvc/q)/(pdf_k*sqrt(2.))
-        pdf_e1 = pdf_a+pdf_b
-        IF (abs(pdf_e1)>=erf_lim) THEN
-           pdf_e1 = sign(1.,pdf_e1)
-        ELSE
-           pdf_e1 = erf(pdf_e1)
-        ENDIF
-
-        pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
-        pdf_e2 = pdf_a+pdf_b
-        IF (abs(pdf_e2)>=erf_lim) THEN
-           pdf_e2 = sign(1.,pdf_e2)
-        ELSE
-           pdf_e2 = erf(pdf_e2)
-        ENDIF
-
-        pdf_e1 = 0.5*pdf_N1*(pdf_e1-pdf_e2)
-        
-        ! Calcul et ajout de la tendance
-        drneb_sub(i,k) = - pdf_e1/dtime    !--unit [s-1]
-        rneb = rneb + drneb_sub(i,k)*dtime
-     ELSE
-        drneb_sub(i,k) = 0.
-     ENDIF
-     
-     ! NOTE : verifier si ca marche bien pour gamma proche de 1.
-
-     ! Condensation
-     IF (gamma_ss*qsat<gamma_prec*qvc) THEN
-     
-        pdf_a = log(gamma_ss*qsat/q)/(pdf_k*sqrt(2.))
-        pdf_e1 = pdf_a+pdf_b
-        IF (abs(pdf_e1)>=erf_lim) THEN
-           pdf_e1 = sign(1.,pdf_e1)
-        ELSE
-           pdf_e1 = erf(pdf_e1)
-        ENDIF
-
-        pdf_a = log(gamma_prec*qvc/q)/(pdf_k*sqrt(2.))
-        pdf_e2 = pdf_a+pdf_b
-        IF (abs(pdf_e2)>=erf_lim) THEN
-           pdf_e2 = sign(1.,pdf_e2)
-        ELSE
-           pdf_e2 = erf(pdf_e2)
-        ENDIF
-
-        pdf_e1 = 0.5*(1.-pdf_N1)*(pdf_e1-pdf_e2)
-        pdf_e2 = 0.5*(1.-pdf_N2)*(1.+pdf_e2)
-
-        ! Calcul et ajout de la tendance
-        drneb_con(i,k) = (pdf_e1 + pdf_e2)/dtime         !--unit [s-1]
-        rneb = rneb + drneb_con(i,k)*dtime
-        
-     ELSE
-     
-        pdf_a = log(gamma_ss*qsat/q)/(pdf_k*sqrt(2.))
-        pdf_e1 = pdf_a+pdf_b
-        IF (abs(pdf_e1)>=erf_lim) THEN
-           pdf_e1 = sign(1.,pdf_e1)
-        ELSE
-           pdf_e1 = erf(pdf_e1)
-        ENDIF
-        pdf_e1 = 0.5*(1.-pdf_N2)*(1.+pdf_e1)
-
-        ! Calcul et ajout de la tendance
-        drneb_con(i,k) = pdf_e1/dtime         !--unit [s-1]
-        rneb = rneb + drneb_con(i,k)*dtime
-        
-     ENDIF
-
-     ! Calcul des grandeurs diagnostiques
-     ! Determination des grandeurs ciel clair
-     pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
-     pdf_e1 = pdf_a+pdf_b
-     IF (abs(pdf_e1)>=erf_lim) THEN
-        pdf_e1 = sign(1.,pdf_e1)
-     ELSE
-        pdf_e1 = erf(pdf_e1)
-     ENDIF
-     pdf_e1 = 0.5*(1.-pdf_e1)
-
-     pdf_e2 = pdf_a-pdf_b
-     IF (abs(pdf_e2)>=erf_lim) THEN
-        pdf_e2 = sign(1.,pdf_e2)
-     ELSE
-        pdf_e2 = erf(pdf_e2)
-     ENDIF
-     pdf_e2 = 0.5*q*(1.-pdf_e2)
-
-     rnebclr = pdf_e1
-     qclr = pdf_e2
-
-     ! Determination de q_cld
-     ! Partie 1
-     pdf_a = log(max(qsat,qvc)/q)/(pdf_k*sqrt(2.))
-     pdf_e1 = pdf_a-pdf_b
-     IF (abs(pdf_e1)>=erf_lim) THEN
-        pdf_e1 = sign(1.,pdf_e1)
-     ELSE
-        pdf_e1 = erf(pdf_e1)
-     ENDIF
-
-     pdf_a = log(min(gamma_ss*qsat,gamma_prec*qvc)/q)/(pdf_k*sqrt(2.))
-     pdf_e2 = pdf_a-pdf_b
-     IF (abs(pdf_e2)>=erf_lim) THEN
-        pdf_e2 = sign(1.,pdf_e2)
-     ELSE
-        pdf_e2 = erf(pdf_e2)
-     ENDIF
-
-     pdf_e1 = 0.5*q*pdf_N1*(pdf_e1-pdf_e2)
-     
-     qcld = pdf_e1
-
-     ! Partie 2 (sous condition)
-     IF (gamma_ss*qsat>gamma_prec*qvc) THEN
-        pdf_a = log(gamma_ss*qsat/q)/(pdf_k*sqrt(2.))
-        pdf_e1 = pdf_a-pdf_b
-        IF (abs(pdf_e1)>=erf_lim) THEN
-           pdf_e1 = sign(1.,pdf_e1)
-        ELSE
-           pdf_e1 = erf(pdf_e1)
-        ENDIF
-
-        pdf_e2 = 0.5*q*pdf_N2*(pdf_e2-pdf_e1)
-
-        qcld = qcld + pdf_e2
-
-        pdf_e2 = pdf_e1  
-     ENDIF
-
-     ! Partie 3
-     pdf_e2 = 0.5*q*(1.+pdf_e2)
-     
-     qcld = qcld + pdf_e2
-
-     ! Fin du calcul de q_cld
-     
-     ! Determination des grandeurs ISSR via les equations de conservation
-     rneb=MIN(rneb, 1. - rnebclr - eps)      !--ajout OB - barrière
-     rnebss = MAX(0.0, 1. - rnebclr - rneb)  !--ajout OB
-     qss = MAX(0.0, q - qclr - qcld)         !--ajout OB
-
-     ! Physique 2 : Turbulence
-     IF (rneb>eps.AND.rneb<1.-eps) THEN ! rneb != 0 and != 1
-
-       tke = pbl_tke(i,k,is_ave)
-       ! A MODIFIER formule a revoir
-       L_tur = min(l_turb, sqrt(tke)*dtime)
-
-       ! On fait pour l'instant l'hypothese a = 3b. V = 4/3 pi a b**2 = alpha_cld
-       ! donc b = alpha_cld/4pi **1/3. 
-       b_tur = (rneb*V_cell/4./PI/N_cld)**(1./3.)
-       ! On verifie que la longeur de melange n'est pas trop grande
-       IF (L_tur>b_tur) THEN
-          L_tur = b_tur
-       ENDIF
-       
-       V_env = N_cld*4.*PI*(3.*(b_tur**2.)*L_tur + L_tur**3. + 3.*b_tur*(L_tur**2.))
-       V_cld = N_cld*4.*PI*(3.*(b_tur**2.)*L_tur + L_tur**3. - 3.*b_tur*(L_tur**2.))
-       V_cld = abs(V_cld)
-
-       ! Repartition statistique des zones de contact nuage-ISSR et nuage-ciel clair
-       sig = rnebss/(chi*rnebclr+rnebss)
-       V_ss = MIN(sig*V_env,rnebss*V_cell)
-       V_clr = MIN((1.-sig)*V_env,rnebclr*V_cell)
-       V_cld = MIN(V_cld,rneb*V_cell)
-       V_env = V_ss + V_clr
-
-       ! ISSR => rneb
-       drnebss = -1.*V_ss/V_cell
-       dqss = drnebss*qss/MAX(eps,rnebss)
-
-       ! Clear sky <=> rneb
-       q_eq = V_env*qclr/MAX(eps,rnebclr) + V_cld*qcld/MAX(eps,rneb)
-       q_eq = q_eq/(V_env + V_cld)
-
-       IF (q_eq>qsat) THEN
-          drnebclr = - V_clr/V_cell
-          dqclr = drnebclr*qclr/MAX(eps,rnebclr)
-       ELSE
-          drnebclr = V_cld/V_cell
-          dqclr = drnebclr*qcld/MAX(eps,rneb)
-       ENDIF
-
-       ! Maj des variables avec les tendances
-       rnebclr = MAX(0.0,rnebclr + drnebclr)   !--OB ajout d'un max avec eps (il faudrait modified drnebclr pour le diag)
-       qclr = MAX(0.0, qclr + dqclr)           !--OB ajout d'un max avec 0
-
-       rneb = rneb - drnebclr - drnebss
-       qcld = qcld - dqclr - dqss
-
-       rnebss = MAX(0.0,rnebss + drnebss)     !--OB ajout d'un max avec eps (il faudrait modifier drnebss pour le diag)
-       qss = MAX(0.0, qss + dqss)             !--OB ajout d'un max avec 0
-
-       ! Tendances pour le diagnostic
-       drneb_tur(i,k) = (drnebclr + drnebss)/dtime  !--unit [s-1]
-
-     ENDIF ! rneb
-
-     !--add a source of cirrus from aviation contrails
-     IF (ok_plane_contrail) THEN
-       drneb_avi(i,k) = rnebss*flight_m(i,k)*contrail_cross_section/V_cell    !--tendency rneb due to aviation [s-1]
-       drneb_avi(i,k) = MIN(drneb_avi(i,k), rnebss/dtime)                     !--majoration
-       dqss_avi = qss*drneb_avi(i,k)/MAX(eps,rnebss)                          !--tendency q aviation [kg kg-1 s-1]
-       rneb = rneb + drneb_avi(i,k)*dtime                                     !--add tendency to rneb
-       qcld = qcld + dqss_avi*dtime                                           !--add tendency to qcld
-       rnebss = rnebss - drneb_avi(i,k)*dtime                                 !--add tendency to rnebss
-       qss = qss - dqss_avi*dtime                                             !--add tendency to qss
-     ELSE 
-       drneb_avi(i,k)=0.0 
-     ENDIF
-
-     ! Barrieres
-     ! ISSR trop petite
-     IF (rnebss<eps) THEN
-        rneb = MIN(rneb + rnebss,1.0-eps) !--ajout OB barriere
-        qcld = qcld + qss
-        rnebss = 0.
-        qss = 0.
-     ENDIF
-
-     ! le nuage est trop petit
-     IF (rneb<eps) THEN
-        ! s'il y a une ISSR on met tout dans l'ISSR, sinon dans le
-        ! clear sky
-        IF (rnebss<eps) THEN
-           rnebclr = 1.
-           rnebss = 0. !--ajout OB
-           qclr = q
-        ELSE
-           rnebss = MIN(rnebss + rneb,1.0-eps) !--ajout OB barriere
-           qss = qss + qcld
-        ENDIF
-        rneb = 0.
-        qcld = 0.
-        qincld = qsat * gamma_ss
-     ELSE
-        qincld = qcld / rneb
-     ENDIF
-
-     !--OB ajout borne superieure
-     sum_rneb_rnebss=rneb+rnebss
-     rneb=rneb*MIN(1.-eps,sum_rneb_rnebss)/MAX(eps,sum_rneb_rnebss)
-     rnebss=rnebss*MIN(1.-eps,sum_rneb_rnebss)/MAX(eps,sum_rneb_rnebss)
-
-     ! On ecrit dans la memoire
-     N1_ss(i,k) = pdf_N1
-     N2_ss(i,k) = pdf_N2
-   
-     !--Diagnostics only used from last iteration
-     !--test
-     !!Tcontr(i,k)=200.
-     !!fcontrN(i,k)=1.0
-     !!fcontrP(i,k)=0.5
-
-     !--slope of dilution line in exhaust
-     !--kg H2O/kg fuel * J kg air-1 K-1 * Pa / (kg H2O / kg air * J kg fuel-1) 
-     Gcontr = EiH2O * RCPD * pplay / (eps_w*Qheat*(1.-eta))             !--Pa K-1
-     !--critical T_LM below which no liquid contrail can form in exhaust
-     !Tcontr(i,k) = 226.69+9.43*log(Gcontr-0.053)+0.72*(log(Gcontr-0.053))**2 !--K
-     IF (Gcontr > 0.1) THEN
-
-       Tcontr = 226.69+9.43*log(Gcontr-0.053)+0.72*(log(Gcontr-0.053))**2 !--K
-       !print *,'Tcontr=',iter,i,k,eps_w,pplay,Gcontr,Tcontr(i,k)
-       !--Psat with index 0 in FOEEW to get saturation wrt liquid water corresponding to Tcontr
-       !qsatliqcontr = RESTT*FOEEW(Tcontr(i,k),0.)                               !--Pa
-       qsatliqcontr = RESTT*FOEEW(Tcontr,0.)                               !--Pa
-       !--Critical water vapour above which there is contrail formation for ambiant temperature 
-       !qcontr(i,k) = Gcontr*(t-Tcontr(i,k)) + qsatliqcontr                      !--Pa
-       qcontr = Gcontr*(t-Tcontr) + qsatliqcontr                      !--Pa
-       !--Conversion of qcontr in specific humidity - method 1
-       !qcontr(i,k) = RD/RV*qcontr(i,k)/pplay      !--so as to return to something similar to R2ES*FOEEW/pplay
-       qcontr2 = RD/RV*qcontr/pplay      !--so as to return to something similar to R2ES*FOEEW/pplay
-       !qcontr(i,k) = min(0.5,qcontr(i,k))         !--and then we apply the same correction term as for qsat
-       qcontr2 = min(0.5,qcontr2)         !--and then we apply the same correction term as for qsat
-       !zcor = 1./(1.-RETV*qcontr(i,k))            !--for consistency with qsat but is it correct at all?
-       zcor = 1./(1.-RETV*qcontr2)            !--for consistency with qsat but is it correct at all as p is dry?
-       !zcor = 1./(1.+qcontr2)                 !--for consistency with qsat
-       !qcontr(i,k) = qcontr(i,k)*zcor
-       qcontr2 = qcontr2*zcor
-       qcontr2=MAX(1.e-10,qcontr2)            !--eliminate negative values due to extrapolation on dilution curve
-       !--Conversion of qcontr in specific humidity - method 2
-       !qcontr(i,k) = eps_w*qcontr(i,k) / (pplay+eps_w*qcontr(i,k))
-       !qcontr=MAX(1.E-10,qcontr)
-       !qcontr2 = eps_w*qcontr / (pplay+eps_w*qcontr)
-
-       IF (t < Tcontr) THEN !--contrail formation is possible
-
-       !--compute fractions of persistent (P) and non-persistent(N) contrail potential regions
-       !!IF (qcontr(i,k).GE.qsat) THEN
-       IF (qcontr2>=qsat) THEN
-         !--none of the unsaturated clear sky is prone for contrail formation
-         !!fcontrN(i,k) = 0.0
-         fcontrN = 0.0
-
-         !--integral of P(q) from qsat to qcontr in ISSR 
-         pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
-         pdf_e1 = pdf_a+pdf_b
-         IF (abs(pdf_e1)>=erf_lim) THEN
-            pdf_e1 = sign(1.,pdf_e1)
-         ELSE
-            pdf_e1 = erf(pdf_e1)
-         ENDIF
-
-         !!pdf_a = log(MIN(qcontr(i,k),qvc)/q)/(pdf_k*sqrt(2.))
-         pdf_a = log(MIN(qcontr2,qvc)/q)/(pdf_k*sqrt(2.))
-         pdf_e2 = pdf_a+pdf_b
-         IF (abs(pdf_e2)>=erf_lim) THEN
-            pdf_e2 = sign(1.,pdf_e2)
-         ELSE
-            pdf_e2 = erf(pdf_e2)
-         ENDIF
-
-         !!fcontrP(i,k) = MAX(0., 0.5*(pdf_e1-pdf_e2))
-         fcontrP = MAX(0., 0.5*(pdf_e1-pdf_e2))
-
-         pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
-         pdf_e1 = pdf_a+pdf_b
-         IF (abs(pdf_e1)>=erf_lim) THEN
-            pdf_e1 = sign(1.,pdf_e1)
-         ELSE
-            pdf_e1 = erf(pdf_e1)
-         ENDIF
-
-         !!pdf_a = log(MIN(qcontr(i,k),qvc)/q)/(pdf_k*sqrt(2.))
-         pdf_a = log(MIN(qcontr2,qvc)/q)/(pdf_k*sqrt(2.))
-         pdf_e2 = pdf_a+pdf_b
-         IF (abs(pdf_e2)>=erf_lim) THEN
-            pdf_e2 = sign(1.,pdf_e2)
-         ELSE
-            pdf_e2 = erf(pdf_e2)
-         ENDIF
-
-         !!fcontrP(i,k) = MAX(0., 0.5*(pdf_e1-pdf_e2))
-         fcontrP = MAX(0., 0.5*(pdf_e1-pdf_e2))
-
-         pdf_a = log(MAX(qsat,qvc)/q)/(pdf_k*sqrt(2.))
-         pdf_e1 = pdf_a+pdf_b
-         IF (abs(pdf_e1)>=erf_lim) THEN
-            pdf_e1 = sign(1.,pdf_e1)
-         ELSE
-            pdf_e1 = erf(pdf_e1)
-         ENDIF
-
-         !!pdf_a = log(MIN(qcontr(i,k),MIN(gamma_prec*qvc,gamma_ss*qsat))/q)/(pdf_k*sqrt(2.))
-         pdf_a = log(MIN(qcontr2,MIN(gamma_prec*qvc,gamma_ss*qsat))/q)/(pdf_k*sqrt(2.))
-         pdf_e2 = pdf_a+pdf_b
-         IF (abs(pdf_e2)>=erf_lim) THEN
-            pdf_e2 = sign(1.,pdf_e2)
-         ELSE
-            pdf_e2 = erf(pdf_e2)
-         ENDIF
-
-         !!fcontrP(i,k) = fcontrP(i,k) + MAX(0., 0.5*(1-pdf_N1)*(pdf_e1-pdf_e2))
-         fcontrP = fcontrP + MAX(0., 0.5*(1-pdf_N1)*(pdf_e1-pdf_e2))
-
-         pdf_a = log(gamma_prec*qvc/q)/(pdf_k*sqrt(2.))
-         pdf_e1 = pdf_a+pdf_b
-         IF (abs(pdf_e1)>=erf_lim) THEN
-            pdf_e1 = sign(1.,pdf_e1)
-         ELSE
-            pdf_e1 = erf(pdf_e1)
-         ENDIF
-
-         !!pdf_a = log(MIN(qcontr(i,k),gamma_ss*qsat)/q)/(pdf_k*sqrt(2.))
-         pdf_a = log(MIN(qcontr2,gamma_ss*qsat)/q)/(pdf_k*sqrt(2.))
-         pdf_e2 = pdf_a+pdf_b
-         IF (abs(pdf_e2)>=erf_lim) THEN
-            pdf_e2 = sign(1.,pdf_e2)
-         ELSE
-            pdf_e2 = erf(pdf_e2)
-         ENDIF
-
-         !!fcontrP(i,k) = fcontrP(i,k) + MAX(0., 0.5*(1-pdf_N2)*(pdf_e1-pdf_e2))
-         fcontrP = fcontrP + MAX(0., 0.5*(1-pdf_N2)*(pdf_e1-pdf_e2))
-
-       ELSE  !--qcontr LT qsat
-
-         !--all of ISSR is prone for contrail formation
-         !!fcontrP(i,k) = rnebss
-         fcontrP = rnebss
-
-         !--integral of zq from qcontr to qsat in unsaturated clear-sky region
-         !!pdf_a = log(qcontr(i,k)/q)/(pdf_k*sqrt(2.))
-         pdf_a = log(qcontr2/q)/(pdf_k*sqrt(2.))
-         pdf_e1 = pdf_a+pdf_b   !--normalement pdf_b est deja defini
-         IF (abs(pdf_e1)>=erf_lim) THEN
-            pdf_e1 = sign(1.,pdf_e1)
-         ELSE
-            pdf_e1 = erf(pdf_e1)
-         ENDIF
-
-         pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
-         pdf_e2 = pdf_a+pdf_b
-         IF (abs(pdf_e2)>=erf_lim) THEN
-            pdf_e2 = sign(1.,pdf_e2)
-         ELSE
-            pdf_e2 = erf(pdf_e2)
-         ENDIF
-
-         !!fcontrN(i,k) = 0.5*(pdf_e1-pdf_e2)
-         fcontrN = 0.5*(pdf_e1-pdf_e2)
-         !!fcontrN=2.0
-
-       ENDIF
-
-       ENDIF !-- t < Tcontr
-
-     ENDIF !-- Gcontr > 0.1
-
-
-END SUBROUTINE ice_sursat
-
-!*******************************************************************
+
+      ENDIF !-- t < Tcontr
+
+    ENDIF !-- Gcontr > 0.1
+
+  END SUBROUTINE ice_sursat
+
+  !*******************************************************************
 
 END MODULE ice_sursat_mod
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_ts2.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_ts2.f90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_ts2.f90	(revision 5143)
@@ -67,4 +67,6 @@
   USE indice_sol_mod
   USE lmdz_comsoil, ONLY: inertie_sol, inertie_sno, inertie_sic, inertie_lic, iflag_sic, iflag_inertie
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   IMPLICIT NONE
@@ -75,6 +77,4 @@
 
   INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
-  INCLUDE "FCTTRE.h"
   ! INCLUDE "indicesol.h"
   ! include  "LMDZphy.inc"
@@ -263,5 +263,5 @@
             * TsisSV(ig, isl)                     & !
             * TsisSV(ig, isl)
-    IRs__D(ig) = dIRsdT(ig)* TsisSV(ig, isl) * 0.75                  !:
+    IRs__D(ig) = dIRsdT(ig) * TsisSV(ig, isl) * 0.75                  !:
   END DO
   !hj
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_FCTTRE.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_FCTTRE.f90	(revision 5143)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_FCTTRE.f90	(revision 5143)
@@ -0,0 +1,57 @@
+MODULE lmdz_fcttre
+  !     ------------------------------------------------------------------
+  !     This COMDECK includes the Thermodynamical functions for the cy39
+  !       ECMWF Physics package.
+  !       Consistent with YOMCST Basic physics constants, assuming the
+  !       partial pressure of water vapour is given by a first order
+  !       Taylor expansion of Qs(T) w.r.t. to Temperature, using constants
+  !       in YOETHF
+  !     ------------------------------------------------------------------
+
+  IMPLICIT NONE; PRIVATE
+  PUBLIC foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
+  LOGICAL, PARAMETER :: thermcep = .TRUE.
+
+CONTAINS
+
+  REAL FUNCTION foeew (ptarg, pdelarg)
+    USE lmdz_YOETHF, ONLY: r3ies, r3les, r4ies, r4les
+    INCLUDE "YOMCST.h"  ! rtt
+    REAL, INTENT(IN) :: ptarg, pdelarg
+    foeew = exp ((r3les * (1. - pdelarg) + r3ies * pdelarg) * (ptarg - rtt) &
+            / (ptarg - (r4les * (1. - pdelarg) + r4ies * pdelarg)))
+  END FUNCTION foeew
+
+  REAL FUNCTION foede (ptarg, pdelarg, p5arg, pqsarg, pcoarg)
+    USE lmdz_YOETHF, ONLY: r4ies, r4les
+    REAL, INTENT(IN) :: ptarg, pdelarg, p5arg, pqsarg, pcoarg
+    foede = pqsarg * pcoarg * p5arg / (ptarg - (r4les * (1. - pdelarg) + r4ies * pdelarg))**2
+  END FUNCTION foede
+
+  REAL FUNCTION qsats(ptarg)
+    REAL, INTENT(IN) :: ptarg
+    qsats = 100.0 * 0.622 * 10.0 ** (2.07023 - 0.00320991 * ptarg - 2484.896 / ptarg + 3.56654 * log10(ptarg))
+  END FUNCTION qsats
+
+  REAL FUNCTION qsatl(ptarg)
+    REAL, INTENT(IN) :: ptarg
+    qsatl = 100.0 * 0.622 * 10.0 ** (23.8319 - 2948.964 / ptarg - 5.028 * log10(ptarg) &
+            - 29810.16 * exp(- 0.0699382 * ptarg) + 25.21935 * exp(- 2999.924 / ptarg))
+  END FUNCTION qsatl
+
+  REAL FUNCTION dqsats(ptarg, pqsarg)
+    REAL, INTENT(IN) :: ptarg, pqsarg
+    INCLUDE "YOMCST.h"  ! rlvtt, rcpd
+    dqsats = rlvtt / rcpd * pqsarg * (3.56654 / ptarg + 2484.896 * log(10.) / ptarg**2 - 0.00320991 * log(10.))
+  END FUNCTION dqsats
+
+  REAL FUNCTION dqsatl(ptarg, pqsarg)
+    REAL, INTENT(IN) :: ptarg, pqsarg
+    INCLUDE "YOMCST.h"  ! rlvtt, rcpd
+    dqsatl = rlvtt / rcpd * pqsarg * log(10.) * (2948.964 / ptarg**2 - 5.028 / log(10.) / ptarg &
+            + 25.21935 * 2999.924 / ptarg**2 * exp(-2999.924 / ptarg) + &
+            29810.16 * 0.0699382 * exp(-0.0699382 * ptarg))
+  END FUNCTION dqsatl
+
+END MODULE lmdz_fcttre
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_YOEGWD.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_YOEGWD.f90	(revision 5143)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_YOEGWD.f90	(revision 5143)
@@ -0,0 +1,22 @@
+!*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
+MODULE lmdz_YOEGWD
+  IMPLICIT NONE; PRIVATE
+  PUBLIC GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
+  INTEGER NKTOPG, NSTRA
+  REAL GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT
+  REAL GHMAX, GRAHILO, GSIGCR, GSSEC, GTSEC, GVSEC
+
+  REAL GWD_RANDO_RUWMAX
+  !     Maximum Eliassen-Palm flux at launch level, in "FLOTT_GWD_rando"
+
+  REAL GWD_RANDO_SAT ! saturation parameter in "FLOTT_GWD_rando"
+  !     S_c in equation (12) of Lott (JGR, vol 118, page 8897, 2013)
+
+  REAL GWD_FRONT_RUWMAX, GWD_FRONT_SAT
+  ! Same as GWD_RANDO params but for fronal GWs
+
+  !$OMP THREADPRIVATE(GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+  !$OMP          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat)
+END MODULE lmdz_YOEGWD
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_YOETHF.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_YOETHF.f90	(revision 5143)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_YOETHF.f90	(revision 5143)
@@ -0,0 +1,24 @@
+MODULE lmdz_YOETHF
+  !*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
+
+  !     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
+  !                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
+  !                ICE(*R_IES*).
+  !     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
+  !     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
+  IMPLICIT NONE; PRIVATE
+  PUBLIC R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, RVTMP2, RHOH2O, R5ALVCP, &
+          R5ALSCP, RALVDCP, RALSDCP, RALFDCP, RTWAT, RTBER, RTBERCU, RTICE, RTICECU, &
+          RTWAT_RTICE_R, RTWAT_RTICECU_R, RKOOP1, RKOOP2, OK_BAD_ECMWF_THERMO
+
+  REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
+  REAL RVTMP2, RHOH2O
+  REAL R5ALVCP, R5ALSCP, RALVDCP, RALSDCP, RALFDCP, RTWAT, RTBER, RTBERCU
+  REAL RTICE, RTICECU, RTWAT_RTICE_R, RTWAT_RTICECU_R, RKOOP1, RKOOP2
+  LOGICAL OK_BAD_ECMWF_THERMO ! If TRUE, then variables set by rrtm/suphec.F90
+  ! If FALSE, then variables set by suphel.F90
+
+  !$OMP THREADPRIVATE(R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, RVTMP2, RHOH2O, R5ALVCP, &
+  !$OMP      R5ALSCP, RALVDCP, RALSDCP, RALFDCP, RTWAT, RTBER, RTBERCU, RTICE, RTICECU,&
+  !$OMP      RTWAT_RTICE_R, RTWAT_RTICECU_R, RKOOP1, RKOOP2, OK_BAD_ECMWF_THERMO)
+END MODULE lmdz_YOETHF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_alpale.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_alpale.f90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_alpale.f90	(revision 5143)
@@ -44,4 +44,5 @@
     USE phys_local_var_mod, ONLY: zw2       ! Variables internes non sauvegardees de la physique
     USE lmdz_abort_physic, ONLY: abort_physic
+    USE lmdz_YOETHF
 
     IMPLICIT NONE
@@ -74,5 +75,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
 
     ! Local variables
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5143)
@@ -14,4 +14,6 @@
 
       USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
+      USE lmdz_YOETHF
+      USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
       IMPLICIT NONE
@@ -26,6 +28,4 @@
 
       INCLUDE "YOMCST.h"
-      INCLUDE "YOETHF.h"
-      INCLUDE "FCTTRE.h"
 
       INTEGER itap,ind1,ind2
@@ -265,11 +265,11 @@
 
       USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert, vert_alpha
+      USE lmdz_YOETHF
+      USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
       IMPLICIT NONE
 
       INCLUDE "YOMCST.h"
-      INCLUDE "YOETHF.h"
-      INCLUDE "FCTTRE.h"
-      
+
       INTEGER itap,ind1,ind2
       INTEGER ngrid,klev,klon,l,ig 
@@ -585,4 +585,6 @@
 
       USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert
+      USE lmdz_YOETHF
+      USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
       IMPLICIT NONE
@@ -597,6 +599,4 @@
 
       INCLUDE "YOMCST.h"
-      INCLUDE "YOETHF.h"
-      INCLUDE "FCTTRE.h"
 
       INTEGER, INTENT(IN) :: ind2
@@ -818,13 +818,11 @@
       USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
       USE lmdz_cloudth_ini, ONLY: vert_alpha,vert_alpha_th, sigma1s_factor, sigma1s_power , sigma2s_factor , sigma2s_power , cloudth_ratqsmin , iflag_cloudth_vert_noratqs
+      USE lmdz_YOETHF
+      USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
       IMPLICIT NONE
 
-
-
       INCLUDE "YOMCST.h"
-      INCLUDE "YOETHF.h"
-      INCLUDE "FCTTRE.h"
-      
+
       INTEGER itap,ind1,ind2
       INTEGER ngrid,klev,klon,l,ig 
@@ -1231,11 +1229,10 @@
 
       USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert
+      USE lmdz_YOETHF
+      USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
       IMPLICIT NONE
 
-
       INCLUDE "YOMCST.h"
-      INCLUDE "YOETHF.h"
-      INCLUDE "FCTTRE.h"
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_conema3.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_conema3.f90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_conema3.f90	(revision 5143)
@@ -27,4 +27,7 @@
     USE dimphy
     USE infotrac_phy, ONLY: nbtr
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
     IMPLICIT NONE
     ! ======================================================================
@@ -193,6 +196,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
 
     IF (first) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5143)
@@ -24,6 +24,6 @@
   USE lmdz_lscp_ini, ONLY: cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
   USE lmdz_lscp_ini, ONLY: reevap_ice, iflag_bergeron, iflag_fisrtilp_qsat, iflag_pdf 
-
-
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   IMPLICIT NONE
@@ -54,6 +54,4 @@
   !======================================================================
   include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
 
   ! Principaux inputs:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90	(revision 5143)
@@ -511,11 +511,10 @@
     ! Calculate qsat following ECMWF method
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     IMPLICIT NONE
 
     include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
 
     INTEGER, INTENT(IN) :: klon  ! number of horizontal grid points
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90	(revision 5143)
@@ -13,10 +13,6 @@
 ! total water subgrid distribution.
 !=============================================
-
+USE lmdz_YOETHF
 IMPLICIT NONE
-
-!=============================================
-    INCLUDE "YOETHF.h"
-
 
       CONTAINS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5143)
@@ -22,4 +22,6 @@
       USE lmdz_thermcell_main, ONLY: thermcell_tke_transport
       USE lmdz_alpale
+      USE lmdz_YOETHF
+      USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
       IMPLICIT NONE
@@ -40,6 +42,4 @@
 
       INCLUDE "YOMCST.h"
-      INCLUDE "YOETHF.h"
-      INCLUDE "FCTTRE.h"
 
 !   arguments:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5143)
@@ -718,4 +718,7 @@
 
     USE dimphy
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
     IMPLICIT NONE
 
@@ -745,6 +748,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
 
     ! arguments:
@@ -2313,4 +2314,7 @@
 
     USE dimphy
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
     IMPLICIT NONE
 
@@ -2340,6 +2344,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
 
     ! arguments:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5143)
@@ -3,10 +3,9 @@
 
 SUBROUTINE thermcell_qsat(klon,active,pplev,ztemp,zqta,zqsat)
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 IMPLICIT NONE
 
   INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
-  INCLUDE "FCTTRE.h"
-
 
 !====================================================================
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/nonlocal.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/nonlocal.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/nonlocal.F90	(revision 5143)
@@ -1,9 +1,11 @@
-
 ! $Header$
 
 ! ======================================================================
 SUBROUTINE nonlocal(knon, paprs, pplay, tsol, beta, u, v, t, q, cd_h, cd_m, &
-    pcfh, pcfm, cgh, cgq)
+        pcfh, pcfm, cgh, cgq)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
   ! ======================================================================
@@ -27,5 +29,5 @@
   REAL tsol(klon) ! temperature du sol (K)
   REAL beta(klon) ! efficacite d'evaporation (entre 0 et 1)
-  REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
+  REAL paprs(klon, klev + 1) ! pression a inter-couche (Pa)
   REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
   REAL u(klon, klev) ! vitesse U (m/s)
@@ -38,31 +40,31 @@
   INTEGER isommet
   REAL vk
-  PARAMETER (vk=0.40)
+  PARAMETER (vk = 0.40)
   REAL ricr
-  PARAMETER (ricr=0.4)
+  PARAMETER (ricr = 0.4)
   REAL fak
-  PARAMETER (fak=8.5)
+  PARAMETER (fak = 8.5)
   REAL fakn
-  PARAMETER (fakn=7.2)
+  PARAMETER (fakn = 7.2)
   REAL onet
-  PARAMETER (onet=1.0/3.0)
+  PARAMETER (onet = 1.0 / 3.0)
   REAL t_coup
-  PARAMETER (t_coup=273.15)
+  PARAMETER (t_coup = 273.15)
   REAL zkmin
-  PARAMETER (zkmin=0.01)
+  PARAMETER (zkmin = 0.01)
   REAL betam
-  PARAMETER (betam=15.0)
+  PARAMETER (betam = 15.0)
   REAL betah
-  PARAMETER (betah=15.0)
+  PARAMETER (betah = 15.0)
   REAL betas
-  PARAMETER (betas=5.0)
+  PARAMETER (betas = 5.0)
   REAL sffrac
-  PARAMETER (sffrac=0.1)
+  PARAMETER (sffrac = 0.1)
   REAL binm
-  PARAMETER (binm=betam*sffrac)
+  PARAMETER (binm = betam * sffrac)
   REAL binh
-  PARAMETER (binh=betah*sffrac)
+  PARAMETER (binh = betah * sffrac)
   REAL ccon
-  PARAMETER (ccon=fak*sffrac*vk)
+  PARAMETER (ccon = fak * sffrac * vk)
 
   REAL z(klon, klev)
@@ -107,7 +109,4 @@
   REAL fac, pblmin, zmzp, term
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
   ! Initialisation
 
@@ -131,11 +130,11 @@
 
   DO i = 1, knon
-    z(i, 1) = rd*t(i, 1)/(0.5*(paprs(i,1)+pplay(i,1)))*(paprs(i,1)-pplay(i,1) &
-      )/rg
+    z(i, 1) = rd * t(i, 1) / (0.5 * (paprs(i, 1) + pplay(i, 1))) * (paprs(i, 1) - pplay(i, 1) &
+            ) / rg
   END DO
   DO k = 2, klev
     DO i = 1, knon
-      z(i, k) = z(i, k-1) + rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)*(pplay(i,k-1 &
-        )-pplay(i,k))/rg
+      z(i, k) = z(i, k - 1) + rd * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) * (pplay(i, k - 1 &
+              ) - pplay(i, k)) / rg
     END DO
   END DO
@@ -143,32 +142,32 @@
   DO i = 1, knon
     IF (thermcep) THEN
-      zdelta = max(0., sign(1.,rtt-tsol(i)))
-      zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta
-      zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*q(i,1))
-      zxqs = r2es*foeew(tsol(i), zdelta)/paprs(i, 1)
+      zdelta = max(0., sign(1., rtt - tsol(i)))
+      zcvm5 = r5les * rlvtt * (1. - zdelta) + r5ies * rlstt * zdelta
+      zcvm5 = zcvm5 / rcpd / (1.0 + rvtmp2 * q(i, 1))
+      zxqs = r2es * foeew(tsol(i), zdelta) / paprs(i, 1)
       zxqs = min(0.5, zxqs)
-      zcor = 1./(1.-retv*zxqs)
-      zxqs = zxqs*zcor
+      zcor = 1. / (1. - retv * zxqs)
+      zxqs = zxqs * zcor
     ELSE
       IF (tsol(i)<t_coup) THEN
-        zxqs = qsats(tsol(i))/paprs(i, 1)
+        zxqs = qsats(tsol(i)) / paprs(i, 1)
       ELSE
-        zxqs = qsatl(tsol(i))/paprs(i, 1)
+        zxqs = qsatl(tsol(i)) / paprs(i, 1)
       END IF
     END IF
     zx_alf1 = 1.0
     zx_alf2 = 1.0 - zx_alf1
-    zxt = (t(i,1)+z(i,1)*rg/rcpd/(1.+rvtmp2*q(i,1)))*(1.+retv*q(i,1))*zx_alf1 &
-      + (t(i,2)+z(i,2)*rg/rcpd/(1.+rvtmp2*q(i,2)))*(1.+retv*q(i,2))*zx_alf2
-    zxu = u(i, 1)*zx_alf1 + u(i, 2)*zx_alf2
-    zxv = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2
-    zxq = q(i, 1)*zx_alf1 + q(i, 2)*zx_alf2
-    zxmod = 1.0 + sqrt(zxu**2+zxv**2)
-    khfs(i) = (tsol(i)*(1.+retv*q(i,1))-zxt)*zxmod*cd_h(i)
-    kqfs(i) = (zxqs-zxq)*zxmod*cd_h(i)*beta(i)
-    heatv(i) = khfs(i) + 0.61*zxt*kqfs(i)
-    taux = zxu*zxmod*cd_m(i)
-    tauy = zxv*zxmod*cd_m(i)
-    ustar(i) = sqrt(taux**2+tauy**2)
+    zxt = (t(i, 1) + z(i, 1) * rg / rcpd / (1. + rvtmp2 * q(i, 1))) * (1. + retv * q(i, 1)) * zx_alf1 &
+            + (t(i, 2) + z(i, 2) * rg / rcpd / (1. + rvtmp2 * q(i, 2))) * (1. + retv * q(i, 2)) * zx_alf2
+    zxu = u(i, 1) * zx_alf1 + u(i, 2) * zx_alf2
+    zxv = v(i, 1) * zx_alf1 + v(i, 2) * zx_alf2
+    zxq = q(i, 1) * zx_alf1 + q(i, 2) * zx_alf2
+    zxmod = 1.0 + sqrt(zxu**2 + zxv**2)
+    khfs(i) = (tsol(i) * (1. + retv * q(i, 1)) - zxt) * zxmod * cd_h(i)
+    kqfs(i) = (zxqs - zxq) * zxmod * cd_h(i) * beta(i)
+    heatv(i) = khfs(i) + 0.61 * zxt * kqfs(i)
+    taux = zxu * zxmod * cd_m(i)
+    tauy = zxv * zxmod * cd_m(i)
+    ustar(i) = sqrt(taux**2 + tauy**2)
     ustar(i) = max(sqrt(ustar(i)), 0.01)
   END DO
@@ -178,5 +177,5 @@
     check(i) = .TRUE.
     pblh(i) = z(i, 1)
-    obklen(i) = -t(i, 1)*ustar(i)**3/(rg*vk*heatv(i))
+    obklen(i) = -t(i, 1) * ustar(i)**3 / (rg * vk * heatv(i))
   END DO
 
@@ -190,14 +189,14 @@
     DO i = 1, knon
       IF (check(i)) THEN
-        zdu2 = (u(i,k)-u(i,1))**2 + (v(i,k)-v(i,1))**2 + fac*ustar(i)**2
+        zdu2 = (u(i, k) - u(i, 1))**2 + (v(i, k) - v(i, 1))**2 + fac * ustar(i)**2
         zdu2 = max(zdu2, 1.0E-20)
-        ztvd = (t(i,k)+z(i,k)*0.5*rg/rcpd/(1.+rvtmp2*q(i, &
-          k)))*(1.+retv*q(i,k))
-        ztvu = (t(i,1)-z(i,k)*0.5*rg/rcpd/(1.+rvtmp2*q(i, &
-          1)))*(1.+retv*q(i,1))
-        rino(i, k) = (z(i,k)-z(i,1))*rg*(ztvd-ztvu)/(zdu2*0.5*(ztvd+ztvu))
-        IF (rino(i,k)>=ricr) THEN
-          pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rino(i,k-1))/(rino(i, &
-            k-1)-rino(i,k))
+        ztvd = (t(i, k) + z(i, k) * 0.5 * rg / rcpd / (1. + rvtmp2 * q(i, &
+                k))) * (1. + retv * q(i, k))
+        ztvu = (t(i, 1) - z(i, k) * 0.5 * rg / rcpd / (1. + rvtmp2 * q(i, &
+                1))) * (1. + retv * q(i, 1))
+        rino(i, k) = (z(i, k) - z(i, 1)) * rg * (ztvd - ztvu) / (zdu2 * 0.5 * (ztvd + ztvu))
+        IF (rino(i, k)>=ricr) THEN
+          pblh(i) = z(i, k - 1) + (z(i, k - 1) - z(i, k)) * (ricr - rino(i, k - 1)) / (rino(i, &
+                  k - 1) - rino(i, k))
           check(i) = .FALSE.
         END IF
@@ -232,7 +231,7 @@
   DO i = 1, knon
     IF (check(i)) THEN
-      phiminv(i) = (1.-binm*pblh(i)/obklen(i))**onet
-      wm(i) = ustar(i)*phiminv(i)
-      therm(i) = heatv(i)*fak/wm(i)
+      phiminv(i) = (1. - binm * pblh(i) / obklen(i))**onet
+      wm(i) = ustar(i) * phiminv(i)
+      therm(i) = heatv(i) * fak / wm(i)
       rino(i, 1) = 0.0
     END IF
@@ -245,14 +244,14 @@
     DO i = 1, knon
       IF (check(i)) THEN
-        zdu2 = (u(i,k)-u(i,1))**2 + (v(i,k)-v(i,1))**2 + fac*ustar(i)**2
+        zdu2 = (u(i, k) - u(i, 1))**2 + (v(i, k) - v(i, 1))**2 + fac * ustar(i)**2
         zdu2 = max(zdu2, 1.0E-20)
-        ztvd = (t(i,k)+z(i,k)*0.5*rg/rcpd/(1.+rvtmp2*q(i, &
-          k)))*(1.+retv*q(i,k))
-        ztvu = (t(i,1)+therm(i)-z(i,k)*0.5*rg/rcpd/(1.+rvtmp2*q(i, &
-          1)))*(1.+retv*q(i,1))
-        rino(i, k) = (z(i,k)-z(i,1))*rg*(ztvd-ztvu)/(zdu2*0.5*(ztvd+ztvu))
-        IF (rino(i,k)>=ricr) THEN
-          pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rino(i,k-1))/(rino(i, &
-            k-1)-rino(i,k))
+        ztvd = (t(i, k) + z(i, k) * 0.5 * rg / rcpd / (1. + rvtmp2 * q(i, &
+                k))) * (1. + retv * q(i, k))
+        ztvu = (t(i, 1) + therm(i) - z(i, k) * 0.5 * rg / rcpd / (1. + rvtmp2 * q(i, &
+                1))) * (1. + retv * q(i, 1))
+        rino(i, k) = (z(i, k) - z(i, 1)) * rg * (ztvd - ztvu) / (zdu2 * 0.5 * (ztvd + ztvu))
+        IF (rino(i, k)>=ricr) THEN
+          pblh(i) = z(i, k - 1) + (z(i, k - 1) - z(i, k)) * (ricr - rino(i, k - 1)) / (rino(i, &
+                  k - 1) - rino(i, k))
           check(i) = .FALSE.
         END IF
@@ -287,5 +286,5 @@
 
   DO i = 1, knon
-    pblmin = 700.0*ustar(i)
+    pblmin = 700.0 * ustar(i)
     pblh(i) = max(pblh(i), pblmin)
   END DO
@@ -295,5 +294,5 @@
   DO i = 1, knon
     pblk(i) = 0.0
-    fak1(i) = ustar(i)*pblh(i)*vk
+    fak1(i) = ustar(i) * pblh(i) * vk
 
     ! Do additional preparation for unstable cases only, set temperature
@@ -301,11 +300,11 @@
 
     IF (unstbl(i)) THEN
-      zxt = (t(i,1)-z(i,1)*0.5*rg/rcpd/(1.+rvtmp2*q(i,1)))*(1.+retv*q(i,1))
-      phiminv(i) = (1.-binm*pblh(i)/obklen(i))**onet
-      phihinv(i) = sqrt(1.-binh*pblh(i)/obklen(i))
-      wm(i) = ustar(i)*phiminv(i)
-      fak2(i) = wm(i)*pblh(i)*vk
-      wstr(i) = (heatv(i)*rg*pblh(i)/zxt)**onet
-      fak3(i) = fakn*wstr(i)/wm(i)
+      zxt = (t(i, 1) - z(i, 1) * 0.5 * rg / rcpd / (1. + rvtmp2 * q(i, 1))) * (1. + retv * q(i, 1))
+      phiminv(i) = (1. - binm * pblh(i) / obklen(i))**onet
+      phihinv(i) = sqrt(1. - binh * pblh(i) / obklen(i))
+      wm(i) = ustar(i) * phiminv(i)
+      fak2(i) = wm(i) * pblh(i) * vk
+      wstr(i) = (heatv(i) * rg * pblh(i) / zxt)**onet
+      fak3(i) = fakn * wstr(i) / wm(i)
     END IF
   END DO
@@ -321,13 +320,13 @@
       unslev(i) = .FALSE.
       stblev(i) = .FALSE.
-      zm(i) = z(i, k-1)
+      zm(i) = z(i, k - 1)
       zp(i) = z(i, k)
       IF (zkmin==0.0 .AND. zp(i)>pblh(i)) zp(i) = pblh(i)
       IF (zm(i)<pblh(i)) THEN
-        zmzp = 0.5*(zm(i)+zp(i))
-        zh(i) = zmzp/pblh(i)
-        zl(i) = zmzp/obklen(i)
+        zmzp = 0.5 * (zm(i) + zp(i))
+        zh(i) = zmzp / pblh(i)
+        zl(i) = zmzp / obklen(i)
         zzh(i) = 0.
-        IF (zh(i)<=1.0) zzh(i) = (1.-zh(i))**2
+        IF (zh(i)<=1.0) zzh(i) = (1. - zh(i))**2
 
         ! stblev for points zm < plbh and stable and neutral
@@ -348,7 +347,7 @@
       IF (stblev(i)) THEN
         IF (zl(i)<=1.) THEN
-          pblk(i) = fak1(i)*zh(i)*zzh(i)/(1.+betas*zl(i))
+          pblk(i) = fak1(i) * zh(i) * zzh(i) / (1. + betas * zl(i))
         ELSE
-          pblk(i) = fak1(i)*zh(i)*zzh(i)/(betas+zl(i))
+          pblk(i) = fak1(i) * zh(i) * zzh(i) / (betas + zl(i))
         END IF
         pcfm(i, k) = pblk(i)
@@ -376,7 +375,7 @@
     DO i = 1, knon
       IF (unssrf(i)) THEN
-        term = (1.-betam*zl(i))**onet
-        pblk(i) = fak1(i)*zh(i)*zzh(i)*term
-        pr(i) = term/sqrt(1.-betah*zl(i))
+        term = (1. - betam * zl(i))**onet
+        pblk(i) = fak1(i) * zh(i) * zzh(i) * term
+        pr(i) = term / sqrt(1. - betah * zl(i))
       END IF
     END DO
@@ -386,9 +385,9 @@
     DO i = 1, knon
       IF (unsout(i)) THEN
-        pblk(i) = fak2(i)*zh(i)*zzh(i)
-        cgs(i, k) = fak3(i)/(pblh(i)*wm(i))
-        cgh(i, k) = khfs(i)*cgs(i, k)
-        pr(i) = phiminv(i)/phihinv(i) + ccon*fak3(i)/fak
-        cgq(i, k) = kqfs(i)*cgs(i, k)
+        pblk(i) = fak2(i) * zh(i) * zzh(i)
+        cgs(i, k) = fak3(i) / (pblh(i) * wm(i))
+        cgh(i, k) = khfs(i) * cgs(i, k)
+        pr(i) = phiminv(i) / phihinv(i) + ccon * fak3(i) / fak
+        cgq(i, k) = kqfs(i) * cgs(i, k)
       END IF
     END DO
@@ -399,9 +398,8 @@
       IF (unslev(i)) THEN
         pcfm(i, k) = pblk(i)
-        pcfh(i, k) = pblk(i)/pr(i)
+        pcfh(i, k) = pblk(i) / pr(i)
       END IF
     END DO
   END DO ! end of level loop
 
-
 END SUBROUTINE nonlocal
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/nuage.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/nuage.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/nuage.F90	(revision 5143)
@@ -343,4 +343,7 @@
 SUBROUTINE diagcld2(paprs, pplay, t, q, diafra, dialiq)
   USE dimphy
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
   IMPLICIT NONE
 
@@ -374,8 +377,4 @@
   REAL zqs, zrhb, zcll, zdthmin(klon), zdthdp
   REAL zdelta, zcor
-
-  ! Fonctions thermodynamiques:
-  include "YOETHF.h"
-  include "FCTTRE.h"
 
   ! Initialisation:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90	(revision 5143)
@@ -118,4 +118,8 @@
 
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+  USE lmdz_libmath, ONLY: ismax, ismin
+
   IMPLICIT NONE
 
@@ -148,15 +152,4 @@
   ! implicit LOGICAL (l)
 
-  ! method.
-  ! -------
-
-  ! externals.
-  ! ----------
-  INTEGER ismin, ismax
-  EXTERNAL ismin, ismax
-
-  ! reference.
-  ! ----------
-
   ! author.
   ! -------
@@ -167,5 +160,4 @@
 
   include "YOMCST.h"
-  include "YOEGWD.h"
   ! -----------------------------------------------------------------------
 
@@ -385,8 +377,10 @@
   ! -----------------------------------------------------------------------
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! -----------------------------------------------------------------------
@@ -820,7 +814,9 @@
   ! -----------------------------------------------------------------------
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! -----------------------------------------------------------------------
@@ -942,8 +938,10 @@
   ! -----------------------------------------------------------------------
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! -----------------------------------------------------------------------
@@ -1273,8 +1271,10 @@
   USE dimphy
   USE lmdz_abort_physic, ONLY: abort_physic
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOEGWD.h"
   ! -----------------------------------------------------------------------
 
@@ -1515,4 +1515,6 @@
   USE lmdz_phys_para
   USE lmdz_grid_phy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
   ! USE parallel
 
@@ -1559,8 +1561,4 @@
   ! ------------------------------------------------------------------
   IMPLICIT NONE
-
-  ! -----------------------------------------------------------------
-  include "YOEGWD.h"
-  ! ----------------------------------------------------------------
 
   INTEGER nlon, nlev, jk
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90	(revision 5143)
@@ -4,4 +4,7 @@
 
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
   ! ======================================================================
@@ -63,5 +66,4 @@
   ! ======================================================================
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! ARGUMENTS
@@ -159,4 +161,8 @@
 
   USE dimphy
+  USE lmdz_libmath, ONLY: ismin, ismax
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
@@ -222,8 +228,4 @@
   ! -------
 
-  ! externals.
-  ! ----------
-  INTEGER ismin, ismax
-  EXTERNAL ismin, ismax
 
   ! reference.
@@ -238,5 +240,4 @@
 
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! -----------------------------------------------------------------------
@@ -529,8 +530,10 @@
   ! -----------------------------------------------------------------------
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! -----------------------------------------------------------------------
@@ -974,8 +977,10 @@
   ! -----------------------------------------------------------------------
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! -----------------------------------------------------------------------
@@ -1087,8 +1092,10 @@
 
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! -----------------------------------------------------------------------
@@ -1257,4 +1264,7 @@
 
   USE dimphy
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
   ! ======================================================================
@@ -1317,5 +1327,4 @@
 
   include "YOMCST.h"
-  include "YOEGWD.h"
 
   ! ARGUMENTS
@@ -1470,8 +1479,10 @@
   USE dimphy
   USE lmdz_abort_physic, ONLY: abort_physic
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOEGWD.h"
   ! -----------------------------------------------------------------------
 
@@ -1777,9 +1788,8 @@
   USE lmdz_geometry
   USE lmdz_abort_physic, ONLY: abort_physic
+  USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, &
+          GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
+
   IMPLICIT NONE
-
-  ! -----------------------------------------------------------------
-  include "YOEGWD.h"
-  ! ----------------------------------------------------------------
 
   ! ARGUMENTS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5143)
@@ -418,4 +418,6 @@
   USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
   USE lmdz_dimpft, ONLY: nvm_lmdz
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     IMPLICIT NONE
@@ -423,6 +425,4 @@
     INCLUDE "dimsoil.h"
     INCLUDE "YOMCST.h"
-    INCLUDE "YOETHF.h"
-    INCLUDE "FCTTRE.h"
 
     !****************************************************************************************
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5143)
@@ -356,4 +356,6 @@
     USE lmdz_conema3
     USE lmdz_dimpft, ONLY: nvm_lmdz
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     IMPLICIT NONE
@@ -1154,6 +1156,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
 
     ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5143)
@@ -52,4 +52,5 @@
     USE lmdz_writefield_phy
     USE lmdz_clesphys
+    USE lmdz_YOETHF
 
 #ifdef REPROBUS
@@ -191,5 +192,4 @@
     ! DECLARATIONS
     ! ==============
-    include "YOETHF.h"
     include "YOMCST.h"
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90	(revision 5143)
@@ -1,79 +1,77 @@
-  SUBROUTINE reevap(klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, &
-           d_t_eva,d_q_eva,d_ql_eva,d_qs_eva)
+SUBROUTINE reevap(klon, klev, iflag_ice_thermo, t_seri, q_seri, ql_seri, qs_seri, &
+        d_t_eva, d_q_eva, d_ql_eva, d_qs_eva)
 
-    ! flag to include modifications to ensure energy conservation (if flag >0)
-    USE add_phys_tend_mod, ONLY: fl_cor_ebil
-    
-    IMPLICIT NONE
-    !>======================================================================
+  ! flag to include modifications to ensure energy conservation (if flag >0)
+  USE add_phys_tend_mod, ONLY: fl_cor_ebil
+  USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
-    INTEGER klon,klev,iflag_ice_thermo
-    REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri,q_seri,ql_seri,qs_seri
-    REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_eva,d_q_eva,d_ql_eva,d_qs_eva
+  IMPLICIT NONE
+  !>======================================================================
 
-    REAL za,zb,zdelta,zlvdcp,zlsdcp
-    INTEGER i,k
+  INTEGER klon, klev, iflag_ice_thermo
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri, q_seri, ql_seri, qs_seri
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_eva, d_q_eva, d_ql_eva, d_qs_eva
 
-    !--------Stochastic Boundary Layer Triggering: ALE_BL--------
-    !---Propri\'et\'es du thermiques au LCL 
-    include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
-    !IM 100106 BEG : pouvoir sortir les ctes de la physique
+  REAL za, zb, zdelta, zlvdcp, zlsdcp
+  INTEGER i, k
 
-    ! Re-evaporer l'eau liquide nuageuse
+  !--------Stochastic Boundary Layer Triggering: ALE_BL--------
+  !---Propri\'et\'es du thermiques au LCL
+  include "YOMCST.h"
+  !IM 100106 BEG : pouvoir sortir les ctes de la physique
 
-!print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
-    DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
-       DO i = 1, klon
-        IF (fl_cor_ebil > 0) THEN
-          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
-          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
-        else
-          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
-          !jyg<
-          !  Attention : Arnaud a propose des formules completement differentes
-          !                  A verifier !!!
-          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
-        end if
-          IF (iflag_ice_thermo == 0) THEN
-             zlsdcp=zlvdcp
-          ENDIF
-          !>jyg
+  ! Re-evaporer l'eau liquide nuageuse
 
-          IF (iflag_ice_thermo==0) THEN
-             !pas necessaire a priori
+  !print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
+  DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
+    DO i = 1, klon
+      IF (fl_cor_ebil > 0) THEN
+        zlvdcp = RLVTT / RCPD / (1.0 + RVTMP2 * (q_seri(i, k) + ql_seri(i, k) + qs_seri(i, k)))
+        zlsdcp = RLSTT / RCPD / (1.0 + RVTMP2 * (q_seri(i, k) + ql_seri(i, k) + qs_seri(i, k)))
+      else
+        zlvdcp = RLVTT / RCPD / (1.0 + RVTMP2 * q_seri(i, k))
+        !jyg<
+        !  Attention : Arnaud a propose des formules completement differentes
+        !                  A verifier !!!
+        zlsdcp = RLSTT / RCPD / (1.0 + RVTMP2 * q_seri(i, k))
+      end if
+      IF (iflag_ice_thermo == 0) THEN
+        zlsdcp = zlvdcp
+      ENDIF
+      !>jyg
 
-             zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
-  zdelta = 0.
-             zb = MAX(0.0,ql_seri(i,k))
-             za = - MAX(0.0,ql_seri(i,k)) &
-                  * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-             d_t_eva(i,k) = za
-             d_q_eva(i,k) = zb
-             d_ql_eva(i,k) = -ql_seri(i,k)
-             d_qs_eva(i,k) = 0.
+      IF (iflag_ice_thermo==0) THEN
+        !pas necessaire a priori
 
-          ELSE
+        zdelta = MAX(0., SIGN(1., RTT - t_seri(i, k)))
+        zdelta = 0.
+        zb = MAX(0.0, ql_seri(i, k))
+        za = - MAX(0.0, ql_seri(i, k)) &
+                * (zlvdcp * (1. - zdelta) + zlsdcp * zdelta)
+        d_t_eva(i, k) = za
+        d_q_eva(i, k) = zb
+        d_ql_eva(i, k) = -ql_seri(i, k)
+        d_qs_eva(i, k) = 0.
 
-             !CR: on r\'e-\'evapore eau liquide et glace
+      ELSE
 
-             !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
-             !        zb = MAX(0.0,ql_seri(i,k))
-             !        za = - MAX(0.0,ql_seri(i,k)) &
-             !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-             zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
-             za = - MAX(0.0,ql_seri(i,k))*zlvdcp & 
-                  - MAX(0.0,qs_seri(i,k))*zlsdcp
-             d_t_eva(i,k) = za
-             d_q_eva(i,k) = zb
-             d_ql_eva(i,k) = -ql_seri(i,k)
-             d_qs_eva(i,k) = -qs_seri(i,k)
-          ENDIF
+        !CR: on r\'e-\'evapore eau liquide et glace
 
-       ENDDO
+        !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
+        !        zb = MAX(0.0,ql_seri(i,k))
+        !        za = - MAX(0.0,ql_seri(i,k)) &
+        !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
+        zb = MAX(0.0, ql_seri(i, k) + qs_seri(i, k))
+        za = - MAX(0.0, ql_seri(i, k)) * zlvdcp &
+                - MAX(0.0, qs_seri(i, k)) * zlsdcp
+        d_t_eva(i, k) = za
+        d_q_eva(i, k) = zb
+        d_ql_eva(i, k) = -ql_seri(i, k)
+        d_qs_eva(i, k) = -qs_seri(i, k)
+      ENDIF
+
     ENDDO
-
-
+  ENDDO
 
 END SUBROUTINE reevap
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5143)
@@ -1,7 +1,6 @@
-
 MODULE stdlevvar_mod
 
-! This module contains main procedures for calculation
-! of temperature, specific humidity and wind at a reference level
+  ! This module contains main procedures for calculation
+  ! of temperature, specific humidity and wind at a reference level
 
   USE cdrag_mod
@@ -12,747 +11,741 @@
 CONTAINS
 
-!****************************************************************************************
-
-!r original routine svn3623
-
-      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
-                           u1, v1, t1, q1, z1, &
-                           ts1, qsurf, z0m, z0h, psol, pat1, &
-                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar, s_pblh, prain, tsol)
-        USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
-
-      IMPLICIT NONE
-!-------------------------------------------------------------------------
-
-! Objet : calcul de la temperature et l'humidite relative a 2m et du 
-!         module du vent a 10m a partir des relations de Dyer-Businger et
-!         des equations de Louis.
-
-! Reference : Hess, Colman et McAvaney (1995)        
-
-! I. Musat, 01.07.2002
-
-!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
-
-!-------------------------------------------------------------------------
-
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
-! u1------input-R- vent zonal au 1er niveau du modele
-! v1------input-R- vent meridien au 1er niveau du modele
-! t1------input-R- temperature de l'air au 1er niveau du modele
-! q1------input-R- humidite relative au 1er niveau du modele
-! z1------input-R- geopotentiel au 1er niveau du modele
-! ts1-----input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! z0m, z0h---input-R- rugosite
-! psol----input-R- pression au sol
-! pat1----input-R- pression au 1er niveau du modele
-
-! t_2m---output-R- temperature de l'air a 2m
-! q_2m---output-R- humidite relative a 2m
-! u_10m--output-R- vitesse du vent a 10m
-!AM
-! t_10m--output-R- temperature de l'air a 10m
-! q_10m--output-R- humidite specifique a 10m
-! ustar--output-R- u*
-
-      INTEGER, INTENT(IN) :: klon, knon, nsrf
-      LOGICAL, INTENT(IN) :: zxli
-      REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, z1, ts1
-      REAL, DIMENSION(klon), INTENT(IN) :: qsurf
-      REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
-      REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
-
-      REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
-      REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
-      REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
-      REAL, DIMENSION(klon), INTENT(IN) :: prain
-      REAL, DIMENSION(klon), INTENT(IN) :: tsol
-!-------------------------------------------------------------------------
-      include "YOMCST.h"
-!IM PLUS
-      include "YOETHF.h"
-
-! Quelques constantes et options:
-
-! RKAR : constante de von Karman
-      REAL, PARAMETER :: RKAR=0.40
-! niter : nombre iterations calcul "corrector"
-!     INTEGER, parameter :: niter=6, ncon=niter-1
-      INTEGER, parameter :: niter=2, ncon=niter-1
-
-! Variables locales
-      INTEGER :: i, n
-      REAL :: zref
-      REAL, DIMENSION(klon) :: speed
-! tpot : temperature potentielle
-      REAL, DIMENSION(klon) :: tpot
-      REAL, DIMENSION(klon) :: zri1, cdran
-      REAL, DIMENSION(klon) :: cdram, cdrah
-! ri1 : nb. de Richardson entre la surface --> la 1ere couche
-      REAL, DIMENSION(klon) :: ri1
-      REAL, DIMENSION(klon) :: testar, qstar
-      REAL, DIMENSION(klon) :: zdte, zdq
-! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
-      DOUBLE PRECISION, DIMENSION(klon) :: lmon
-      DOUBLE PRECISION, parameter :: eps=1.0D-20
-      REAL, DIMENSION(klon) :: delu, delte, delq
-      REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
-      REAL, DIMENSION(klon) :: temp, pref
-      LOGICAL :: okri
-      REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
-!convertgence
-      REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
-      REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
-      REAL, DIMENSION(klon) :: ok_pred, ok_corr, zri_zero
-!     REAL, DIMENSION(klon) :: conv_te, conv_q
-!------------------------------------------------------------------------- 
-      DO i=1, knon
-       speed(i)=SQRT(u1(i)**2+v1(i)**2)
-       ri1(i) = 0.0
+  !****************************************************************************************
+
+  !r original routine svn3623
+
+  SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
+          u1, v1, t1, q1, z1, &
+          ts1, qsurf, z0m, z0h, psol, pat1, &
+          t_2m, q_2m, t_10m, q_10m, u_10m, ustar, s_pblh, prain, tsol)
+    USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
+    USE lmdz_YOETHF
+
+    IMPLICIT NONE
+    !-------------------------------------------------------------------------
+
+    ! Objet : calcul de la temperature et l'humidite relative a 2m et du
+    !         module du vent a 10m a partir des relations de Dyer-Businger et
+    !         des equations de Louis.
+
+    ! Reference : Hess, Colman et McAvaney (1995)
+
+    ! I. Musat, 01.07.2002
+
+    !AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
+
+    !-------------------------------------------------------------------------
+
+    ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+    ! knon----input-I- nombre de points pour un type de surface
+    ! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+    ! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+    ! u1------input-R- vent zonal au 1er niveau du modele
+    ! v1------input-R- vent meridien au 1er niveau du modele
+    ! t1------input-R- temperature de l'air au 1er niveau du modele
+    ! q1------input-R- humidite relative au 1er niveau du modele
+    ! z1------input-R- geopotentiel au 1er niveau du modele
+    ! ts1-----input-R- temperature de l'air a la surface
+    ! qsurf---input-R- humidite relative a la surface
+    ! z0m, z0h---input-R- rugosite
+    ! psol----input-R- pression au sol
+    ! pat1----input-R- pression au 1er niveau du modele
+
+    ! t_2m---output-R- temperature de l'air a 2m
+    ! q_2m---output-R- humidite relative a 2m
+    ! u_10m--output-R- vitesse du vent a 10m
+    !AM
+    ! t_10m--output-R- temperature de l'air a 10m
+    ! q_10m--output-R- humidite specifique a 10m
+    ! ustar--output-R- u*
+
+    INTEGER, INTENT(IN) :: klon, knon, nsrf
+    LOGICAL, INTENT(IN) :: zxli
+    REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, z1, ts1
+    REAL, DIMENSION(klon), INTENT(IN) :: qsurf
+    REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
+    REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
+
+    REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
+    REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
+    REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
+    REAL, DIMENSION(klon), INTENT(IN) :: prain
+    REAL, DIMENSION(klon), INTENT(IN) :: tsol
+    !-------------------------------------------------------------------------
+    include "YOMCST.h"
+
+    ! Quelques constantes et options:
+
+    ! RKAR : constante de von Karman
+    REAL, PARAMETER :: RKAR = 0.40
+    ! niter : nombre iterations calcul "corrector"
+    !     INTEGER, parameter :: niter=6, ncon=niter-1
+    INTEGER, parameter :: niter = 2, ncon = niter - 1
+
+    ! Variables locales
+    INTEGER :: i, n
+    REAL :: zref
+    REAL, DIMENSION(klon) :: speed
+    ! tpot : temperature potentielle
+    REAL, DIMENSION(klon) :: tpot
+    REAL, DIMENSION(klon) :: zri1, cdran
+    REAL, DIMENSION(klon) :: cdram, cdrah
+    ! ri1 : nb. de Richardson entre la surface --> la 1ere couche
+    REAL, DIMENSION(klon) :: ri1
+    REAL, DIMENSION(klon) :: testar, qstar
+    REAL, DIMENSION(klon) :: zdte, zdq
+    ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
+    DOUBLE PRECISION, DIMENSION(klon) :: lmon
+    DOUBLE PRECISION, parameter :: eps = 1.0D-20
+    REAL, DIMENSION(klon) :: delu, delte, delq
+    REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
+    REAL, DIMENSION(klon) :: temp, pref
+    LOGICAL :: okri
+    REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
+    !convertgence
+    REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
+    REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
+    REAL, DIMENSION(klon) :: ok_pred, ok_corr, zri_zero
+    !     REAL, DIMENSION(klon) :: conv_te, conv_q
+    !-------------------------------------------------------------------------
+    DO i = 1, knon
+      speed(i) = SQRT(u1(i)**2 + v1(i)**2)
+      ri1(i) = 0.0
+    ENDDO
+
+    okri = .FALSE.
+    !      CALL coefcdrag(klon, knon, nsrf, zxli, &
+    ! &                   speed, t1, q1, z1, psol, &
+    ! &                   ts1, qsurf, rugos, okri, ri1,  &
+    ! &                   cdram, cdrah, cdran, zri1, pref)
+    ! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
+
+    CALL cdrag(knon, nsrf, &
+            speed, t1, q1, z1, &
+            psol, s_pblh, ts1, qsurf, z0m, z0h, &
+            zri_zero, 0, &
+            cdram, cdrah, zri1, pref, prain, tsol, pat1)
+
+    ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
+    IF (ok_prescr_ust) THEN
+      DO i = 1, knon
+        print *, 'cdram avant=', cdram(i)
+        cdram(i) = ust * ust / speed(i) / speed(i)
+        print *, 'cdram ust speed apres=', cdram(i), ust, speed
       ENDDO
-
-      okri=.FALSE.
-!      CALL coefcdrag(klon, knon, nsrf, zxli, &
-! &                   speed, t1, q1, z1, psol, &
-! &                   ts1, qsurf, rugos, okri, ri1,  &         
-! &                   cdram, cdrah, cdran, zri1, pref)            
-! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
-
-      CALL cdrag(knon, nsrf, &
-                     speed, t1, q1, z1, &
-                     psol, s_pblh, ts1, qsurf, z0m, z0h, &
-                     zri_zero, 0, &
-                     cdram, cdrah, zri1, pref, prain, tsol, pat1)
-
-! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
-     IF (ok_prescr_ust) THEN
-      DO i = 1, knon
-       print *,'cdram avant=',cdram(i)
-       cdram(i) = ust*ust/speed(i)/speed(i)
-       print *,'cdram ust speed apres=',cdram(i),ust,speed
-      ENDDO
-     ENDIF
-
-!---------Star variables----------------------------------------------------
-
-      DO i = 1, knon
-        ri1(i) = zri1(i)
-        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
-        ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
-        zdte(i) = tpot(i) - ts1(i)
-        zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
-
-
-!IM BUG BUG BUG       zdte(i) = max(zdte(i),1.e-10)
-        zdte(i) = sign(max(abs(zdte(i)),1.e-10),zdte(i))
-
-        testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
-        qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
-        lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
-                  (RKAR * RG * testar(i))
-      ENDDO
-
-!----------First aproximation of variables at zref --------------------------
-      zref = 2.0
-      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
-                   ts1, qsurf, z0m, lmon, &
-                   ustar, testar, qstar, zref, &
-                   delu, delte, delq)
+    ENDIF
+
+    !---------Star variables----------------------------------------------------
+
+    DO i = 1, knon
+      ri1(i) = zri1(i)
+      tpot(i) = t1(i) * (psol(i) / pat1(i))**RKAPPA
+      ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
+      zdte(i) = tpot(i) - ts1(i)
+      zdq(i) = max(q1(i), 0.0) - max(qsurf(i), 0.0)
+
+
+      !IM BUG BUG BUG       zdte(i) = max(zdte(i),1.e-10)
+      zdte(i) = sign(max(abs(zdte(i)), 1.e-10), zdte(i))
+
+      testar(i) = (cdrah(i) * zdte(i) * speed(i)) / ustar(i)
+      qstar(i) = (cdrah(i) * zdq(i) * speed(i)) / ustar(i)
+      lmon(i) = (ustar(i) * ustar(i) * tpot(i)) / &
+              (RKAR * RG * testar(i))
+    ENDDO
+
+    !----------First aproximation of variables at zref --------------------------
+    zref = 2.0
+    CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
+            ts1, qsurf, z0m, lmon, &
+            ustar, testar, qstar, zref, &
+            delu, delte, delq)
+
+    DO i = 1, knon
+      u_zref(i) = delu(i)
+      q_zref(i) = max(qsurf(i), 0.0) + delq(i)
+      te_zref(i) = ts1(i) + delte(i)
+      temp(i) = te_zref(i) * (psol(i) / pat1(i))**(-RKAPPA)
+      q_zref_p(i) = q_zref(i)
+      !       te_zref_p(i) = te_zref(i)
+      temp_p(i) = temp(i)
+    ENDDO
+
+    ! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
+
+    DO n = 1, niter
+
+      okri = .TRUE.
+      CALL screenc(klon, knon, nsrf, zxli, &
+              u_zref, temp, q_zref, zref, &
+              ts1, qsurf, z0m, z0h, psol, &
+              ustar, testar, qstar, okri, ri1, &
+              pref, delu, delte, delq, s_pblh, prain, tsol, pat1)
 
       DO i = 1, knon
         u_zref(i) = delu(i)
-        q_zref(i) = max(qsurf(i),0.0) + delq(i)
-        te_zref(i) = ts1(i) + delte(i)
-        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
-        q_zref_p(i) = q_zref(i)
-!       te_zref_p(i) = te_zref(i)
-        temp_p(i) = temp(i)
-      ENDDO
-
-! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
-
-      DO n = 1, niter
-
-        okri=.TRUE.
-        CALL screenc(klon, knon, nsrf, zxli, &
-                     u_zref, temp, q_zref, zref, &
-                     ts1, qsurf, z0m, z0h, psol, &
-                     ustar, testar, qstar, okri, ri1, &
-                     pref, delu, delte, delq, s_pblh ,prain, tsol, pat1)
-
-        DO i = 1, knon
-          u_zref(i) = delu(i)
-          q_zref(i) = delq(i) + max(qsurf(i),0.0)
-          te_zref(i) = delte(i) + ts1(i) 
-
-! return to normal temperature
-
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                 (1 + RVTMP2 * max(q_zref(i),0.0))
-
-!IM +++
-!         IF(temp(i).GT.350.) THEN
-!           WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
-!         ENDIF
-!IM ---
+        q_zref(i) = delq(i) + max(qsurf(i), 0.0)
+        te_zref(i) = delte(i) + ts1(i)
+
+        ! return to normal temperature
+
+        temp(i) = te_zref(i) * (psol(i) / pref(i))**(-RKAPPA)
+        !         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+        !                 (1 + RVTMP2 * max(q_zref(i),0.0))
+
+        !IM +++
+        !         IF(temp(i).GT.350.) THEN
+        !           WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
+        !         ENDIF
+        !IM ---
 
         IF(n==ncon) THEN
           te_zref_con(i) = te_zref(i)
           q_zref_con(i) = q_zref(i)
-        ENDIF 
-
-        ENDDO 
-
-      ENDDO 
-
-! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
-
-!       DO i = 1, knon
-!         conv_te(i) = (te_zref(i) - te_zref_con(i))/te_zref_con(i)
-!         conv_q(i) = (q_zref(i) - q_zref_con(i))/q_zref_con(i)
-!IM +++
-!         IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
-!           PRINT*,'DIV','i=',i,te_zref_con(i),te_zref(i),conv_te(i), &
-!           q_zref_con(i),q_zref(i),conv_q(i)
-!         ENDIF
-!IM ---
-!       ENDDO
-
-      DO i = 1, knon
-        q_zref_c(i) = q_zref(i)
-        temp_c(i) = temp(i)
-
-!       IF(zri1(i).LT.0.) THEN
-!         IF(nsrf.EQ.1) THEN
-!           ok_pred(i)=1.
-!           ok_corr(i)=0.
-!         ELSE
-!           ok_pred(i)=0.
-!           ok_corr(i)=1.
-!         ENDIF
-!       ELSE
-!         ok_pred(i)=0.
-!         ok_corr(i)=1.
-!       ENDIF
-
-        ok_pred(i)=0.
-        ok_corr(i)=1.
-
-        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
-        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
-!IM +++
-!       IF(n.EQ.niter) THEN
-!       IF(t_2m(i).LT.t1(i).AND.t_2m(i).LT.ts1(i)) THEN
-!         PRINT*,' BAD t2m LT ',i,nsrf,t_2m(i),t1(i),ts1(i) 
-!       ELSEIF(t_2m(i).GT.t1(i).AND.t_2m(i).GT.ts1(i)) THEN
-!         PRINT*,' BAD t2m GT ',i,nsrf,t_2m(i),t1(i),ts1(i) 
-!       ENDIF
-!       ENDIF
-!IM ---
+        ENDIF
+
       ENDDO
 
-
-!----------First aproximation of variables at zref --------------------------
-
-      zref = 10.0
-      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
-                   ts1, qsurf, z0m, lmon, &
-                   ustar, testar, qstar, zref, &
-                   delu, delte, delq)
+    ENDDO
+
+    ! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
+
+    !       DO i = 1, knon
+    !         conv_te(i) = (te_zref(i) - te_zref_con(i))/te_zref_con(i)
+    !         conv_q(i) = (q_zref(i) - q_zref_con(i))/q_zref_con(i)
+    !IM +++
+    !         IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
+    !           PRINT*,'DIV','i=',i,te_zref_con(i),te_zref(i),conv_te(i), &
+    !           q_zref_con(i),q_zref(i),conv_q(i)
+    !         ENDIF
+    !IM ---
+    !       ENDDO
+
+    DO i = 1, knon
+      q_zref_c(i) = q_zref(i)
+      temp_c(i) = temp(i)
+
+      !       IF(zri1(i).LT.0.) THEN
+      !         IF(nsrf.EQ.1) THEN
+      !           ok_pred(i)=1.
+      !           ok_corr(i)=0.
+      !         ELSE
+      !           ok_pred(i)=0.
+      !           ok_corr(i)=1.
+      !         ENDIF
+      !       ELSE
+      !         ok_pred(i)=0.
+      !         ok_corr(i)=1.
+      !       ENDIF
+
+      ok_pred(i) = 0.
+      ok_corr(i) = 1.
+
+      t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+      q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+      !IM +++
+      !       IF(n.EQ.niter) THEN
+      !       IF(t_2m(i).LT.t1(i).AND.t_2m(i).LT.ts1(i)) THEN
+      !         PRINT*,' BAD t2m LT ',i,nsrf,t_2m(i),t1(i),ts1(i)
+      !       ELSEIF(t_2m(i).GT.t1(i).AND.t_2m(i).GT.ts1(i)) THEN
+      !         PRINT*,' BAD t2m GT ',i,nsrf,t_2m(i),t1(i),ts1(i)
+      !       ENDIF
+      !       ENDIF
+      !IM ---
+    ENDDO
+
+
+    !----------First aproximation of variables at zref --------------------------
+
+    zref = 10.0
+    CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
+            ts1, qsurf, z0m, lmon, &
+            ustar, testar, qstar, zref, &
+            delu, delte, delq)
+
+    DO i = 1, knon
+      u_zref(i) = delu(i)
+      q_zref(i) = max(qsurf(i), 0.0) + delq(i)
+      te_zref(i) = ts1(i) + delte(i)
+      temp(i) = te_zref(i) * (psol(i) / pat1(i))**(-RKAPPA)
+      !       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+      !                 (1 + RVTMP2 * max(q_zref(i),0.0))
+      u_zref_p(i) = u_zref(i)
+    ENDDO
+
+    ! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995
+
+    DO n = 1, niter
+
+      okri = .TRUE.
+      CALL screenc(klon, knon, nsrf, zxli, &
+              u_zref, temp, q_zref, zref, &
+              ts1, qsurf, z0m, z0h, psol, &
+              ustar, testar, qstar, okri, ri1, &
+              pref, delu, delte, delq, s_pblh, prain, tsol, pat1)
 
       DO i = 1, knon
         u_zref(i) = delu(i)
-        q_zref(i) = max(qsurf(i),0.0) + delq(i)
-        te_zref(i) = ts1(i) + delte(i)
-        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
-!       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                 (1 + RVTMP2 * max(q_zref(i),0.0))
+        q_zref(i) = delq(i) + max(qsurf(i), 0.0)
+        te_zref(i) = delte(i) + ts1(i)
+        temp(i) = te_zref(i) * (psol(i) / pref(i))**(-RKAPPA)
+        !         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+        !                   (1 + RVTMP2 * max(q_zref(i),0.0))
+      ENDDO
+
+    ENDDO
+
+    DO i = 1, knon
+      u_zref_c(i) = u_zref(i)
+
+      u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
+
+      !AM
+      q_zref_c(i) = q_zref(i)
+      temp_c(i) = temp(i)
+      t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+      q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+      !MA
+    ENDDO
+
+  END SUBROUTINE stdlevvar
+
+  SUBROUTINE stdlevvarn(klon, knon, nsrf, zxli, &
+          u1, v1, t1, q1, z1, &
+          ts1, qsurf, z0m, z0h, psol, pat1, &
+          t_2m, q_2m, t_10m, q_10m, u_10m, ustar, &
+          n2mout)
+
+    USE lmdz_ioipsl_getin_p, ONLY: getin_p
+    USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
+    USE lmdz_YOETHF
+
+    IMPLICIT NONE
+    !-------------------------------------------------------------------------
+
+    ! Objet : calcul de la temperature et l'humidite relative a 2m et du
+    !         module du vent a 10m a partir des relations de Dyer-Businger et
+    !         des equations de Louis.
+
+    ! Reference : Hess, Colman et McAvaney (1995)
+
+    ! I. Musat, 01.07.2002
+
+    !AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
+
+    !-------------------------------------------------------------------------
+
+    ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+    ! knon----input-I- nombre de points pour un type de surface
+    ! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+    ! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+    ! u1------input-R- vent zonal au 1er niveau du modele
+    ! v1------input-R- vent meridien au 1er niveau du modele
+    ! t1------input-R- temperature de l'air au 1er niveau du modele
+    ! q1------input-R- humidite relative au 1er niveau du modele
+    ! z1------input-R- geopotentiel au 1er niveau du modele
+    ! ts1-----input-R- temperature de l'air a la surface
+    ! qsurf---input-R- humidite relative a la surface
+    ! z0m, z0h---input-R- rugosite
+    ! psol----input-R- pression au sol
+    ! pat1----input-R- pression au 1er niveau du modele
+
+    ! t_2m---output-R- temperature de l'air a 2m
+    ! q_2m---output-R- humidite relative a 2m
+    ! u_2m--output-R- vitesse du vent a 2m
+    ! u_10m--output-R- vitesse du vent a 10m
+    ! ustar--output-R- u*
+    !AM
+    ! t_10m--output-R- temperature de l'air a 10m
+    ! q_10m--output-R- humidite specifique a 10m
+
+    INTEGER, INTENT(IN) :: klon, knon, nsrf
+    LOGICAL, INTENT(IN) :: zxli
+    REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, ts1, z1
+    REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
+    REAL, DIMENSION(klon), INTENT(IN) :: qsurf
+    REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
+
+    REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
+    REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
+    INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: n2mout
+
+    REAL, DIMENSION(klon) :: u_2m
+    REAL, DIMENSION(klon) :: cdrm2m, cdrh2m, ri2m
+    REAL, DIMENSION(klon) :: cdram, cdrah, zri1
+    REAL, DIMENSION(klon) :: cdmn1, cdhn1, fm1, fh1
+    REAL, DIMENSION(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
+    REAL, DIMENSION(klon) :: ri2m_new
+    REAL, DIMENSION(klon) :: s_pblh
+    REAL, DIMENSION(klon) :: prain
+    REAL, DIMENSION(klon) :: tsol
+    !-------------------------------------------------------------------------
+    include "YOMCST.h"
+
+    ! Quelques constantes et options:
+
+    ! RKAR : constante de von Karman
+    REAL, PARAMETER :: RKAR = 0.40
+    ! niter : nombre iterations calcul "corrector"
+    !     INTEGER, parameter :: niter=6, ncon=niter-1
+    !IM 071020     INTEGER, parameter :: niter=2, ncon=niter-1
+    INTEGER, parameter :: niter = 2, ncon = niter
+    !     INTEGER, parameter :: niter=6, ncon=niter
+
+    ! Variables locales
+    INTEGER :: i, n
+    REAL :: zref
+    REAL, DIMENSION(klon) :: speed
+    ! tpot : temperature potentielle
+    REAL, DIMENSION(klon) :: tpot
+    REAL, DIMENSION(klon) :: cdran
+    ! ri1 : nb. de Richardson entre la surface --> la 1ere couche
+    REAL, DIMENSION(klon) :: ri1
+    DOUBLE PRECISION, parameter :: eps = 1.0D-20
+    REAL, DIMENSION(klon) :: delu, delte, delq
+    REAL, DIMENSION(klon) :: delh, delm
+    REAL, DIMENSION(klon) :: delh_new, delm_new
+    REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
+    REAL, DIMENSION(klon) :: u_zref_pnew, te_zref_pnew, q_zref_pnew
+    REAL, DIMENSION(klon) :: temp, pref
+    REAL, DIMENSION(klon) :: temp_new, pref_new
+    LOGICAL :: okri
+    REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
+    REAL, DIMENSION(klon) :: u_zref_p_new, te_zref_p_new, temp_p_new, q_zref_p_new
+    !convergence
+    REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
+    REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
+    REAL, DIMENSION(klon) :: ok_pred, ok_corr
+
+    REAL, DIMENSION(klon) :: cdrm10m, cdrh10m, ri10m
+    REAL, DIMENSION(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
+    REAL, DIMENSION(klon) :: cdn2m, cdn1, zri_zero
+    REAL :: CEPDUE, zdu2
+    INTEGER :: nzref, nz1
+    LOGICAL, DIMENSION(klon) :: ok_t2m_toosmall, ok_t2m_toobig
+    LOGICAL, DIMENSION(klon) :: ok_q2m_toosmall, ok_q2m_toobig
+    LOGICAL, DIMENSION(klon) :: ok_u2m_toobig
+    LOGICAL, DIMENSION(klon) :: ok_t10m_toosmall, ok_t10m_toobig
+    LOGICAL, DIMENSION(klon) :: ok_q10m_toosmall, ok_q10m_toobig
+    LOGICAL, DIMENSION(klon) :: ok_u10m_toobig
+    INTEGER, DIMENSION(klon, 6) :: n10mout
+
+    !-------------------------------------------------------------------------
+    CEPDUE = 0.1
+
+    ! n2mout : compteur des pas de temps ou t2m,q2m ou u2m sont en dehors des intervalles
+    !          [tsurf, temp], [qsurf, q1] ou [0, speed]
+    ! n10mout : compteur des pas de temps ou t10m,q10m ou u10m sont en dehors des intervalles
+    !          [tsurf, temp], [qsurf, q1] ou [0, speed]
+
+    n2mout(:, :) = 0
+    n10mout(:, :) = 0
+
+    DO i = 1, knon
+      speed(i) = MAX(SQRT(u1(i)**2 + v1(i)**2), CEPDUE)
+      ri1(i) = 0.0
+    ENDDO
+
+    okri = .FALSE.
+    CALL cdrag(knon, nsrf, &
+            speed, t1, q1, z1, &
+            psol, s_pblh, ts1, qsurf, z0m, z0h, &
+            zri_zero, 0, &
+            cdram, cdrah, zri1, pref, prain, tsol, pat1)
+
+    DO i = 1, knon
+      ri1(i) = zri1(i)
+      tpot(i) = t1(i) * (psol(i) / pat1(i))**RKAPPA
+      zdu2 = MAX(CEPDUE * CEPDUE, speed(i)**2)
+      ustar(i) = sqrt(cdram(i) * zdu2)
+
+    ENDDO
+
+    !----------First aproximation of variables at zref --------------------------
+    zref = 2.0
+
+    ! calcul first-guess en utilisant dans les calculs à 2m
+    ! le Richardson de la premiere couche atmospherique
+
+    CALL screencn(klon, knon, nsrf, zxli, &
+            speed, tpot, q1, zref, &
+            ts1, qsurf, z0m, z0h, psol, &
+            cdram, cdrah, okri, &
+            ri1, 1, &
+            pref_new, delm_new, delh_new, ri2m, &
+            s_pblh, prain, tsol, pat1)
+
+    DO i = 1, knon
+      u_zref(i) = delm_new(i) * speed(i)
+      u_zref_p(i) = u_zref(i)
+      q_zref(i) = delh_new(i) * max(q1(i), 0.0) + &
+              max(qsurf(i), 0.0) * (1 - delh_new(i))
+      q_zref_p(i) = q_zref(i)
+      te_zref(i) = delh_new(i) * tpot(i) + ts1(i) * (1 - delh_new(i))
+      te_zref_p(i) = te_zref(i)
+
+      ! return to normal temperature
+      temp(i) = te_zref(i) * (psol(i) / pref_new(i))**(-RKAPPA)
+      temp_p(i) = temp(i)
+
+      ! compteurs ici
+
+      ok_t2m_toosmall(i) = te_zref(i)<tpot(i).AND. &
+              te_zref(i)<ts1(i)
+      ok_t2m_toobig(i) = te_zref(i)>tpot(i).AND. &
+              te_zref(i)>ts1(i)
+      ok_q2m_toosmall(i) = q_zref(i)<q1(i).AND. &
+              q_zref(i)<qsurf(i)
+      ok_q2m_toobig(i) = q_zref(i)>q1(i).AND. &
+              q_zref(i)>qsurf(i)
+      ok_u2m_toobig(i) = u_zref(i)>speed(i)
+
+      IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
+        n2mout(i, 1) = n2mout(i, 1) + 1
+      ENDIF
+      IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
+        n2mout(i, 3) = n2mout(i, 3) + 1
+      ENDIF
+      IF(ok_u2m_toobig(i)) THEN
+        n2mout(i, 5) = n2mout(i, 5) + 1
+      ENDIF
+
+      IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
+              ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
+              ok_u2m_toobig(i)) THEN
+        delm_new(i) = min(max(delm_new(i), 0.), 1.)
+        delh_new(i) = min(max(delh_new(i), 0.), 1.)
+        u_zref(i) = delm_new(i) * speed(i)
         u_zref_p(i) = u_zref(i)
+        q_zref(i) = delh_new(i) * max(q1(i), 0.0) + &
+                max(qsurf(i), 0.0) * (1 - delh_new(i))
+        q_zref_p(i) = q_zref(i)
+        te_zref(i) = delh_new(i) * tpot(i) + ts1(i) * (1 - delh_new(i))
+        te_zref_p(i) = te_zref(i)
+
+        ! return to normal temperature
+        temp(i) = te_zref(i) * (psol(i) / pref_new(i))**(-RKAPPA)
+        temp_p(i) = temp(i)
+      ENDIF
+
+    ENDDO
+
+    ! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
+
+    DO n = 1, niter
+
+      okri = .TRUE.
+      CALL screencn(klon, knon, nsrf, zxli, &
+              u_zref, temp, q_zref, zref, &
+              ts1, qsurf, z0m, z0h, psol, &
+              cdram, cdrah, okri, &
+              ri1, 0, &
+              pref, delm, delh, ri2m, &
+              s_pblh, prain, tsol, pat1)
+
+      DO i = 1, knon
+        u_zref(i) = delm(i) * speed(i)
+        q_zref(i) = delh(i) * max(q1(i), 0.0) + &
+                max(qsurf(i), 0.0) * (1 - delh(i))
+        te_zref(i) = delh(i) * tpot(i) + ts1(i) * (1 - delh(i))
+
+        ! return to normal temperature
+        temp(i) = te_zref(i) * (psol(i) / pref(i))**(-RKAPPA)
+
+        ! compteurs ici
+
+        ok_t2m_toosmall(i) = te_zref(i)<tpot(i).AND. &
+                te_zref(i)<ts1(i)
+        ok_t2m_toobig(i) = te_zref(i)>tpot(i).AND. &
+                te_zref(i)>ts1(i)
+        ok_q2m_toosmall(i) = q_zref(i)<q1(i).AND. &
+                q_zref(i)<qsurf(i)
+        ok_q2m_toobig(i) = q_zref(i)>q1(i).AND. &
+                q_zref(i)>qsurf(i)
+        ok_u2m_toobig(i) = u_zref(i)>speed(i)
+
+        IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
+          n2mout(i, 2) = n2mout(i, 2) + 1
+        ENDIF
+        IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
+          n2mout(i, 4) = n2mout(i, 4) + 1
+        ENDIF
+        IF(ok_u2m_toobig(i)) THEN
+          n2mout(i, 6) = n2mout(i, 6) + 1
+        ENDIF
+
+        IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
+                ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
+                ok_u2m_toobig(i)) THEN
+          delm(i) = min(max(delm(i), 0.), 1.)
+          delh(i) = min(max(delh(i), 0.), 1.)
+          u_zref(i) = delm(i) * speed(i)
+          q_zref(i) = delh(i) * max(q1(i), 0.0) + &
+                  max(qsurf(i), 0.0) * (1 - delh(i))
+          te_zref(i) = delh(i) * tpot(i) + ts1(i) * (1 - delh(i))
+          temp(i) = te_zref(i) * (psol(i) / pref(i))**(-RKAPPA)
+        ENDIF
+
+        IF(n==ncon) THEN
+          te_zref_con(i) = te_zref(i)
+          q_zref_con(i) = q_zref(i)
+        ENDIF
+
       ENDDO
 
-! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995 
-
-      DO n = 1, niter
-
-        okri=.TRUE.
-        CALL screenc(klon, knon, nsrf, zxli, &
-                     u_zref, temp, q_zref, zref, &
-                     ts1, qsurf, z0m, z0h, psol, &
-                     ustar, testar, qstar, okri, ri1, &
-                     pref, delu, delte, delq, s_pblh ,prain, tsol, pat1)
-
-        DO i = 1, knon
-          u_zref(i) = delu(i)
-          q_zref(i) = delq(i) + max(qsurf(i),0.0)
-          te_zref(i) = delte(i) + ts1(i)
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                   (1 + RVTMP2 * max(q_zref(i),0.0))
-        ENDDO 
+    ENDDO
+
+    DO i = 1, knon
+      q_zref_c(i) = q_zref(i)
+      temp_c(i) = temp(i)
+
+      ok_pred(i) = 0.
+      ok_corr(i) = 1.
+
+      t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+      q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+
+      u_zref_c(i) = u_zref(i)
+      u_2m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
+    ENDDO
+
+
+    !----------First aproximation of variables at zref --------------------------
+
+    zref = 10.0
+
+    CALL screencn(klon, knon, nsrf, zxli, &
+            speed, tpot, q1, zref, &
+            ts1, qsurf, z0m, z0h, psol, &
+            cdram, cdrah, okri, &
+            ri1, 1, &
+            pref_new, delm_new, delh_new, ri10m, &
+            s_pblh, prain, tsol, pat1)
+
+    DO i = 1, knon
+      u_zref(i) = delm_new(i) * speed(i)
+      q_zref(i) = delh_new(i) * max(q1(i), 0.0) + &
+              max(qsurf(i), 0.0) * (1 - delh_new(i))
+      te_zref(i) = delh_new(i) * tpot(i) + ts1(i) * (1 - delh_new(i))
+      temp(i) = te_zref(i) * (psol(i) / pref_new(i))**(-RKAPPA)
+      u_zref_p(i) = u_zref(i)
+
+      ! compteurs ici
+
+      ok_t10m_toosmall(i) = te_zref(i)<tpot(i).AND. &
+              te_zref(i)<ts1(i)
+      ok_t10m_toobig(i) = te_zref(i)>tpot(i).AND. &
+              te_zref(i)>ts1(i)
+      ok_q10m_toosmall(i) = q_zref(i)<q1(i).AND. &
+              q_zref(i)<qsurf(i)
+      ok_q10m_toobig(i) = q_zref(i)>q1(i).AND. &
+              q_zref(i)>qsurf(i)
+      ok_u10m_toobig(i) = u_zref(i)>speed(i)
+
+      IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
+        n10mout(i, 1) = n10mout(i, 1) + 1
+      ENDIF
+      IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
+        n10mout(i, 3) = n10mout(i, 3) + 1
+      ENDIF
+      IF(ok_u10m_toobig(i)) THEN
+        n10mout(i, 5) = n10mout(i, 5) + 1
+      ENDIF
+
+      IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
+              ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
+              ok_u10m_toobig(i)) THEN
+        delm_new(i) = min(max(delm_new(i), 0.), 1.)
+        delh_new(i) = min(max(delh_new(i), 0.), 1.)
+        u_zref(i) = delm_new(i) * speed(i)
+        u_zref_p(i) = u_zref(i)
+        q_zref(i) = delh_new(i) * max(q1(i), 0.0) + &
+                max(qsurf(i), 0.0) * (1 - delh_new(i))
+        te_zref(i) = delh_new(i) * tpot(i) + ts1(i) * (1 - delh_new(i))
+        temp(i) = te_zref(i) * (psol(i) / pref_new(i))**(-RKAPPA)
+      ENDIF
+
+    ENDDO
+
+    ! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
+
+    DO n = 1, niter
+
+      okri = .TRUE.
+      CALL screencn(klon, knon, nsrf, zxli, &
+              u_zref, temp, q_zref, zref, &
+              ts1, qsurf, z0m, z0h, psol, &
+              cdram, cdrah, okri, &
+              ri1, 0, &
+              pref, delm, delh, ri10m, &
+              s_pblh, prain, tsol, pat1)
+
+      DO i = 1, knon
+        u_zref(i) = delm(i) * speed(i)
+        q_zref(i) = delh(i) * max(q1(i), 0.0) + &
+                max(qsurf(i), 0.0) * (1 - delh(i))
+        te_zref(i) = delh(i) * tpot(i) + ts1(i) * (1 - delh(i))
+
+        ! return to normal temperature
+        temp(i) = te_zref(i) * (psol(i) / pref(i))**(-RKAPPA)
+
+        ! compteurs ici
+
+        ok_t10m_toosmall(i) = te_zref(i)<tpot(i).AND. &
+                te_zref(i)<ts1(i)
+        ok_t10m_toobig(i) = te_zref(i)>tpot(i).AND. &
+                te_zref(i)>ts1(i)
+        ok_q10m_toosmall(i) = q_zref(i)<q1(i).AND. &
+                q_zref(i)<qsurf(i)
+        ok_q10m_toobig(i) = q_zref(i)>q1(i).AND. &
+                q_zref(i)>qsurf(i)
+        ok_u10m_toobig(i) = u_zref(i)>speed(i)
+
+        IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
+          n10mout(i, 2) = n10mout(i, 2) + 1
+        ENDIF
+        IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
+          n10mout(i, 4) = n10mout(i, 4) + 1
+        ENDIF
+        IF(ok_u10m_toobig(i)) THEN
+          n10mout(i, 6) = n10mout(i, 6) + 1
+        ENDIF
+
+        IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
+                ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
+                ok_u10m_toobig(i)) THEN
+          delm(i) = min(max(delm(i), 0.), 1.)
+          delh(i) = min(max(delh(i), 0.), 1.)
+          u_zref(i) = delm(i) * speed(i)
+          q_zref(i) = delh(i) * max(q1(i), 0.0) + &
+                  max(qsurf(i), 0.0) * (1 - delh(i))
+          te_zref(i) = delh(i) * tpot(i) + ts1(i) * (1 - delh(i))
+          temp(i) = te_zref(i) * (psol(i) / pref(i))**(-RKAPPA)
+        ENDIF
+
+        IF(n==ncon) THEN
+          te_zref_con(i) = te_zref(i)
+          q_zref_con(i) = q_zref(i)
+        ENDIF
 
       ENDDO
 
-      DO i = 1, knon
-        u_zref_c(i) = u_zref(i)
-
-        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
-
-!AM
-        q_zref_c(i) = q_zref(i)
-        temp_c(i) = temp(i)
-        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
-        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
-!MA
-      ENDDO
-
-
-      END SUBROUTINE stdlevvar
-
-      SUBROUTINE stdlevvarn(klon, knon, nsrf, zxli, &
-                           u1, v1, t1, q1, z1, &
-                           ts1, qsurf, z0m, z0h, psol, pat1, &
-                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar, &
-                           n2mout)
-
-      USE lmdz_ioipsl_getin_p, ONLY: getin_p
-      USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
-
-      IMPLICIT NONE
-!-------------------------------------------------------------------------
-
-! Objet : calcul de la temperature et l'humidite relative a 2m et du 
-!         module du vent a 10m a partir des relations de Dyer-Businger et
-!         des equations de Louis.
-
-! Reference : Hess, Colman et McAvaney (1995)        
-
-! I. Musat, 01.07.2002
-
-!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
-
-!-------------------------------------------------------------------------
-
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
-! u1------input-R- vent zonal au 1er niveau du modele
-! v1------input-R- vent meridien au 1er niveau du modele
-! t1------input-R- temperature de l'air au 1er niveau du modele
-! q1------input-R- humidite relative au 1er niveau du modele
-! z1------input-R- geopotentiel au 1er niveau du modele
-! ts1-----input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! z0m, z0h---input-R- rugosite
-! psol----input-R- pression au sol
-! pat1----input-R- pression au 1er niveau du modele
-
-! t_2m---output-R- temperature de l'air a 2m
-! q_2m---output-R- humidite relative a 2m
-! u_2m--output-R- vitesse du vent a 2m
-! u_10m--output-R- vitesse du vent a 10m
-! ustar--output-R- u*
-!AM
-! t_10m--output-R- temperature de l'air a 10m
-! q_10m--output-R- humidite specifique a 10m
-
-      INTEGER, INTENT(IN) :: klon, knon, nsrf
-      LOGICAL, INTENT(IN) :: zxli
-      REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, ts1, z1
-      REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
-      REAL, DIMENSION(klon), INTENT(IN) :: qsurf
-      REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
-
-      REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
-      REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
-      INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: n2mout
-
-      REAL, DIMENSION(klon) :: u_2m
-      REAL, DIMENSION(klon) :: cdrm2m, cdrh2m, ri2m
-      REAL, DIMENSION(klon) :: cdram, cdrah, zri1
-      REAL, DIMENSION(klon) :: cdmn1, cdhn1, fm1, fh1
-      REAL, DIMENSION(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
-      REAL, DIMENSION(klon) :: ri2m_new
-      REAL, DIMENSION(klon) :: s_pblh
-      REAL, DIMENSION(klon) :: prain
-      REAL, DIMENSION(klon) :: tsol
-!-------------------------------------------------------------------------
-      include "YOMCST.h"
-!IM PLUS
-      include "YOETHF.h"
-
-! Quelques constantes et options:
-
-! RKAR : constante de von Karman
-      REAL, PARAMETER :: RKAR=0.40
-! niter : nombre iterations calcul "corrector"
-!     INTEGER, parameter :: niter=6, ncon=niter-1
-!IM 071020     INTEGER, parameter :: niter=2, ncon=niter-1
-      INTEGER, parameter :: niter=2, ncon=niter
-!     INTEGER, parameter :: niter=6, ncon=niter
-
-! Variables locales
-      INTEGER :: i, n
-      REAL :: zref
-      REAL, DIMENSION(klon) :: speed
-! tpot : temperature potentielle
-      REAL, DIMENSION(klon) :: tpot
-      REAL, DIMENSION(klon) :: cdran
-! ri1 : nb. de Richardson entre la surface --> la 1ere couche
-      REAL, DIMENSION(klon) :: ri1
-      DOUBLE PRECISION, parameter :: eps=1.0D-20
-      REAL, DIMENSION(klon) :: delu, delte, delq
-      REAL, DIMENSION(klon) :: delh, delm
-      REAL, DIMENSION(klon) :: delh_new, delm_new
-      REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
-      REAL, DIMENSION(klon) :: u_zref_pnew, te_zref_pnew, q_zref_pnew
-      REAL, DIMENSION(klon) :: temp, pref
-      REAL, DIMENSION(klon) :: temp_new, pref_new
-      LOGICAL :: okri
-      REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
-      REAL, DIMENSION(klon) :: u_zref_p_new, te_zref_p_new, temp_p_new, q_zref_p_new
-!convergence
-      REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
-      REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
-      REAL, DIMENSION(klon) :: ok_pred, ok_corr
-
-      REAL, DIMENSION(klon) :: cdrm10m, cdrh10m, ri10m
-      REAL, DIMENSION(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
-      REAL, DIMENSION(klon) :: cdn2m, cdn1, zri_zero
-      REAL :: CEPDUE,zdu2 
-      INTEGER :: nzref, nz1
-      LOGICAL, DIMENSION(klon) :: ok_t2m_toosmall, ok_t2m_toobig
-      LOGICAL, DIMENSION(klon) :: ok_q2m_toosmall, ok_q2m_toobig
-      LOGICAL, DIMENSION(klon) :: ok_u2m_toobig
-      LOGICAL, DIMENSION(klon) :: ok_t10m_toosmall, ok_t10m_toobig
-      LOGICAL, DIMENSION(klon) :: ok_q10m_toosmall, ok_q10m_toobig
-      LOGICAL, DIMENSION(klon) :: ok_u10m_toobig
-      INTEGER, DIMENSION(klon, 6) :: n10mout
-
-!------------------------------------------------------------------------- 
-      CEPDUE=0.1
-
-! n2mout : compteur des pas de temps ou t2m,q2m ou u2m sont en dehors des intervalles
-!          [tsurf, temp], [qsurf, q1] ou [0, speed]
-! n10mout : compteur des pas de temps ou t10m,q10m ou u10m sont en dehors des intervalles
-!          [tsurf, temp], [qsurf, q1] ou [0, speed]
-
-      n2mout(:,:)=0
-      n10mout(:,:)=0
-      
-      DO i=1, knon
-       speed(i)=MAX(SQRT(u1(i)**2+v1(i)**2),CEPDUE)
-       ri1(i) = 0.0
-      ENDDO
-
-      okri=.FALSE.
-      CALL cdrag(knon, nsrf, &
-                     speed, t1, q1, z1, &
-                     psol, s_pblh, ts1, qsurf, z0m, z0h, &
-                     zri_zero, 0, &
-                     cdram, cdrah, zri1, pref, prain, tsol, pat1)
-
-      DO i = 1, knon
-        ri1(i) = zri1(i)
-        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
-        zdu2 = MAX(CEPDUE*CEPDUE, speed(i)**2)
-        ustar(i) = sqrt(cdram(i) * zdu2)
-
-      ENDDO
-
-!----------First aproximation of variables at zref --------------------------
-      zref = 2.0
-
-! calcul first-guess en utilisant dans les calculs à 2m
-! le Richardson de la premiere couche atmospherique 
-
-       CALL screencn(klon, knon, nsrf, zxli, &
-                     speed, tpot, q1, zref, &
-                     ts1, qsurf, z0m, z0h, psol, &
-                     cdram, cdrah,  okri, &
-                     ri1, 1, &
-                     pref_new, delm_new, delh_new, ri2m, &
-                     s_pblh, prain, tsol, pat1      )
-
-       DO i = 1, knon
-         u_zref(i) = delm_new(i)*speed(i)
-         u_zref_p(i) = u_zref(i)
-         q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
-             max(qsurf(i),0.0)*(1-delh_new(i))
-         q_zref_p(i) = q_zref(i)
-         te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
-         te_zref_p(i) = te_zref(i)
-
-! return to normal temperature
-         temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
-         temp_p(i) = temp(i)
-
-! compteurs ici
-
-         ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
-   te_zref(i)<ts1(i)
-         ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
-   te_zref(i)>ts1(i)
-         ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
-   q_zref(i)<qsurf(i)
-         ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
-   q_zref(i)>qsurf(i)
-         ok_u2m_toobig(i)=u_zref(i)>speed(i)
-
-         IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
-             n2mout(i,1)=n2mout(i,1)+1
-         ENDIF
-         IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
-             n2mout(i,3)=n2mout(i,3)+1
-         ENDIF
-         IF(ok_u2m_toobig(i)) THEN
-             n2mout(i,5)=n2mout(i,5)+1
-         ENDIF
-
-         IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
-   ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
-   ok_u2m_toobig(i)) THEN
-             delm_new(i)=min(max(delm_new(i),0.),1.)
-             delh_new(i)=min(max(delh_new(i),0.),1.)
-             u_zref(i) = delm_new(i)*speed(i)
-             u_zref_p(i) = u_zref(i)
-             q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
-                 max(qsurf(i),0.0)*(1-delh_new(i))
-             q_zref_p(i) = q_zref(i)
-             te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
-             te_zref_p(i) = te_zref(i)
-
-! return to normal temperature
-             temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
-             temp_p(i) = temp(i)
-         ENDIF 
-
-       ENDDO
-
-! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
-
-      DO n = 1, niter
-
-        okri=.TRUE.
-        CALL screencn(klon, knon, nsrf, zxli, &
-                     u_zref, temp, q_zref, zref, &
-                     ts1, qsurf, z0m, z0h, psol, &
-                     cdram, cdrah,  okri, &
-                     ri1, 0, &
-                     pref, delm, delh, ri2m, &
-                     s_pblh, prain, tsol, pat1      )
-
-        DO i = 1, knon
-          u_zref(i) = delm(i)*speed(i)
-          q_zref(i) = delh(i)*max(q1(i),0.0) + &
-             max(qsurf(i),0.0)*(1-delh(i))
-          te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
-
-! return to normal temperature
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-
-! compteurs ici
-
-          ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
-   te_zref(i)<ts1(i)
-          ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
-   te_zref(i)>ts1(i)
-          ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
-   q_zref(i)<qsurf(i)
-          ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
-   q_zref(i)>qsurf(i)
-          ok_u2m_toobig(i)=u_zref(i)>speed(i)
-
-          IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
-              n2mout(i,2)=n2mout(i,2)+1
-          ENDIF
-          IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
-              n2mout(i,4)=n2mout(i,4)+1
-          ENDIF
-          IF(ok_u2m_toobig(i)) THEN
-              n2mout(i,6)=n2mout(i,6)+1
-          ENDIF
-
-          IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
-   ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
-   ok_u2m_toobig(i)) THEN
-              delm(i)=min(max(delm(i),0.),1.)
-              delh(i)=min(max(delh(i),0.),1.)
-              u_zref(i) = delm(i)*speed(i)
-              q_zref(i) = delh(i)*max(q1(i),0.0) + &
-             max(qsurf(i),0.0)*(1-delh(i))
-              te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
-              temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-          ENDIF
-
-
-          IF(n==ncon) THEN
-            te_zref_con(i) = te_zref(i)
-            q_zref_con(i) = q_zref(i)
-          ENDIF 
-
-        ENDDO 
-
-      ENDDO 
-
-      DO i = 1, knon
-        q_zref_c(i) = q_zref(i)
-        temp_c(i) = temp(i)
-
-        ok_pred(i)=0.
-        ok_corr(i)=1.
-
-        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
-        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
-
-        u_zref_c(i) = u_zref(i)
-        u_2m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
-      ENDDO
-
-
-!----------First aproximation of variables at zref --------------------------
-
-      zref = 10.0
-
-       CALL screencn(klon, knon, nsrf, zxli, &
-                     speed, tpot, q1, zref, &
-                     ts1, qsurf, z0m, z0h, psol, &
-                     cdram, cdrah,  okri, &
-                     ri1, 1, &
-                     pref_new, delm_new, delh_new, ri10m, &
-                     s_pblh, prain, tsol, pat1      )
-
-       DO i = 1, knon
-         u_zref(i) = delm_new(i)*speed(i)
-         q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
-             max(qsurf(i),0.0)*(1-delh_new(i))
-         te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
-         temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
-         u_zref_p(i) = u_zref(i)
-
-! compteurs ici
-
-         ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
-   te_zref(i)<ts1(i)
-         ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
-   te_zref(i)>ts1(i)
-         ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
-   q_zref(i)<qsurf(i)
-         ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
-   q_zref(i)>qsurf(i)
-         ok_u10m_toobig(i)=u_zref(i)>speed(i)
-
-         IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
-             n10mout(i,1)=n10mout(i,1)+1
-         ENDIF
-         IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
-             n10mout(i,3)=n10mout(i,3)+1
-         ENDIF
-         IF(ok_u10m_toobig(i)) THEN
-             n10mout(i,5)=n10mout(i,5)+1
-         ENDIF
-
-         IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
-   ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
-   ok_u10m_toobig(i)) THEN
-             delm_new(i)=min(max(delm_new(i),0.),1.)
-             delh_new(i)=min(max(delh_new(i),0.),1.)
-             u_zref(i) = delm_new(i)*speed(i)
-             u_zref_p(i) = u_zref(i)
-             q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
-                 max(qsurf(i),0.0)*(1-delh_new(i))
-             te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
-             temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
-         ENDIF 
-
-       ENDDO
-
-! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
-
-      DO n = 1, niter
-
-        okri=.TRUE.
-        CALL screencn(klon, knon, nsrf, zxli, &
-                     u_zref, temp, q_zref, zref, &
-                     ts1, qsurf, z0m, z0h, psol, &
-                     cdram, cdrah,  okri, &
-                     ri1, 0, &
-                     pref, delm, delh, ri10m, &
-                     s_pblh, prain, tsol, pat1      )
-
-        DO i = 1, knon
-          u_zref(i) = delm(i)*speed(i)
-          q_zref(i) = delh(i)*max(q1(i),0.0) + &
-             max(qsurf(i),0.0)*(1-delh(i))
-          te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
-
-! return to normal temperature
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-
-! compteurs ici
-
-          ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
-   te_zref(i)<ts1(i)
-          ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
-   te_zref(i)>ts1(i)
-          ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
-   q_zref(i)<qsurf(i)
-          ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
-   q_zref(i)>qsurf(i)
-          ok_u10m_toobig(i)=u_zref(i)>speed(i)
-
-          IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
-              n10mout(i,2)=n10mout(i,2)+1
-          ENDIF
-          IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
-              n10mout(i,4)=n10mout(i,4)+1
-          ENDIF
-          IF(ok_u10m_toobig(i)) THEN
-              n10mout(i,6)=n10mout(i,6)+1
-          ENDIF
-
-          IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
-   ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
-   ok_u10m_toobig(i)) THEN
-              delm(i)=min(max(delm(i),0.),1.)
-              delh(i)=min(max(delh(i),0.),1.)
-              u_zref(i) = delm(i)*speed(i)
-              q_zref(i) = delh(i)*max(q1(i),0.0) + &
-             max(qsurf(i),0.0)*(1-delh(i))
-              te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
-              temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-          ENDIF
-
-
-          IF(n==ncon) THEN
-            te_zref_con(i) = te_zref(i)
-            q_zref_con(i) = q_zref(i)
-          ENDIF 
-
-        ENDDO 
-
-      ENDDO 
-
-      DO i = 1, knon
-        q_zref_c(i) = q_zref(i)
-        temp_c(i) = temp(i)
-
-        ok_pred(i)=0.
-        ok_corr(i)=1.
-
-        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
-        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
-
-        u_zref_c(i) = u_zref(i)
-        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
-      ENDDO
-
-
-      END SUBROUTINE stdlevvarn
+    ENDDO
+
+    DO i = 1, knon
+      q_zref_c(i) = q_zref(i)
+      temp_c(i) = temp(i)
+
+      ok_pred(i) = 0.
+      ok_corr(i) = 1.
+
+      t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+      q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+
+      u_zref_c(i) = u_zref(i)
+      u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
+    ENDDO
+
+  END SUBROUTINE stdlevvarn
 
 END MODULE stdlevvar_mod
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/suphel.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/suphel.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/suphel.F90	(revision 5143)
@@ -3,9 +3,9 @@
 
 SUBROUTINE suphel
+  USE lmdz_YOETHF
 
   IMPLICIT NONE
 
   include "YOMCST.h"
-  include "YOETHF.h"
   ! IM cf. JLD
   LOGICAL firstcall
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_mod.F90	(revision 5143)
@@ -35,8 +35,8 @@
     USE indice_sol_mod, ONLY: is_oce
     USE lmdz_clesphys
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     INCLUDE "YOMCST.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "YOETHF.h"
 
     INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
@@ -169,8 +169,8 @@
 
     USE lmdz_print_control, ONLY: prt_level,lunout
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     INCLUDE "YOMCST.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "YOETHF.h"
 
     INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
@@ -721,8 +721,8 @@
 
     USE lmdz_print_control, ONLY: prt_level,lunout
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     INCLUDE "YOMCST.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "YOETHF.h"
 
     INTEGER,                      INTENT(IN)        :: knon         ! number of grid cells
@@ -964,8 +964,8 @@
 
     USE lmdz_print_control, ONLY: prt_level,lunout
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     INCLUDE "YOMCST.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "YOETHF.h"
 
     INTEGER,                      INTENT(IN)        :: knon         ! number of grid cells
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_var_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_var_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_var_mod.F90	(revision 5143)
@@ -318,8 +318,8 @@
     USE indice_sol_mod, ONLY: is_oce
     USE lmdz_clesphys
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     INCLUDE "YOMCST.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "YOETHF.h"
 
     INTEGER, INTENT(IN) :: knon    ! number of grid cells
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/FCTTRE.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/FCTTRE.h	(revision 5142)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/FCTTRE.h
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/YOEGWD.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/YOEGWD.h	(revision 5142)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/YOEGWD.h
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/YOETHF.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/YOETHF.h	(revision 5142)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/YOETHF.h
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90	(revision 5143)
@@ -43,4 +43,5 @@
   USE dimphy
   USE infotrac_phy, ONLY: nbtr
+  USE lmdz_YOETHF
 #ifdef ISO
   USE infotrac_phy, ONLY: ntraciso=>ntiso
@@ -65,4 +66,5 @@
   USE lmdz_clesphys
   USE lmdz_conema3
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   IMPLICIT NONE
@@ -297,6 +299,4 @@
   include "YOMCST.h"
   include "YOMCST2.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
 
   IF (first) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90	(revision 5143)
@@ -18,4 +18,6 @@
   ! **************************************************************
 USE lmdz_cvthermo
+USE lmdz_YOETHF
+USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   IMPLICIT NONE
@@ -30,7 +32,5 @@
   ! ===============================================================
 
-  include "YOETHF.h"
   include "YOMCST.h"
-  include "FCTTRE.h"
 !inputs:
   INTEGER, INTENT (IN)                      :: nd, len
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90	(revision 5143)
@@ -19,4 +19,6 @@
   ! ****************************************************************
 USE lmdz_cvthermo
+USE lmdz_YOETHF
+USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   IMPLICIT NONE
@@ -31,7 +33,5 @@
   ! ===============================================================
 
-  include "YOETHF.h"
   include "YOMCST.h"
-  include "FCTTRE.h"
 !inputs:
   INTEGER, INTENT (IN)                      :: nd, len
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5143)
@@ -12843,4 +12843,7 @@
     USE isotrac_mod, ONLY: izone_cont,index_zone,index_iso
 #endif
+USE lmdz_YOETHF
+USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
         IMPLICIT NONE
 
@@ -12848,7 +12851,4 @@
         ! fond, etc...
         ! commun aux dfférentes sous-surfaces.
-
- include "YOETHF.h"
- include "FCTTRE.h"
 
          ! inputs
@@ -13407,8 +13407,8 @@
 &       bassin_map
 #endif
+USE lmdz_YOETHF
+USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
         IMPLICIT NONE
-
- include "YOETHF.h"
- include "FCTTRE.h"
 
         ! inputs
@@ -14318,10 +14318,9 @@
 &       bassin_map
 #endif
+USE lmdz_YOETHF
+USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
         IMPLICIT NONE
 
- include "YOETHF.h"
- include "FCTTRE.h"
-        
         ! inputs
         INTEGER klon,knon
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_FCTTRE.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_FCTTRE.f90	(revision 5143)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_FCTTRE.f90	(revision 5143)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_FCTTRE.f90
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_YOEGWD.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_YOEGWD.f90	(revision 5143)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_YOEGWD.f90	(revision 5143)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_YOEGWD.f90
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_YOETHF.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_YOETHF.f90	(revision 5143)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_YOETHF.f90	(revision 5143)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_YOETHF.f90
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90	(revision 5143)
@@ -67,4 +67,7 @@
 #endif
 #endif
+
+USE lmdz_YOETHF
+  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
   IMPLICIT NONE
@@ -312,6 +315,4 @@
   REAL zzz
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
   fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
   fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90	(revision 5143)
@@ -424,4 +424,6 @@
     USE lmdz_conema3
     USE lmdz_dimpft, ONLY: nvm_lmdz
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
 
     IMPLICIT NONE
@@ -1268,6 +1270,4 @@
 
     include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
 
     ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90	(revision 5142)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90	(revision 5143)
@@ -15,4 +15,8 @@
 #endif
 #endif
+
+    USE lmdz_YOETHF
+    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
+
     IMPLICIT NONE
     !>======================================================================
@@ -27,10 +31,7 @@
     INTEGER i,k,ixt,ivapcur,iliqcur,isolcur
 
-
     !--------Stochastic Boundary Layer Triggering: ALE_BL--------
     !---Propri\'et\'es du thermiques au LCL
     include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
     !IM 100106 BEG : pouvoir sortir les ctes de la physique
 
