Index: LMDZ6/trunk/libf/phylmdiso/FCTTRE.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/FCTTRE.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/FCTTRE.h	(revision 3940)
@@ -1,45 +1,1 @@
-!
-! $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))
+link ../phylmd/FCTTRE.h
Index: LMDZ6/trunk/libf/phylmdiso/YOECUMF.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/YOECUMF.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/YOECUMF.h	(revision 3940)
@@ -1,48 +1,1 @@
-!
-! $Id: YOECUMF.h 1907 2013-11-26 13:10:46Z lguez $
-!
-!  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* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
-!     ----------------------------------------------------------------
-!
-      COMMON /YOECUMF/                                                  &
-     &                 LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV,              &
-     &                 ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP,          &
-     &                 CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON
-
-      LOGICAL          LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV
-      REAL ENTRPEN, ENTRSCV, ENTRMID, ENTRDD
-      REAL CMFCTOP, CMFCMAX, CMFCMIN, CMFDEPS, RHCDD, CPRCON
-!$OMP THREADPRIVATE(/YOECUMF/)
-!
-!*if (DOC,declared) <> 'UNKNOWN'
-!*    *COMMON* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
-!
-!     M.TIEDTKE       E. C. M. W. F.      18/1/89
-!
-!     NAME      TYPE      PURPOSE
-!     ----      ----      -------
-!
-!     LMFPEN    LOGICAL  TRUE IF PENETRATIVE CONVECTION IS SWITCHED ON
-!     LMFSCV    LOGICAL  TRUE IF SHALLOW     CONVECTION IS SWITCHED ON
-!     LMFMID    LOGICAL  TRUE IF MIDLEVEL    CONVECTION IS SWITCHED ON
-!     LMFDD     LOGICAL  TRUE IF CUMULUS DOWNDRAFT      IS SWITCHED ON
-!     LMFDUDV   LOGICAL  TRUE IF CUMULUS FRICTION       IS SWITCHED ON
-!     ENTRPEN   REAL     ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
-!     ENTRSCV   REAL     ENTRAINMENT RATE FOR SHALLOW CONVECTION
-!     ENTRMID   REAL     ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
-!     ENTRDD    REAL     ENTRAINMENT RATE FOR CUMULUS DOWNDRAFTS
-!     CMFCTOP   REAL     RELAT. CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANC
-!     CMFCMAX   REAL     MAXIMUM MASSFLUX VALUE ALLOWED FOR
-!     CMFCMIN   REAL     MINIMUM MASSFLUX VALUE (FOR SAFETY)
-!     CMFDEPS   REAL     FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
-!     RHCDD     REAL     RELATIVE SATURATION IN DOWNDRAFTS
-!     CPRCON    REAL     COEFFICIENTS FOR DETERMINING CONVERSION
-!                        FROM CLOUD WATER TO RAIN
-!*ifend
-!     ----------------------------------------------------------------
+link ../phylmd/YOECUMF.h
Index: LMDZ6/trunk/libf/phylmdiso/YOEGWD.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/YOEGWD.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/YOEGWD.h	(revision 3940)
@@ -1,32 +1,1 @@
-!
-! $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/)
+link ../phylmd/YOEGWD.h
Index: LMDZ6/trunk/libf/phylmdiso/YOEMETH.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/YOEMETH.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/YOEMETH.F90	(revision 3940)
@@ -1,46 +1,1 @@
-MODULE YOEMETH
-
-IMPLICIT NONE
-
-SAVE
-
-!     -----------------------------------------------------------------
-!     ** YOEMETH - CONTROL PARAMETERS FOR METHANE OXIDATION
-!     -----------------------------------------------------------------
-
-!     * E.C.M.W.F. PHYSICS PACKAGE *
-
-!     C. JAKOB        E.C.M.W.F.          98/04/07
-!     D. Cugnet       Adapted for LMDZ    12/02/24
-
-!      NAME     TYPE      PURPOSE
-!      ----     ----      -------
-
-!     *RALPHA1* REAL      CONSTANT IN TIME SCALE 1 CALCULATIONS
-!     *RALPHA2* REAL      CONSTANT IN TIME SCALE 2 CALCULATIONS
-!     *RQLIM*   REAL      UPPERLIMIT OD SPECIFIC HUMIDITY FOR 
-!                         METHANE OXIDATION TO BE ACTIVE
-!     *RPBOTOX* REAL      PRESSURE BELOW WHICH METHANE OXIDATION
-!                         IS CONSIDERED ACTIVE
-!     *RPBOTPH* REAL      PRESSURE BELOW WHICH H2O PHOTOLYSIS
-!                         IS CONSIDERED ACTIVE
-!     *RPTOPOX* REAL      PRESSURE BELOW WHICH SHORTEST TIME SCALE
-!                         IS USED IN METHANE OXIDATION
-!     *RPTOPPH* REAL      PRESSURE BELOW WHICH SHORTEST TIME SCALE
-!                         IS USED IN H2O PHOTOLYISIS
-!     *RALPHA3* REAL      CONSTANT IN TIME SCALE 2 CALCULATIONS
-!     *RLOGPPH* REAL      CONSTANT IN TIME SCALE 2 CALCULATIONS
-
-REAL :: RALPHA1
-REAL :: RALPHA2
-REAL :: RQLIM
-REAL :: RPBOTOX
-REAL :: RPBOTPH
-REAL :: RPTOPOX
-REAL :: RPTOPPH
-REAL :: RALPHA3
-REAL :: RLOGPPH
-
-END MODULE YOEMETH
-
-
+link ../phylmd/YOEMETH.F90
Index: LMDZ6/trunk/libf/phylmdiso/YOETHF.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/YOETHF.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/YOETHF.h	(revision 3940)
@@ -1,31 +1,1 @@
-!
-! $Id: YOETHF.h 2799 2017-02-24 18:50:33Z jyg $
-!
-!  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/)
+link ../phylmd/YOETHF.h
Index: LMDZ6/trunk/libf/phylmdiso/YOMCST.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/YOMCST.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/YOMCST.h	(revision 3940)
@@ -1,46 +1,1 @@
-!
-! $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)
-!
-!
-! A1.0 Fundamental constants
-      REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO
-! A1.1 Astronomical constants
-      REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
-! A1.1.bis Constantes concernant l'orbite de la Terre:
-      REAL R_ecc, R_peri, R_incl
-! A1.2 Geoide
-      REAL RA,RG,R1SA
-! A1.3 Radiation
-!     REAL RSIGMA,RI0
-      REAL RSIGMA
-! A1.4 Thermodynamic gas phase
-      REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12
-      REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
-      REAL RKAPPA,RETV
-! A1.5,6 Thermodynamic liquid,solid phases
-      REAL RCW,RCS
-! A1.7 Thermodynamic transition of phase
-      REAL RLVTT,RLSTT,RLMLT,RTT,RATM
-! A1.8 Curve of saturation
-      REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
-      REAL RALPD,RBETD,RGAMD
-!
-      COMMON/YOMCST/RPI   ,RCLUM ,RHPLA ,RKBOL ,RNAVO                   &
-     &      ,RDAY  ,REA   ,REPSM ,RSIYEA,RSIDAY,ROMEGA                  &
-     &      ,R_ecc, R_peri, R_incl                                      &
-     &      ,RA    ,RG    ,R1SA                                         &
-     &      ,RSIGMA                                                     &
-     &      ,R     ,RMD   ,RMV   ,RD    ,RV    ,RCPD                    &
-     &      ,RMO3  ,RMCO2 ,RMC   ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12        &
-     &      ,RCPV  ,RCVD  ,RCVV  ,RKAPPA,RETV                           &
-     &      ,RCW   ,RCS                                                 &
-     &      ,RLVTT ,RLSTT ,RLMLT ,RTT   ,RATM                           &
-     &      ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS            &
-     &      ,RALPD ,RBETD ,RGAMD
-!    ------------------------------------------------------------------
-!$OMP THREADPRIVATE(/YOMCST/)
+link ../phylmd/YOMCST.h
Index: LMDZ6/trunk/libf/phylmdiso/YOMCST2.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/YOMCST2.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/YOMCST2.h	(revision 3940)
@@ -1,14 +1,1 @@
-
-      INTEGER choice, iflag_mix, iflag_mix_adiab
-      REAL  gammas, alphas, betas, Fmax, qqa1, qqa2, qqa3, scut
-      REAL  Qcoef1max,Qcoef2max,Supcrit1,Supcrit2
-      REAL coef_clos_ls
-!
-      COMMON/YOMCST2/gammas,    alphas, betas, Fmax, scut,              &
-     &               qqa1, qqa2, qqa3,                                  &
-     &               Qcoef1max,Qcoef2max,                               &
-     &               Supcrit1, Supcrit2,                                &
-     &               choice,iflag_mix,coef_clos_ls,iflag_mix_adiab
-!$OMP THREADPRIVATE(/YOMCST2/)
-!    --------------------------------------------------------------------
-
+link ../phylmd/YOMCST2.h
Index: LMDZ6/trunk/libf/phylmdiso/aaam_bud.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/aaam_bud.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/aaam_bud.F90	(revision 3940)
@@ -1,358 +1,1 @@
-
-! $Id: aaam_bud.F90 2350 2015-08-25 11:40:19Z emillour $
-
-SUBROUTINE aaam_bud(iam, nlon, nlev, rjour, rsec, rea, rg, ome, plat, plon, &
-    phis, dragu, liftu, phyu, dragv, liftv, phyv, p, u, v, aam, torsfc)
-
-  USE dimphy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): F.Lott (LMD/CNRS) date: 20031020
-  ! Object: Compute different terms of the axial AAAM Budget.
-  ! No outputs, every AAM quantities are written on the IAM
-  ! File.
-
-  ! Modif : I.Musat (LMD/CNRS) date : 20041020
-  ! Outputs : axial components of wind AAM "aam" and total surface torque
-  ! "torsfc",
-  ! but no write in the iam file.
-
-  ! WARNING: Only valid for regular rectangular grids.
-  ! REMARK: CALL DANS PHYSIQ AFTER lift_noro:
-  ! CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
-  ! C               ra,rg,romega,
-  ! C               rlat,rlon,pphis,
-  ! C               zustrdr,zustrli,zustrph,
-  ! C               zvstrdr,zvstrli,zvstrph,
-  ! C               paprs,u,v)
-
-  ! ======================================================================
-  ! Explicit Arguments:
-  ! ==================
-  ! iam-----input-I-File number where AAMs and torques are written
-  ! It is a formatted file that has been opened
-  ! in physiq.F
-  ! nlon----input-I-Total number of horizontal points that get into physics
-  ! nlev----input-I-Number of vertical levels
-  ! rjour        -R-Jour compte depuis le debut de la simu (run.def)
-  ! rsec         -R-Seconde de la journee
-  ! rea          -R-Earth radius
-  ! rg           -R-gravity constant
-  ! ome          -R-Earth rotation rate
-  ! plat ---input-R-Latitude en degres
-  ! plon ---input-R-Longitude en degres
-  ! phis ---input-R-Geopotential at the ground
-  ! dragu---input-R-orodrag stress (zonal)
-  ! liftu---input-R-orolift stress (zonal)
-  ! phyu----input-R-Stress total de la physique (zonal)
-  ! dragv---input-R-orodrag stress (Meridional)
-  ! liftv---input-R-orolift stress (Meridional)
-  ! phyv----input-R-Stress total de la physique (Meridional)
-  ! p-------input-R-Pressure (Pa) at model half levels
-  ! u-------input-R-Horizontal wind (m/s)
-  ! v-------input-R-Meridional wind (m/s)
-  ! aam-----output-R-Axial Wind AAM (=raam(3))
-  ! torsfc--output-R-Total surface torque (=tmou(3)+tsso(3)+tbls(3))
-
-  ! Implicit Arguments:
-  ! ===================
-
-  ! nbp_lon--common-I: Number of longitude intervals
-  ! (nbp_lat-1)--common-I: Number of latitude intervals
-  ! klon-common-I: Number of points seen by the physics
-  ! nbp_lon*(nbp_lat-2)+2 for instance
-  ! klev-common-I: Number of vertical layers
-  ! ======================================================================
-  ! Local Variables:
-  ! ================
-  ! dlat-----R: Latitude increment (Radians)
-  ! dlon-----R: Longitude increment (Radians)
-  ! raam  ---R: Wind AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)
-  ! oaam  ---R: Mass AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)
-  ! tmou-----R: Resolved Mountain torque (3 components)
-  ! tsso-----R: Parameterised Moutain drag torque (3 components)
-  ! tbls-----R: Parameterised Boundary layer torque (3 components)
-
-  ! LOCAL ARRAY:
-  ! ===========
-  ! zs    ---R: Topographic height
-  ! ps    ---R: Surface Pressure
-  ! ub    ---R: Barotropic wind zonal
-  ! vb    ---R: Barotropic wind meridional
-  ! zlat  ---R: Latitude in radians
-  ! zlon  ---R: Longitude in radians
-  ! ======================================================================
-
-  ! ARGUMENTS
-
-  INTEGER iam, nlon, nlev
-  REAL, INTENT (IN) :: rjour, rsec, rea, rg, ome
-  REAL plat(nlon), plon(nlon), phis(nlon)
-  REAL dragu(nlon), liftu(nlon), phyu(nlon)
-  REAL dragv(nlon), liftv(nlon), phyv(nlon)
-  REAL p(nlon, nlev+1), u(nlon, nlev), v(nlon, nlev)
-
-  ! Variables locales:
-
-  INTEGER i, j, k, l
-  REAL xpi, hadley, hadday
-  REAL dlat, dlon
-  REAL raam(3), oaam(3), tmou(3), tsso(3), tbls(3)
-  INTEGER iax
-  ! IM ajout aam, torsfc
-  ! aam = composante axiale du Wind AAM raam
-  ! torsfc = composante axiale de (tmou+tsso+tbls)
-  REAL aam, torsfc
-
-  REAL zs(801, 401), ps(801, 401)
-  REAL ub(801, 401), vb(801, 401)
-  REAL ssou(801, 401), ssov(801, 401)
-  REAL blsu(801, 401), blsv(801, 401)
-  REAL zlon(801), zlat(401)
-
-  CHARACTER (LEN=20) :: modname = 'aaam_bud'
-  CHARACTER (LEN=80) :: abort_message
-
-
-
-  ! PUT AAM QUANTITIES AT ZERO:
-
-  IF (nbp_lon+1>801 .OR. nbp_lat>401) THEN
-    abort_message = 'Pb de dimension dans aaam_bud'
-    CALL abort_physic(modname, abort_message, 1)
-  END IF
-
-  xpi = acos(-1.)
-  hadley = 1.E18
-  hadday = 1.E18*24.*3600.
-  IF(klon_glo.EQ.1) THEN
-    dlat = xpi
-  ELSE
-    dlat = xpi/real(nbp_lat-1)
-  ENDIF
-  dlon = 2.*xpi/real(nbp_lon)
-
-  DO iax = 1, 3
-    oaam(iax) = 0.
-    raam(iax) = 0.
-    tmou(iax) = 0.
-    tsso(iax) = 0.
-    tbls(iax) = 0.
-  END DO
-
-  ! MOUNTAIN HEIGHT, PRESSURE AND BAROTROPIC WIND:
-
-  ! North pole values (j=1):
-
-  l = 1
-
-  ub(1, 1) = 0.
-  vb(1, 1) = 0.
-  DO k = 1, nlev
-    ub(1, 1) = ub(1, 1) + u(l, k)*(p(l,k)-p(l,k+1))/rg
-    vb(1, 1) = vb(1, 1) + v(l, k)*(p(l,k)-p(l,k+1))/rg
-  END DO
-
-  zlat(1) = plat(l)*xpi/180.
-
-  DO i = 1, nbp_lon + 1
-
-    zs(i, 1) = phis(l)/rg
-    ps(i, 1) = p(l, 1)
-    ub(i, 1) = ub(1, 1)
-    vb(i, 1) = vb(1, 1)
-    ssou(i, 1) = dragu(l) + liftu(l)
-    ssov(i, 1) = dragv(l) + liftv(l)
-    blsu(i, 1) = phyu(l) - dragu(l) - liftu(l)
-    blsv(i, 1) = phyv(l) - dragv(l) - liftv(l)
-
-  END DO
-
-
-  DO j = 2, nbp_lat-1
-
-    ! Values at Greenwich (Periodicity)
-
-    zs(nbp_lon+1, j) = phis(l+1)/rg
-    ps(nbp_lon+1, j) = p(l+1, 1)
-    ssou(nbp_lon+1, j) = dragu(l+1) + liftu(l+1)
-    ssov(nbp_lon+1, j) = dragv(l+1) + liftv(l+1)
-    blsu(nbp_lon+1, j) = phyu(l+1) - dragu(l+1) - liftu(l+1)
-    blsv(nbp_lon+1, j) = phyv(l+1) - dragv(l+1) - liftv(l+1)
-    zlon(nbp_lon+1) = -plon(l+1)*xpi/180.
-    zlat(j) = plat(l+1)*xpi/180.
-
-    ub(nbp_lon+1, j) = 0.
-    vb(nbp_lon+1, j) = 0.
-    DO k = 1, nlev
-      ub(nbp_lon+1, j) = ub(nbp_lon+1, j) + u(l+1, k)*(p(l+1,k)-p(l+1,k+1))/rg
-      vb(nbp_lon+1, j) = vb(nbp_lon+1, j) + v(l+1, k)*(p(l+1,k)-p(l+1,k+1))/rg
-    END DO
-
-
-    DO i = 1, nbp_lon
-
-      l = l + 1
-      zs(i, j) = phis(l)/rg
-      ps(i, j) = p(l, 1)
-      ssou(i, j) = dragu(l) + liftu(l)
-      ssov(i, j) = dragv(l) + liftv(l)
-      blsu(i, j) = phyu(l) - dragu(l) - liftu(l)
-      blsv(i, j) = phyv(l) - dragv(l) - liftv(l)
-      zlon(i) = plon(l)*xpi/180.
-
-      ub(i, j) = 0.
-      vb(i, j) = 0.
-      DO k = 1, nlev
-        ub(i, j) = ub(i, j) + u(l, k)*(p(l,k)-p(l,k+1))/rg
-        vb(i, j) = vb(i, j) + v(l, k)*(p(l,k)-p(l,k+1))/rg
-      END DO
-
-    END DO
-
-  END DO
-
-
-  ! South Pole
-
-  IF (nbp_lat-1>1) THEN
-    l = l + 1
-    ub(1, nbp_lat) = 0.
-    vb(1, nbp_lat) = 0.
-    DO k = 1, nlev
-      ub(1, nbp_lat) = ub(1, nbp_lat) + u(l, k)*(p(l,k)-p(l,k+1))/rg
-      vb(1, nbp_lat) = vb(1, nbp_lat) + v(l, k)*(p(l,k)-p(l,k+1))/rg
-    END DO
-    zlat(nbp_lat) = plat(l)*xpi/180.
-
-    DO i = 1, nbp_lon + 1
-      zs(i, nbp_lat) = phis(l)/rg
-      ps(i, nbp_lat) = p(l, 1)
-      ssou(i, nbp_lat) = dragu(l) + liftu(l)
-      ssov(i, nbp_lat) = dragv(l) + liftv(l)
-      blsu(i, nbp_lat) = phyu(l) - dragu(l) - liftu(l)
-      blsv(i, nbp_lat) = phyv(l) - dragv(l) - liftv(l)
-      ub(i, nbp_lat) = ub(1, nbp_lat)
-      vb(i, nbp_lat) = vb(1, nbp_lat)
-    END DO
-  END IF
-
-
-  ! MOMENT ANGULAIRE
-
-  DO j = 1, nbp_lat-1
-    DO i = 1, nbp_lon
-
-      raam(1) = raam(1) - rea**3*dlon*dlat*0.5*(cos(zlon(i))*sin(zlat(j))*cos &
-        (zlat(j))*ub(i,j)+cos(zlon(i))*sin(zlat(j+1))*cos(zlat(j+ &
-        1))*ub(i,j+1)) + rea**3*dlon*dlat*0.5*(sin(zlon(i))*cos(zlat(j))*vb(i &
-        ,j)+sin(zlon(i))*cos(zlat(j+1))*vb(i,j+1))
-
-      oaam(1) = oaam(1) - ome*rea**4*dlon*dlat/rg*0.5*(cos(zlon(i))*cos(zlat( &
-        j))**2*sin(zlat(j))*ps(i,j)+cos(zlon(i))*cos(zlat(j+ &
-        1))**2*sin(zlat(j+1))*ps(i,j+1))
-
-      raam(2) = raam(2) - rea**3*dlon*dlat*0.5*(sin(zlon(i))*sin(zlat(j))*cos &
-        (zlat(j))*ub(i,j)+sin(zlon(i))*sin(zlat(j+1))*cos(zlat(j+ &
-        1))*ub(i,j+1)) - rea**3*dlon*dlat*0.5*(cos(zlon(i))*cos(zlat(j))*vb(i &
-        ,j)+cos(zlon(i))*cos(zlat(j+1))*vb(i,j+1))
-
-      oaam(2) = oaam(2) - ome*rea**4*dlon*dlat/rg*0.5*(sin(zlon(i))*cos(zlat( &
-        j))**2*sin(zlat(j))*ps(i,j)+sin(zlon(i))*cos(zlat(j+ &
-        1))**2*sin(zlat(j+1))*ps(i,j+1))
-
-      raam(3) = raam(3) + rea**3*dlon*dlat*0.5*(cos(zlat(j))**2*ub(i,j)+cos( &
-        zlat(j+1))**2*ub(i,j+1))
-
-      oaam(3) = oaam(3) + ome*rea**4*dlon*dlat/rg*0.5*(cos(zlat(j))**3*ps(i,j &
-        )+cos(zlat(j+1))**3*ps(i,j+1))
-
-    END DO
-  END DO
-
-
-  ! COUPLE DES MONTAGNES:
-
-
-  DO j = 1, nbp_lat-1
-    DO i = 1, nbp_lon
-      tmou(1) = tmou(1) - rea**2*dlon*0.5*sin(zlon(i))*(zs(i,j)-zs(i,j+1))*( &
-        cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j))
-      tmou(2) = tmou(2) + rea**2*dlon*0.5*cos(zlon(i))*(zs(i,j)-zs(i,j+1))*( &
-        cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j))
-    END DO
-  END DO
-
-  DO j = 2, nbp_lat-1
-    DO i = 1, nbp_lon
-      tmou(1) = tmou(1) + rea**2*dlat*0.5*sin(zlat(j))*(zs(i+1,j)-zs(i,j))*( &
-        cos(zlon(i+1))*ps(i+1,j)+cos(zlon(i))*ps(i,j))
-      tmou(2) = tmou(2) + rea**2*dlat*0.5*sin(zlat(j))*(zs(i+1,j)-zs(i,j))*( &
-        sin(zlon(i+1))*ps(i+1,j)+sin(zlon(i))*ps(i,j))
-      tmou(3) = tmou(3) - rea**2*dlat*0.5*cos(zlat(j))*(zs(i+1,j)-zs(i,j))*( &
-        ps(i+1,j)+ps(i,j))
-    END DO
-  END DO
-
-
-  ! COUPLES DES DIFFERENTES FRICTION AU SOL:
-
-  l = 1
-  DO j = 2, nbp_lat-1
-    DO i = 1, nbp_lon
-      l = l + 1
-      tsso(1) = tsso(1) - rea**3*cos(zlat(j))*dlon*dlat*ssou(i, j)*sin(zlat(j &
-        ))*cos(zlon(i)) + rea**3*cos(zlat(j))*dlon*dlat*ssov(i, j)*sin(zlon(i &
-        ))
-
-      tsso(2) = tsso(2) - rea**3*cos(zlat(j))*dlon*dlat*ssou(i, j)*sin(zlat(j &
-        ))*sin(zlon(i)) - rea**3*cos(zlat(j))*dlon*dlat*ssov(i, j)*cos(zlon(i &
-        ))
-
-      tsso(3) = tsso(3) + rea**3*cos(zlat(j))*dlon*dlat*ssou(i, j)*cos(zlat(j &
-        ))
-
-      tbls(1) = tbls(1) - rea**3*cos(zlat(j))*dlon*dlat*blsu(i, j)*sin(zlat(j &
-        ))*cos(zlon(i)) + rea**3*cos(zlat(j))*dlon*dlat*blsv(i, j)*sin(zlon(i &
-        ))
-
-      tbls(2) = tbls(2) - rea**3*cos(zlat(j))*dlon*dlat*blsu(i, j)*sin(zlat(j &
-        ))*sin(zlon(i)) - rea**3*cos(zlat(j))*dlon*dlat*blsv(i, j)*cos(zlon(i &
-        ))
-
-      tbls(3) = tbls(3) + rea**3*cos(zlat(j))*dlon*dlat*blsu(i, j)*cos(zlat(j &
-        ))
-
-    END DO
-  END DO
-
-
-  ! write(*,*) 'AAM',rsec,
-  ! write(*,*) 'AAM',rjour+rsec/86400.,
-  ! c      raam(3)/hadday,oaam(3)/hadday,
-  ! c      tmou(3)/hadley,tsso(3)/hadley,tbls(3)/hadley
-
-  ! write(iam,100)rjour+rsec/86400.,
-  ! c      raam(1)/hadday,oaam(1)/hadday,
-  ! c      tmou(1)/hadley,tsso(1)/hadley,tbls(1)/hadley,
-  ! c      raam(2)/hadday,oaam(2)/hadday,
-  ! c      tmou(2)/hadley,tsso(2)/hadley,tbls(2)/hadley,
-  ! c      raam(3)/hadday,oaam(3)/hadday,
-  ! c      tmou(3)/hadley,tsso(3)/hadley,tbls(3)/hadley
-100 FORMAT (F12.5, 15(1X,F12.5))
-
-  ! write(iam+1,*)((zs(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ps(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ub(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((vb(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ssou(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ssov(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((blsu(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((blsv(i,j),i=1,nbp_lon),j=1,nbp_lat)
-
-  aam = raam(3)
-  torsfc = tmou(3) + tsso(3) + tbls(3)
-
-  RETURN
-END SUBROUTINE aaam_bud
+link ../phylmd/aaam_bud.F90
Index: LMDZ6/trunk/libf/phylmdiso/acama_gwd_rando_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/acama_gwd_rando_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/acama_gwd_rando_m.F90	(revision 3940)
@@ -1,536 +1,1 @@
-!
-! $Id: acama_gwd_rando_m.F90 3531 2019-06-06 15:08:45Z fairhead $
-!
-module ACAMA_GWD_rando_m
-
-  implicit none
-
-contains
-
-  SUBROUTINE ACAMA_GWD_rando(DTIME, pp, plat, tt, uu, vv, rot, &
-       zustr, zvstr, d_u, d_v,east_gwstress,west_gwstress)
-
-    ! Parametrization of the momentum flux deposition due to a discrete
-    ! number of gravity waves. 
-    ! Author: F. Lott, A. de la Camara
-    ! July, 24th, 2014
-    ! Gaussian distribution of the source, source is vorticity squared
-    ! Reference: de la Camara and Lott (GRL, 2015, vol 42, 2071-2078 )
-    ! Lott et al (JAS, 2010, vol 67, page 157-170)
-    ! Lott et al (JAS, 2012, vol 69, page 2134-2151)
-
-!  ONLINE:
-    use dimphy, only: klon, klev
-    use assert_m, only: assert
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-    USE vertical_layers_mod, ONLY : presnivs
-
-    include "YOMCST.h"
-    include "clesphys.h"
-!  OFFLINE:
-!   include "dimensions.h"
-!   include "dimphy.h"
-!END DIFFERENCE
-    include "YOEGWD.h"
-
-    ! 0. DECLARATIONS:
-
-    ! 0.1 INPUTS
-    REAL, intent(in)::DTIME ! Time step of the Physics
-    REAL, intent(in):: PP(:, :) ! (KLON, KLEV) Pressure at full levels
-    REAL, intent(in):: ROT(:,:) ! Relative vorticity              
-    REAL, intent(in):: TT(:, :) ! (KLON, KLEV) Temp at full levels 
-    REAL, intent(in):: UU(:, :) ! (KLON, KLEV) Zonal wind at full levels
-    REAL, intent(in):: VV(:, :) ! (KLON, KLEV) Merid wind at full levels
-    REAL, intent(in):: PLAT(:) ! (KLON) LATITUDE                   
-
-    ! 0.2 OUTPUTS
-    REAL, intent(out):: zustr(:), zvstr(:) ! (KLON) Surface Stresses
-
-    REAL, intent(inout):: d_u(:, :), d_v(:, :) 
-    REAL, intent(inout):: east_gwstress(:, :) !  Profile of eastward stress
-    REAL, intent(inout):: west_gwstress(:, :) !  Profile of westward stress 
-    ! (KLON, KLEV) tendencies on winds
-
-    ! O.3 INTERNAL ARRAYS
-    REAL BVLOW(klon)  !  LOW LEVEL BV FREQUENCY
-    REAL ROTBA(KLON),CORIO(KLON)  !  BAROTROPIC REL. VORTICITY AND PLANETARY
-    REAL UZ(KLON, KLEV + 1)
-
-    INTEGER II, JJ, LL
-
-    ! 0.3.0 TIME SCALE OF THE LIFE CYCLE OF THE WAVES PARAMETERIZED
-
-    REAL DELTAT
-
-    ! 0.3.1 GRAVITY-WAVES SPECIFICATIONS
-
-    INTEGER, PARAMETER:: NK = 2, NP = 2, NO = 2, NW = NK * NP * NO
-    INTEGER JK, JP, JO, JW
-    INTEGER, PARAMETER:: NA = 5  !number of realizations to get the phase speed
-    REAL KMIN, KMAX ! Min and Max horizontal wavenumbers
-    REAL CMIN, CMAX ! Min and Max absolute ph. vel.
-    REAL CPHA ! absolute PHASE VELOCITY frequency
-    REAL ZK(NW, KLON) ! Horizontal wavenumber amplitude
-    REAL ZP(NW, KLON) ! Horizontal wavenumber angle 
-    REAL ZO(NW, KLON) ! Absolute frequency !
-
-    ! Waves Intr. freq. at the 1/2 lev surrounding the full level
-    REAL ZOM(NW, KLON), ZOP(NW, KLON)
-
-    ! Wave EP-fluxes at the 2 semi levels surrounding the full level
-    REAL WWM(NW, KLON), WWP(NW, KLON)
-
-    REAL RUW0(NW, KLON) ! Fluxes at launching level
-
-    REAL RUWP(NW, KLON), RVWP(NW, KLON)
-    ! Fluxes X and Y for each waves at 1/2 Levels
-
-    INTEGER LAUNCH, LTROP ! Launching altitude and tropo altitude
-
-    REAL XLAUNCH ! Controle the launching altitude
-    REAL XTROP ! SORT of Tropopause altitude 
-    REAL RUW(KLON, KLEV + 1) ! Flux x at semi levels
-    REAL RVW(KLON, KLEV + 1) ! Flux y at semi levels
-
-    REAL PRMAX ! Maximum value of PREC, and for which our linear formula
-    ! for GWs parameterisation apply
-
-    ! 0.3.2 PARAMETERS OF WAVES DISSIPATIONS
-
-    REAL RDISS, ZOISEC ! COEFF DE DISSIPATION, SECURITY FOR INTRINSIC FREQ
-    REAL CORSEC ! SECURITY FOR INTRINSIC CORIOLIS
-    REAL RUWFRT,SATFRT
-
-    ! 0.3.3 BACKGROUND FLOW AT 1/2 LEVELS AND VERTICAL COORDINATE
-
-    REAL H0 ! Characteristic Height of the atmosphere
-    REAL DZ ! Characteristic depth of the source!
-    REAL PR, TR ! Reference Pressure and Temperature
-
-    REAL ZH(KLON, KLEV + 1) ! Log-pressure altitude
-
-    REAL UH(KLON, KLEV + 1), VH(KLON, KLEV + 1) ! Winds at 1/2 levels
-    REAL PH(KLON, KLEV + 1) ! Pressure at 1/2 levels
-    REAL PSEC ! Security to avoid division by 0 pressure
-    REAL PHM1(KLON, KLEV + 1) ! 1/Press at 1/2 levels
-    REAL BV(KLON, KLEV + 1) ! Brunt Vaisala freq. (BVF) at 1/2 levels
-    REAL BVSEC ! Security to avoid negative BVF
-
-    REAL, DIMENSION(klev+1) ::HREF
-    LOGICAL, SAVE :: gwd_reproductibilite_mpiomp=.true.
-    LOGICAL, SAVE :: firstcall = .TRUE.
-  !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp)
-
-    CHARACTER (LEN=20) :: modname='acama_gwd_rando_m'
-    CHARACTER (LEN=80) :: abort_message
-
-
-
-  IF (firstcall) THEN
-    ! Cle introduite pour resoudre un probleme de non reproductibilite
-    ! Le but est de pouvoir tester de revenir a la version precedenete
-    ! A eliminer rapidement
-    CALL getin_p('gwd_reproductibilite_mpiomp',gwd_reproductibilite_mpiomp)
-    IF (NW+4*(NA-1)+NA>=KLEV) THEN
-       abort_message = 'NW+3*NA>=KLEV Probleme pour generation des ondes'
-       CALL abort_physic (modname,abort_message,1)
-    ENDIF
-    firstcall=.false.
-!    CALL iophys_ini
-  ENDIF
-
-    !-----------------------------------------------------------------
-
-    ! 1. INITIALISATIONS
-
-    ! 1.1 Basic parameter
-
-    ! Are provided from elsewhere (latent heat of vaporization, dry
-    ! gaz constant for air, gravity constant, heat capacity of dry air
-    ! at constant pressure, earth rotation rate, pi).
-
-    ! 1.2 Tuning parameters of V14
-
-! Values for linear in rot (recommended):
-!   RUWFRT=0.005 ! As RUWMAX but for frontal waves 
-!   SATFRT=1.00  ! As SAT    but for frontal waves
-! Values when rot^2 is used                          
-!    RUWFRT=0.02  ! As RUWMAX but for frontal waves 
-!    SATFRT=1.00  ! As SAT    but for frontal waves
-!    CMAX = 30.   ! Characteristic phase speed
-! Values when rot^2*EXP(-pi*sqrt(J)) is used                          
-!   RUWFRT=2.5   ! As RUWMAX but for frontal waves ~ N0*F0/4*DZ
-!   SATFRT=0.60   ! As SAT    but for frontal waves
-    RUWFRT=gwd_front_ruwmax  
-    SATFRT=gwd_front_sat
-    CMAX = 50.    ! Characteristic phase speed
-! Phase speed test
-!   RUWFRT=0.01
-!   CMAX = 50.   ! Characteristic phase speed (TEST)
-! Values when rot^2 and exp(-m^2*dz^2) are used      
-!   RUWFRT=0.03  ! As RUWMAX but for frontal waves 
-!   SATFRT=1.00  ! As SAT    but for frontal waves
-! CRUCIAL PARAMETERS FOR THE WIND FILTERING
-    XLAUNCH=0.95 ! Parameter that control launching altitude
-    RDISS = 0.5  ! Diffusion parameter 
-
-    ! maximum of rain for which our theory applies (in kg/m^2/s)
-
-    DZ = 1000. ! Characteristic depth of the source
-    XTROP=0.2 ! Parameter that control tropopause altitude
-    DELTAT=24.*3600. ! Time scale of the waves (first introduced in 9b)
-!   DELTAT=DTIME     ! No AR-1 Accumulation, OR OFFLINE             
-
-    KMIN = 2.E-5
-    ! minimum horizontal wavenumber (inverse of the subgrid scale resolution)
-
-    KMAX = 1.E-3  ! Max horizontal wavenumber
-    CMIN = 1.     ! Min phase velocity
-
-    TR = 240. ! Reference Temperature
-    PR = 101300. ! Reference pressure
-    H0 = RD * TR / RG ! Characteristic vertical scale height
-
-    BVSEC = 5.E-3 ! Security to avoid negative BVF 
-    PSEC = 1.E-6 ! Security to avoid division by 0 pressure
-    ZOISEC = 1.E-6 ! Security FOR 0 INTRINSIC FREQ
-    CORSEC = ROMEGA*2.*SIN(2.*RPI/180.)! Security for CORIO
-
-!  ONLINE
-    call assert(klon == (/size(pp, 1), size(tt, 1), size(uu, 1), &
-         size(vv, 1), size(rot,1), size(zustr), size(zvstr), size(d_u, 1), &
-         size(d_v, 1), &
-        size(east_gwstress,1), size(west_gwstress,1) /), &
-        "ACAMA_GWD_RANDO klon")
-    call assert(klev == (/size(pp, 2), size(tt, 2), size(uu, 2), &
-         size(vv, 2), size(d_u, 2), size(d_v, 2), &
-         size(east_gwstress,2), size(west_gwstress,2) /), &
-         "ACAMA_GWD_RANDO klev")
-!  END ONLINE
-
-    IF(DELTAT < DTIME)THEN
-!       PRINT *, 'flott_gwd_rando: deltat < dtime!'
-!       STOP 1
-       abort_message=' deltat < dtime! '
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    IF (KLEV < NW) THEN
-!       PRINT *, 'flott_gwd_rando: you will have problem with random numbers'
-!       STOP 1
-       abort_message=' you will have problem with random numbers'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    ! 2. EVALUATION OF THE BACKGROUND FLOW AT SEMI-LEVELS
-
-    ! Pressure and Inv of pressure
-    DO LL = 2, KLEV
-       PH(:, LL) = EXP((LOG(PP(:, LL)) + LOG(PP(:, LL - 1))) / 2.)
-       PHM1(:, LL) = 1. / PH(:, LL) 
-    end DO
-
-    PH(:, KLEV + 1) = 0. 
-    PHM1(:, KLEV + 1) = 1. / PSEC
-    PH(:, 1) = 2. * PP(:, 1) - PH(:, 2)
-
-    ! Launching altitude
-
-    IF (gwd_reproductibilite_mpiomp) THEN
-       ! Reprend la formule qui calcule PH en fonction de PP=play
-       DO LL = 2, KLEV
-          HREF(LL) = EXP((LOG(presnivs(LL)) + LOG(presnivs(LL - 1))) / 2.)
-       end DO
-       HREF(KLEV + 1) = 0.
-       HREF(1) = 2. * presnivs(1) - HREF(2)
-    ELSE
-       HREF(1:KLEV)=PH(KLON/2,1:KLEV)
-    ENDIF
-
-    LAUNCH=0
-    LTROP =0
-    DO LL = 1, KLEV
-       IF (HREF(LL) / HREF(1) > XLAUNCH) LAUNCH = LL
-    ENDDO
-    DO LL = 1, KLEV
-       IF (HREF(LL) / HREF(1) > XTROP) LTROP = LL
-    ENDDO
-    !LAUNCH=22 ; LTROP=33
-!   print*,'LAUNCH=',LAUNCH,'LTROP=',LTROP
-
-
-!   PRINT *,'LAUNCH IN ACAMARA:',LAUNCH
-
-    ! Log pressure vert. coordinate
-    DO LL = 1, KLEV + 1 
-       ZH(:, LL) = H0 * LOG(PR / (PH(:, LL) + PSEC))
-    end DO
-
-    ! BV frequency
-    DO LL = 2, KLEV
-       ! BVSEC: BV Frequency (UH USED IS AS A TEMPORARY ARRAY DOWN TO WINDS)
-       UH(:, LL) = 0.5 * (TT(:, LL) + TT(:, LL - 1)) &
-            * RD**2 / RCPD / H0**2 + (TT(:, LL) &
-            - TT(:, LL - 1)) / (ZH(:, LL) - ZH(:, LL - 1)) * RD / H0
-    end DO
-    BVLOW = 0.5 * (TT(:, LTROP )+ TT(:, LAUNCH)) &
-         * RD**2 / RCPD / H0**2 + (TT(:, LTROP ) &
-         - TT(:, LAUNCH))/(ZH(:, LTROP )- ZH(:, LAUNCH)) * RD / H0
-
-    UH(:, 1) = UH(:, 2)
-    UH(:, KLEV + 1) = UH(:, KLEV)
-    BV(:, 1) = UH(:, 2)
-    BV(:, KLEV + 1) = UH(:, KLEV)
-    ! SMOOTHING THE BV HELPS
-    DO LL = 2, KLEV
-       BV(:, LL)=(UH(:, LL+1)+2.*UH(:, LL)+UH(:, LL-1))/4.
-    end DO
-
-    BV=MAX(SQRT(MAX(BV, 0.)), BVSEC)
-    BVLOW=MAX(SQRT(MAX(BVLOW, 0.)), BVSEC)
-
-    ! WINDS
-    DO LL = 2, KLEV
-       UH(:, LL) = 0.5 * (UU(:, LL) + UU(:, LL - 1)) ! Zonal wind
-       VH(:, LL) = 0.5 * (VV(:, LL) + VV(:, LL - 1)) ! Meridional wind
-       UZ(:, LL) = ABS((SQRT(UU(:, LL)**2+VV(:, LL)**2) & 
-          - SQRT(UU(:,LL-1)**2+VV(:, LL-1)**2)) &
-          /(ZH(:, LL)-ZH(:, LL-1)) )
-    end DO
-    UH(:, 1) = 0.
-    VH(:, 1) = 0.
-    UH(:, KLEV + 1) = UU(:, KLEV)
-    VH(:, KLEV + 1) = VV(:, KLEV)
-
-    UZ(:, 1) = UZ(:, 2)
-    UZ(:, KLEV + 1) = UZ(:, KLEV)
-    UZ(:, :) = MAX(UZ(:,:), PSEC)
-
-   ! BAROTROPIC VORTICITY AND INTEGRATED CORIOLIS PARAMETER
-    
-    CORIO(:) = MAX(ROMEGA*2.*ABS(SIN(PLAT(:)*RPI/180.)),CORSEC)
-    ROTBA(:)=0.
-    DO LL = 1,KLEV-1
-        !ROTBA(:) = ROTBA(:) + (ROT(:,LL)+ROT(:,LL+1))/2./RG*(PP(:,LL)-PP(:,LL+1))
-        ! Introducing the complete formula (exp of Richardson number):
-        ROTBA(:) = ROTBA(:) + &
-                !((ROT(:,LL)+ROT(:,LL+1))/2.)**2 &
-                (CORIO(:)*TANH(ABS(ROT(:,LL)+ROT(:,LL+1))/2./CORIO(:)))**2 &
-                /RG*(PP(:,LL)-PP(:,LL+1)) &
-                * EXP(-RPI*BV(:,LL+1)/UZ(:,LL+1)) &
-!               * DZ*BV(:,LL+1)/4./ABS(CORIO(:)) 
-                * DZ*BV(:,LL+1)/4./1.E-4           !  Changes after 1991
-!ARRET
-    ENDDO
-    !   PRINT *,'MAX ROTBA:',MAXVAL(ROTBA)
-    !   ROTBA(:)=(1.*ROTBA(:)  & ! Testing zone
-    !           +0.15*CORIO(:)**2                &
-    !           /(COS(PLAT(:)*RPI/180.)+0.02)  &
-    !           )*DZ*0.01/0.0001/4. ! & ! Testing zone
-    !   MODIF GWD4 AFTER 1985
-    !            *(1.25+SIN(PLAT(:)*RPI/180.))/(1.05+SIN(PLAT(:)*RPI/180.))/1.25
-    !          *1./(COS(PLAT(:)*RPI/180.)+0.02)
-    !    CORIO(:) = MAX(ROMEGA*2.*ABS(SIN(PLAT(:)*RPI/180.)),ZOISEC)/RG*PP(:,1)
-
-    ! 3 WAVES CHARACTERISTICS CHOSEN RANDOMLY AT THE LAUNCH ALTITUDE
-
-    ! The mod functions of weird arguments are used to produce the
-    ! waves characteristics in an almost stochastic way
-
-    JW = 0
-    DO JW = 1, NW
-             ! Angle
-             DO II = 1, KLON
-                ! Angle (0 or PI so far)
-                ! ZP(JW, II) = (SIGN(1., 0.5 - MOD(TT(II, JW) * 10., 1.)) + 1.) &
-                !      * RPI / 2.
-                ! Angle between 0 and pi
-                  ZP(JW, II) = MOD(TT(II, JW) * 10., 1.) * RPI
-! TEST WITH POSITIVE WAVES ONLY (Part I/II)
-!               ZP(JW, II) = 0.
-                ! Horizontal wavenumber amplitude
-                ZK(JW, II) = KMIN + (KMAX - KMIN) * MOD(TT(II, JW) * 100., 1.)
-                ! Horizontal phase speed
-                CPHA = 0.
-                DO JJ = 1, NA
-                    CPHA = CPHA + &
-         CMAX*2.*(MOD(TT(II, JW+4*(JJ-1)+JJ)**2, 1.)-0.5)*SQRT(3.)/SQRT(NA*1.)
-                END DO
-                IF (CPHA.LT.0.)  THEN
-                   CPHA = -1.*CPHA
-                   ZP(JW,II) = ZP(JW,II) + RPI
-! TEST WITH POSITIVE WAVES ONLY (Part II/II)
-!               ZP(JW, II) = 0.
-                ENDIF
-                CPHA = CPHA + CMIN !we dont allow |c|<1m/s
-                ! Absolute frequency is imposed
-                ZO(JW, II) = CPHA * ZK(JW, II) 
-                ! Intrinsic frequency is imposed
-                ZO(JW, II) = ZO(JW, II) &
-                     + ZK(JW, II) * COS(ZP(JW, II)) * UH(II, LAUNCH) &
-                     + ZK(JW, II) * SIN(ZP(JW, II)) * VH(II, LAUNCH)
-                ! Momentum flux at launch lev 
-                ! LAUNCHED RANDOM WAVES WITH LOG-NORMAL AMPLITUDE
-                !  RIGHT IN THE SH (GWD4 after 1990)
-                  RUW0(JW, II) = 0.
-                 DO JJ = 1, NA
-                    RUW0(JW, II) = RUW0(JW,II) + &
-         2.*(MOD(TT(II, JW+4*(JJ-1)+JJ)**2, 1.)-0.5)*SQRT(3.)/SQRT(NA*1.)
-                END DO
-                RUW0(JW, II) = RUWFRT &
-                          * EXP(RUW0(JW,II))/1250. &  ! 2 mpa at south pole
-       *((1.05+SIN(PLAT(II)*RPI/180.))/(1.01+SIN(PLAT(II)*RPI/180.))-2.05/2.01)
-                ! RUW0(JW, II) = RUWFRT
-             ENDDO
-    end DO
-
-    ! 4. COMPUTE THE FLUXES
-
-    ! 4.0 
-
-    ! 4.1 Vertical velocity at launching altitude to ensure 
-    ! the correct value to the imposed fluxes.
-
-    DO JW = 1, NW
-
-       ! Evaluate intrinsic frequency at launching altitude:
-       ZOP(JW, :) = ZO(JW, :) &
-            - ZK(JW, :) * COS(ZP(JW, :)) * UH(:, LAUNCH) &
-            - ZK(JW, :) * SIN(ZP(JW, :)) * VH(:, LAUNCH) 
-
-       ! VERSION WITH FRONTAL SOURCES
-
-       ! Momentum flux at launch level imposed by vorticity sources
-
-       ! tanh limitation for values above CORIO (inertial instability).
-       ! WWP(JW, :) = RUW0(JW, :) &
-       WWP(JW, :) = RUWFRT      &
-       !     * (CORIO(:)*TANH(ROTBA(:)/CORIO(:)))**2 &
-       !    * ABS((CORIO(:)*TANH(ROTBA(:)/CORIO(:)))*CORIO(:)) &
-       !  CONSTANT FLUX
-       !    * (CORIO(:)*CORIO(:)) &
-       ! MODERATION BY THE DEPTH OF THE SOURCE (DZ HERE)
-       !      *EXP(-BVLOW(:)**2/MAX(ABS(ZOP(JW, :)),ZOISEC)**2 &
-       !      *ZK(JW, :)**2*DZ**2) &
-       ! COMPLETE FORMULA:
-            !* CORIO(:)**2*TANH(ROTBA(:)/CORIO(:)**2) &
-            * ROTBA(:) &
-       !  RESTORE DIMENSION OF A FLUX
-       !     *RD*TR/PR
-       !     *1. + RUW0(JW, :)
-             *1.
-
-       ! Factor related to the characteristics of the waves: NONE
-
-       ! Moderation by the depth of the source (dz here): NONE
-
-       ! Put the stress in the right direction:
-
-        RUWP(JW, :) = SIGN(1., ZOP(JW, :))*COS(ZP(JW, :)) * WWP(JW, :)
-        RVWP(JW, :) = SIGN(1., ZOP(JW, :))*SIN(ZP(JW, :)) * WWP(JW, :)
-
-    end DO
-
-    ! 4.2 Uniform values below the launching altitude
-
-    DO LL = 1, LAUNCH
-       RUW(:, LL) = 0
-       RVW(:, LL) = 0
-       DO JW = 1, NW
-          RUW(:, LL) = RUW(:, LL) + RUWP(JW, :)
-          RVW(:, LL) = RVW(:, LL) + RVWP(JW, :)
-       end DO
-    end DO
-
-    ! 4.3 Loop over altitudes, with passage from one level to the next
-    ! done by i) conserving the EP flux, ii) dissipating a little,
-    ! iii) testing critical levels, and vi) testing the breaking.
-
-    DO LL = LAUNCH, KLEV - 1
-       ! Warning: all the physics is here (passage from one level
-       ! to the next)
-       DO JW = 1, NW
-          ZOM(JW, :) = ZOP(JW, :)
-          WWM(JW, :) = WWP(JW, :)
-          ! Intrinsic Frequency
-          ZOP(JW, :) = ZO(JW, :) - ZK(JW, :) * COS(ZP(JW, :)) * UH(:, LL + 1) &
-               - ZK(JW, :) * SIN(ZP(JW, :)) * VH(:, LL + 1) 
-
-          ! No breaking (Eq.6)
-          ! Dissipation (Eq. 8)
-          WWP(JW, :) = WWM(JW, :) * EXP(- 4. * RDISS * PR / (PH(:, LL + 1) &
-               + PH(:, LL)) * ((BV(:, LL + 1) + BV(:, LL)) / 2.)**3 &
-               / MAX(ABS(ZOP(JW, :) + ZOM(JW, :)) / 2., ZOISEC)**4 &
-               * ZK(JW, :)**3 * (ZH(:, LL + 1) - ZH(:, LL)))
-
-          ! Critical levels (forced to zero if intrinsic frequency changes sign)
-          ! Saturation (Eq. 12)
-          WWP(JW, :) = min(WWP(JW, :), MAX(0., &
-               SIGN(1., ZOP(JW, :) * ZOM(JW, :))) * ABS(ZOP(JW, :))**3 &
-          !    / BV(:, LL + 1) * EXP(- ZH(:, LL + 1) / H0) * SATFRT**2 * KMIN**2 &
-               / BV(:, LL + 1) * EXP(- ZH(:, LL + 1) / H0) * KMIN**2 &
-!              *(SATFRT*(2.5+1.5*TANH((ZH(:,LL+1)/H0-8.)/2.)))**2 &
-               *SATFRT**2       &
-               / ZK(JW, :)**4)
-       end DO
-
-       ! Evaluate EP-flux from Eq. 7 and give the right orientation to
-       ! the stress
-
-       DO JW = 1, NW
-          RUWP(JW, :) = SIGN(1., ZOP(JW, :))*COS(ZP(JW, :)) * WWP(JW, :)
-          RVWP(JW, :) = SIGN(1., ZOP(JW, :))*SIN(ZP(JW, :)) * WWP(JW, :)
-       end DO
-
-       RUW(:, LL + 1) = 0.
-       RVW(:, LL + 1) = 0.
-
-       DO JW = 1, NW
-          RUW(:, LL + 1) = RUW(:, LL + 1) + RUWP(JW, :) 
-          RVW(:, LL + 1) = RVW(:, LL + 1) + RVWP(JW, :) 
-          EAST_GWSTRESS(:, LL)=EAST_GWSTRESS(:, LL)+MAX(0.,RUWP(JW,:))/FLOAT(NW)
-          WEST_GWSTRESS(:, LL)=WEST_GWSTRESS(:, LL)+MIN(0.,RUWP(JW,:))/FLOAT(NW)
-       end DO
-    end DO
-
-    ! 5 CALCUL DES TENDANCES:
-
-    ! 5.1 Rectification des flux au sommet et dans les basses couches
-
-    RUW(:, KLEV + 1) = 0.
-    RVW(:, KLEV + 1) = 0.
-    RUW(:, 1) = RUW(:, LAUNCH)
-    RVW(:, 1) = RVW(:, LAUNCH)
-    DO LL = 1, LAUNCH
-       RUW(:, LL) = RUW(:, LAUNCH+1)
-       RVW(:, LL) = RVW(:, LAUNCH+1)
-       EAST_GWSTRESS(:, LL)=EAST_GWSTRESS(:, LAUNCH)
-       WEST_GWSTRESS(:, LL)=WEST_GWSTRESS(:, LAUNCH)
-    end DO
-
-    ! AR-1 RECURSIVE FORMULA (13) IN VERSION 4
-    DO LL = 1, KLEV
-       D_U(:, LL) = (1.-DTIME/DELTAT) * D_U(:, LL) + DTIME/DELTAT/REAL(NW) * &
-            RG * (RUW(:, LL + 1) - RUW(:, LL)) &
-            / (PH(:, LL + 1) - PH(:, LL)) * DTIME
-!  NO AR1 FOR MERIDIONAL TENDENCIES
-!      D_V(:, LL) = (1.-DTIME/DELTAT) * D_V(:, LL) + DTIME/DELTAT/REAL(NW) * &
-       D_V(:, LL) =                                            1./REAL(NW) * &
-            RG * (RVW(:, LL + 1) - RVW(:, LL)) &
-            / (PH(:, LL + 1) - PH(:, LL)) * DTIME
-    ENDDO
-
-    ! Cosmetic: evaluation of the cumulated stress
-    ZUSTR = 0.
-    ZVSTR = 0.
-    DO LL = 1, KLEV
-       ZUSTR = ZUSTR + D_U(:, LL) / RG * (PH(:, LL + 1) - PH(:, LL))/DTIME
-!      ZVSTR = ZVSTR + D_V(:, LL) / RG * (PH(:, LL + 1) - PH(:, LL))/DTIME
-    ENDDO
-! COSMETICS TO VISUALIZE ROTBA
-    ZVSTR = ROTBA
-
-  END SUBROUTINE ACAMA_GWD_RANDO
-
-end module ACAMA_GWD_rando_m
+link ../phylmd/acama_gwd_rando_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/aero_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/aero_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/aero_mod.F90	(revision 3940)
@@ -1,106 +1,1 @@
-! $Id$
-!
-MODULE aero_mod
-
-  IMPLICIT NONE
-
-! Declaration des indices pour les aerosols 
-
-! 1/ Total number of aerosols for which an aerosol optical depth is provided
-!--strat aerosols are only prescribed naero_tot = 10 ==> 11 
-!--adding nitrate naero_tot = 14 OB
-
-  INTEGER, PARAMETER :: naero_tot = 14
-
-! Identification number used in aeropt_2bands and aeropt_5wv
-! corresponding to naero_tot
-  INTEGER, PARAMETER :: id_ASBCM_phy    = 1
-  INTEGER, PARAMETER :: id_ASPOMM_phy   = 2
-  INTEGER, PARAMETER :: id_ASSO4M_phy   = 3
-  INTEGER, PARAMETER :: id_CSSO4M_phy   = 4
-  INTEGER, PARAMETER :: id_SSSSM_phy    = 5
-  INTEGER, PARAMETER :: id_CSSSM_phy    = 6
-  INTEGER, PARAMETER :: id_ASSSM_phy    = 7
-  INTEGER, PARAMETER :: id_CIDUSTM_phy  = 8
-  INTEGER, PARAMETER :: id_AIBCM_phy    = 9
-  INTEGER, PARAMETER :: id_AIPOMM_phy   = 10
-  INTEGER, PARAMETER :: id_ASNO3M_phy   = 11
-  INTEGER, PARAMETER :: id_CSNO3M_phy   = 12
-  INTEGER, PARAMETER :: id_CINO3M_phy   = 13
-  INTEGER, PARAMETER :: id_STRAT_phy    = 14
-
-! Corresponding names for the aerosols
-  CHARACTER(len=7),DIMENSION(naero_tot), PARAMETER :: name_aero_tau=(/&
-       "ASBCM  ", &
-       "ASPOMM ", &
-       "ASSO4M ", &
-       "CSSO4M ", &
-       "SSSSM  ", &
-       "CSSSM  ", &
-       "ASSSM  ", &
-       "CIDUSTM", &
-       "AIBCM  ", &
-       "AIPOMM ", &
-       "ASNO3M ", & 
-       "CSNO3M ", &
-       "CINO3M ", &
-       "STRAT  " /)
-
-! 2/ Total number of aerosols for which an aerosol mass is provided
-
-  INTEGER, PARAMETER :: naero_spc = 13
-
-! Corresponding names for the aerosols
-  CHARACTER(len=7),DIMENSION(naero_spc), PARAMETER :: name_aero=(/&
-       "ASBCM  ", &
-       "ASPOMM ", &
-       "SO4    ", &
-       "CSSO4M ", &
-       "SSSSM  ", &
-       "CSSSM  ", &
-       "ASSSM  ", &
-       "CIDUSTM", &
-       "AIBCM  ", &
-       "AIPOMM " ,&
-       "ASNO3M ", & 
-       "CSNO3M ", &
-       "CINO3M " /)
-
-! 3/ Number of aerosol groups
-  INTEGER, PARAMETER :: naero_grp = 13
-  ! if info_trac = inca
-  ! 1 = ZERO    
-  ! 2 = AER total    
-  ! 3 = NAT    
-  ! 4 = BC    
-  ! 5 = SO4    
-  ! 6 = POM    
-  ! 7 = DUST    
-  ! 8 = SS    
-  ! 9 = FNO3    
-  ! 10 = DNO3
-  ! 11 = SNO3
-  ! 12 = SOAA
-  ! 13 = SOAB 
-  ! else 
-  ! 1 = ZERO    
-  ! 2 = AER total    
-  ! 3 = NAT    
-  ! 4 = BC    
-  ! 5 = SO4    
-  ! 6 = POM    
-  ! 7 = DUST    
-  ! 8 = SS    
-  ! 9 = NO3    
-
-! Number of diagnostics wavelengths (5 SW + 1 LW @ 10 um)
-  INTEGER, PARAMETER :: nwave_sw = 5
-  INTEGER, PARAMETER :: nwave_lw = 1
-  INTEGER, PARAMETER :: nwave = nwave_sw + nwave_lw
-
-! Number of modes spectral bands
-  INTEGER, parameter :: nbands = 2
-  INTEGER, parameter :: nbands_sw_rrtm = 6
-  INTEGER, parameter :: nbands_lw_rrtm = 16
-
-END MODULE aero_mod
+link ../phylmd/aero_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/aeropt.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/aeropt.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/aeropt.F90	(revision 3940)
@@ -1,124 +1,1 @@
-
-! $Id: aeropt.F90 2346 2015-08-21 15:13:46Z emillour $
-
-SUBROUTINE aeropt(pplay, paprs, t_seri, msulfate, rhcl, tau_ae, piz_ae, &
-    cg_ae, ai)
-
-  USE dimphy
-  IMPLICIT NONE
-
-
-
-  include "YOMCST.h"
-
-  ! Arguments:
-
-  REAL, INTENT (IN) :: paprs(klon, klev+1)
-  REAL, INTENT (IN) :: pplay(klon, klev), t_seri(klon, klev)
-  REAL, INTENT (IN) :: msulfate(klon, klev) ! masse sulfate ug SO4/m3  [ug/m^3]
-  REAL, INTENT (IN) :: rhcl(klon, klev) ! humidite relative ciel clair
-  REAL, INTENT (OUT) :: tau_ae(klon, klev, 2) ! epaisseur optique aerosol
-  REAL, INTENT (OUT) :: piz_ae(klon, klev, 2) ! single scattering albedo aerosol
-  REAL, INTENT (OUT) :: cg_ae(klon, klev, 2) ! asymmetry parameter aerosol
-  REAL, INTENT (OUT) :: ai(klon) ! POLDER aerosol index
-
-  ! Local
-
-  INTEGER i, k, inu
-  INTEGER rh_num, nbre_rh
-  PARAMETER (nbre_rh=12)
-  REAL rh_tab(nbre_rh)
-  REAL rh_max, delta, rh
-  PARAMETER (rh_max=95.)
-  DATA rh_tab/0., 10., 20., 30., 40., 50., 60., 70., 80., 85., 90., 95./
-  REAL zrho, zdz
-  REAL taue670(klon) ! epaisseur optique aerosol absorption 550 nm
-  REAL taue865(klon) ! epaisseur optique aerosol extinction 865 nm
-  REAL alpha_aer_sulfate(nbre_rh, 5) !--unit m2/g SO4
-  REAL alphasulfate
-
-  CHARACTER (LEN=20) :: modname = 'aeropt'
-  CHARACTER (LEN=80) :: abort_message
-
-
-  ! Proprietes optiques
-
-  REAL alpha_aer(nbre_rh, 2) !--unit m2/g SO4
-  REAL cg_aer(nbre_rh, 2)
-  DATA alpha_aer/.500130E+01, .500130E+01, .500130E+01, .500130E+01, &
-    .500130E+01, .616710E+01, .826850E+01, .107687E+02, .136976E+02, &
-    .162972E+02, .211690E+02, .354833E+02, .139460E+01, .139460E+01, &
-    .139460E+01, .139460E+01, .139460E+01, .173910E+01, .244380E+01, &
-    .332320E+01, .440120E+01, .539570E+01, .734580E+01, .136038E+02/
-  DATA cg_aer/.619800E+00, .619800E+00, .619800E+00, .619800E+00, &
-    .619800E+00, .662700E+00, .682100E+00, .698500E+00, .712500E+00, &
-    .721800E+00, .734600E+00, .755800E+00, .545600E+00, .545600E+00, &
-    .545600E+00, .545600E+00, .545600E+00, .583700E+00, .607100E+00, &
-    .627700E+00, .645800E+00, .658400E+00, .676500E+00, .708500E+00/
-  DATA alpha_aer_sulfate/4.910, 4.910, 4.910, 4.910, 6.547, 7.373, 8.373, &
-    9.788, 12.167, 14.256, 17.924, 28.433, 1.453, 1.453, 1.453, 1.453, 2.003, &
-    2.321, 2.711, 3.282, 4.287, 5.210, 6.914, 12.305, 4.308, 4.308, 4.308, &
-    4.308, 5.753, 6.521, 7.449, 8.772, 11.014, 12.999, 16.518, 26.772, 3.265, &
-    3.265, 3.265, 3.265, 4.388, 5.016, 5.775, 6.868, 8.745, 10.429, 13.457, &
-    22.538, 2.116, 2.116, 2.116, 2.116, 2.882, 3.330, 3.876, 4.670, 6.059, &
-    7.327, 9.650, 16.883/
-
-  DO i = 1, klon
-    taue670(i) = 0.0
-    taue865(i) = 0.0
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (t_seri(i,k)==0) WRITE (*, *) 'aeropt T ', i, k, t_seri(i, k)
-      IF (pplay(i,k)==0) WRITE (*, *) 'aeropt p ', i, k, pplay(i, k)
-      zrho = pplay(i, k)/t_seri(i, k)/rd ! kg/m3
-      zdz = (paprs(i,k)-paprs(i,k+1))/zrho/rg ! m
-      rh = min(rhcl(i,k)*100., rh_max)
-      rh_num = int(rh/10.+1.)
-      IF (rh<0.) THEN
-        abort_message = 'aeropt: RH < 0 not possible'
-        CALL abort_physic(modname, abort_message, 1)
-      END IF
-      IF (rh>85.) rh_num = 10
-      IF (rh>90.) rh_num = 11
-      delta = (rh-rh_tab(rh_num))/(rh_tab(rh_num+1)-rh_tab(rh_num))
-
-      inu = 1
-      tau_ae(i, k, inu) = alpha_aer(rh_num, inu) + delta*(alpha_aer(rh_num+1, &
-        inu)-alpha_aer(rh_num,inu))
-      tau_ae(i, k, inu) = tau_ae(i, k, inu)*msulfate(i, k)*zdz*1.E-6
-      piz_ae(i, k, inu) = 1.0
-      cg_ae(i, k, inu) = cg_aer(rh_num, inu) + delta*(cg_aer(rh_num+1,inu)- &
-        cg_aer(rh_num,inu))
-
-      inu = 2
-      tau_ae(i, k, inu) = alpha_aer(rh_num, inu) + delta*(alpha_aer(rh_num+1, &
-        inu)-alpha_aer(rh_num,inu))
-      tau_ae(i, k, inu) = tau_ae(i, k, inu)*msulfate(i, k)*zdz*1.E-6
-      piz_ae(i, k, inu) = 1.0
-      cg_ae(i, k, inu) = cg_aer(rh_num, inu) + delta*(cg_aer(rh_num+1,inu)- &
-        cg_aer(rh_num,inu))
-      ! jq
-      ! jq for aerosol index
-
-      alphasulfate = alpha_aer_sulfate(rh_num, 4) + &
-        delta*(alpha_aer_sulfate(rh_num+1,4)-alpha_aer_sulfate(rh_num,4)) !--m2/g
-
-      taue670(i) = taue670(i) + alphasulfate*msulfate(i, k)*zdz*1.E-6
-
-      alphasulfate = alpha_aer_sulfate(rh_num, 5) + &
-        delta*(alpha_aer_sulfate(rh_num+1,5)-alpha_aer_sulfate(rh_num,5)) !--m2/g
-
-      taue865(i) = taue865(i) + alphasulfate*msulfate(i, k)*zdz*1.E-6
-
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ai(i) = (-log(max(taue670(i),0.0001)/max(taue865(i), &
-      0.0001))/log(670./865.))*taue865(i)
-  END DO
-
-  RETURN
-END SUBROUTINE aeropt
+link ../phylmd/aeropt.F90
Index: LMDZ6/trunk/libf/phylmdiso/aeropt_2bands.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/aeropt_2bands.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/aeropt_2bands.F90	(revision 3940)
@@ -1,1130 +1,1 @@
-!
-! $Id: aeropt_2bands.F90 2842 2017-04-01 16:09:13Z oboucher $
-!
-SUBROUTINE AEROPT_2BANDS( &
-     pdel, m_allaer, delt, RHcl, &
-     tau_allaer, piz_allaer, &
-     cg_allaer, m_allaer_pi, &
-     flag_aerosol, pplay, t_seri, presnivs)
-
-  USE dimphy
-  USE aero_mod
-  USE pres2lev_mod
-
-  !    Yves Balkanski le 12 avril 2006
-  !    Celine Deandreis
-  !    Anne Cozic Avril 2009
-  !    a partir d'une sous-routine de Johannes Quaas pour les sulfates
-  !
-  IMPLICIT NONE
-
-  INCLUDE "YOMCST.h"
-
-  !
-  ! Input arguments:
-  !
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: pdel
-  REAL,                           INTENT(in)  :: delt
-  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(in)  :: m_allaer
-  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(in)  :: m_allaer_pi
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: RHcl       ! humidite relative ciel clair
-  INTEGER,                        INTENT(in)  :: flag_aerosol
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: pplay
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: t_seri
-  REAL, DIMENSION(klev),          INTENT(in)  :: presnivs
-  !
-  ! Output arguments:
-  !
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: tau_allaer ! epaisseur optique aerosol
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: piz_allaer ! single scattering albedo aerosol
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: cg_allaer  ! asymmetry parameter aerosol
-
-  !
-  ! Local
-  !
-  REAL, DIMENSION(klon,klev,naero_tot,nbands) ::  tau_ae
-  REAL, DIMENSION(klon,klev,naero_tot,nbands) ::  tau_ae_pi
-  REAL, DIMENSION(klon,klev,naero_tot,nbands) ::  piz_ae
-  REAL, DIMENSION(klon,klev,naero_tot,nbands) ::  cg_ae
-  LOGICAL ::  soluble
-  INTEGER :: i, k,n, ierr, inu, m, mrfspecies
-  INTEGER :: spsol, spinsol, spss
-  INTEGER :: RH_num(klon,klev)
-  INTEGER, PARAMETER :: nb_level=19 ! number of vertical levels in DATA
-
-  INTEGER, PARAMETER :: nbre_RH=12
-  INTEGER, PARAMETER :: naero_soluble=7    ! 1- BC soluble; 2- POM soluble; 3- SO4. acc. 4- SO4 coarse
-                                           ! 5- seasalt super coarse  6- seasalt coarse   7- seasalt acc.
-  INTEGER, PARAMETER :: naero_insoluble=3  ! 1- Dust; 2- BC insoluble; 3- POM insoluble
-  LOGICAL, SAVE :: firstcall=.TRUE. 
-!$OMP THREADPRIVATE(firstcall)
-
-! Coefficient optiques sur 19 niveaux
-  REAL, SAVE, DIMENSION(nb_level) :: presnivs_19  ! Pression milieux couche pour 19 niveaux (nb_level)
-!$OMP THREADPRIVATE(presnivs_19)
-
-  REAL, SAVE, DIMENSION(nb_level) :: A1_ASSSM_b1_19, A2_ASSSM_b1_19, A3_ASSSM_b1_19,&
-          B1_ASSSM_b1_19, B2_ASSSM_b1_19, C1_ASSSM_b1_19, C2_ASSSM_b1_19,&
-          A1_CSSSM_b1_19, A2_CSSSM_b1_19, A3_CSSSM_b1_19,&
-          B1_CSSSM_b1_19, B2_CSSSM_b1_19, C1_CSSSM_b1_19, C2_CSSSM_b1_19,&
-          A1_SSSSM_b1_19, A2_SSSSM_b1_19, A3_SSSSM_b1_19,&
-          B1_SSSSM_b1_19, B2_SSSSM_b1_19, C1_SSSSM_b1_19, C2_SSSSM_b1_19,&
-          A1_ASSSM_b2_19, A2_ASSSM_b2_19, A3_ASSSM_b2_19,&
-          B1_ASSSM_b2_19, B2_ASSSM_b2_19, C1_ASSSM_b2_19, C2_ASSSM_b2_19,&
-          A1_CSSSM_b2_19, A2_CSSSM_b2_19, A3_CSSSM_b2_19,&
-          B1_CSSSM_b2_19, B2_CSSSM_b2_19, C1_CSSSM_b2_19, C2_CSSSM_b2_19,&
-          A1_SSSSM_b2_19, A2_SSSSM_b2_19, A3_SSSSM_b2_19,&
-          B1_SSSSM_b2_19, B2_SSSSM_b2_19, C1_SSSSM_b2_19, C2_SSSSM_b2_19
-!$OMP THREADPRIVATE(A1_ASSSM_b1_19, A2_ASSSM_b1_19, A3_ASSSM_b1_19)
-!$OMP THREADPRIVATE(B1_ASSSM_b1_19, B2_ASSSM_b1_19, C1_ASSSM_b1_19, C2_ASSSM_b1_19)
-!$OMP THREADPRIVATE(A1_CSSSM_b1_19, A2_CSSSM_b1_19, A3_CSSSM_b1_19)
-!$OMP THREADPRIVATE(B1_CSSSM_b1_19, B2_CSSSM_b1_19, C1_CSSSM_b1_19, C2_CSSSM_b1_19)
-!$OMP THREADPRIVATE(A1_SSSSM_b1_19, A2_SSSSM_b1_19, A3_SSSSM_b1_19)
-!$OMP THREADPRIVATE(B1_SSSSM_b1_19, B2_SSSSM_b1_19, C1_SSSSM_b1_19, C2_SSSSM_b1_19)
-!$OMP THREADPRIVATE(A1_ASSSM_b2_19, A2_ASSSM_b2_19, A3_ASSSM_b2_19)
-!$OMP THREADPRIVATE(B1_ASSSM_b2_19, B2_ASSSM_b2_19, C1_ASSSM_b2_19, C2_ASSSM_b2_19)
-!$OMP THREADPRIVATE(A1_CSSSM_b2_19, A2_CSSSM_b2_19, A3_CSSSM_b2_19)
-!$OMP THREADPRIVATE(B1_CSSSM_b2_19, B2_CSSSM_b2_19, C1_CSSSM_b2_19, C2_CSSSM_b2_19)
-!$OMP THREADPRIVATE(A1_SSSSM_b2_19, A2_SSSSM_b2_19, A3_SSSSM_b2_19)
-!$OMP THREADPRIVATE(B1_SSSSM_b2_19, B2_SSSSM_b2_19, C1_SSSSM_b2_19, C2_SSSSM_b2_19)
-
-
-! Coefficient optiques interpole sur le nombre de niveau du modele
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
-          A1_ASSSM_b1, A2_ASSSM_b1, A3_ASSSM_b1,&
-          B1_ASSSM_b1, B2_ASSSM_b1, C1_ASSSM_b1, C2_ASSSM_b1,&
-          A1_CSSSM_b1, A2_CSSSM_b1, A3_CSSSM_b1,&
-          B1_CSSSM_b1, B2_CSSSM_b1, C1_CSSSM_b1, C2_CSSSM_b1,&
-          A1_SSSSM_b1, A2_SSSSM_b1, A3_SSSSM_b1,&
-          B1_SSSSM_b1, B2_SSSSM_b1, C1_SSSSM_b1, C2_SSSSM_b1,&
-          A1_ASSSM_b2, A2_ASSSM_b2, A3_ASSSM_b2,&
-          B1_ASSSM_b2, B2_ASSSM_b2, C1_ASSSM_b2, C2_ASSSM_b2,&
-          A1_CSSSM_b2, A2_CSSSM_b2, A3_CSSSM_b2,&
-          B1_CSSSM_b2, B2_CSSSM_b2, C1_CSSSM_b2, C2_CSSSM_b2,&
-          A1_SSSSM_b2, A2_SSSSM_b2, A3_SSSSM_b2,&
-          B1_SSSSM_b2, B2_SSSSM_b2, C1_SSSSM_b2, C2_SSSSM_b2
-!$OMP THREADPRIVATE(A1_ASSSM_b1, A2_ASSSM_b1, A3_ASSSM_b1)
-!$OMP THREADPRIVATE(B1_ASSSM_b1, B2_ASSSM_b1, C1_ASSSM_b1, C2_ASSSM_b1)
-!$OMP THREADPRIVATE(A1_CSSSM_b1, A2_CSSSM_b1, A3_CSSSM_b1)
-!$OMP THREADPRIVATE(B1_CSSSM_b1, B2_CSSSM_b1, C1_CSSSM_b1, C2_CSSSM_b1)
-!$OMP THREADPRIVATE(A1_SSSSM_b1, A2_SSSSM_b1, A3_SSSSM_b1)
-!$OMP THREADPRIVATE(B1_SSSSM_b1, B2_SSSSM_b1, C1_SSSSM_b1, C2_SSSSM_b1)
-!$OMP THREADPRIVATE(A1_ASSSM_b2, A2_ASSSM_b2, A3_ASSSM_b2)
-!$OMP THREADPRIVATE(B1_ASSSM_b2, B2_ASSSM_b2, C1_ASSSM_b2, C2_ASSSM_b2)
-!$OMP THREADPRIVATE(A1_CSSSM_b2, A2_CSSSM_b2, A3_CSSSM_b2)
-!$OMP THREADPRIVATE(B1_CSSSM_b2, B2_CSSSM_b2, C1_CSSSM_b2, C2_CSSSM_b2)
-!$OMP THREADPRIVATE(A1_SSSSM_b2, A2_SSSSM_b2, A3_SSSSM_b2)
-!$OMP THREADPRIVATE(B1_SSSSM_b2, B2_SSSSM_b2, C1_SSSSM_b2, C2_SSSSM_b2)
-  
-  REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
-  REAL, PARAMETER :: RH_MAX=95.
-  REAL:: DELTA(klon,klev), rh(klon,klev), H
-  REAL:: tau_ae2b_int   ! Intermediate computation of epaisseur optique aerosol
-  REAL:: piz_ae2b_int   ! Intermediate computation of Single scattering albedo
-  REAL:: cg_ae2b_int    ! Intermediate computation of Assymetry parameter
-  REAL :: Fact_RH(nbre_RH)
-  REAL :: zrho
-  REAL :: fac
-  REAL :: zdh(klon,klev) 
-  INTEGER, ALLOCATABLE, DIMENSION(:)   :: aerosol_name
-  INTEGER :: nb_aer
-
-  !
-  ! Proprietes optiques
-  !
-  REAL:: alpha_aers_2bands(nbre_RH,nbands,naero_soluble)   !--unit m2/g SO4
-  REAL:: alpha_aeri_2bands(nbands,naero_insoluble)
-  REAL:: cg_aers_2bands(nbre_RH,nbands,naero_soluble)      !--unit 
-  REAL:: cg_aeri_2bands(nbands,naero_insoluble)
-  REAL:: piz_aers_2bands(nbre_RH,nbands,naero_soluble)     !-- unit
-  REAL:: piz_aeri_2bands(nbands,naero_insoluble)           !-- unit
-
-  INTEGER :: id
-  LOGICAL :: used_aer(naero_tot)
-  REAL :: tmp_var, tmp_var_pi
-
-  DATA presnivs_19/&
-       100426.5,  98327.6, 95346.5, 90966.8, 84776.9, &
-       76536.5,   66292.2, 54559.3, 42501.8, 31806, &
-       23787.5,   18252.7, 13996,   10320.8, 7191.1, &
-       4661.7,    2732.9,  1345.6,  388.2/  
-
-
-!***********************BAND 1***********************************
-!ACCUMULATION MODE
-  DATA A1_ASSSM_b1_19/ 4.373E+00,  4.361E+00,  4.331E+00, &
-                    4.278E+00,  4.223E+00,  4.162E+00, &
-                    4.103E+00,  4.035E+00,  3.962E+00, &
-                    3.904E+00,  3.871E+00,  3.847E+00, &
-                    3.824E+00,  3.780E+00,  3.646E+00, &
-                    3.448E+00,  3.179E+00,  2.855E+00,  2.630E+00/
-  DATA A2_ASSSM_b1_19/ 2.496E+00,  2.489E+00,  2.472E+00, &
-                    2.442E+00,  2.411E+00,  2.376E+00, &
-                    2.342E+00,  2.303E+00,  2.261E+00, &
-                    2.228E+00,  2.210E+00,  2.196E+00, &
-                    2.183E+00,  2.158E+00,  2.081E+00, &
-                    1.968E+00,  1.814E+00,  1.630E+00,  1.501E+00/
-  DATA A3_ASSSM_b1_19/-4.688E-02, -4.676E-02, -4.644E-02, &
-                   -4.587E-02, -4.528E-02, -4.463E-02, &
-                   -4.399E-02, -4.326E-02, -4.248E-02, &
-                   -4.186E-02, -4.151E-02, -4.125E-02, &
-                   -4.100E-02, -4.053E-02, -3.910E-02, &
-                   -3.697E-02, -3.408E-02, -3.061E-02, -2.819E-02/
-  DATA B1_ASSSM_b1_19/ 1.165E-08,  1.145E-08,  1.097E-08, &
-                    1.012E-08,  9.233E-09,  8.261E-09, &
-                    7.297E-09,  6.201E-09,  5.026E-09, &
-                    4.098E-09,  3.567E-09,  3.187E-09, &
-                    2.807E-09,  2.291E-09,  2.075E-09, &
-                    1.756E-09,  1.322E-09,  8.011E-10, 4.379E-10/
-  DATA B2_ASSSM_b1_19/ 2.193E-08,  2.192E-08,  2.187E-08, &
-                    2.179E-08,  2.171E-08,  2.162E-08, &
-                    2.153E-08,  2.143E-08,  2.132E-08, &
-                    2.124E-08,  2.119E-08,  2.115E-08, &
-                    2.112E-08,  2.106E-08,  2.100E-08, &
-                    2.090E-08,  2.077E-08,  2.061E-08,  2.049E-08/
-  DATA C1_ASSSM_b1_19/ 7.365E-01,  7.365E-01,  7.365E-01, &
-                    7.364E-01,  7.363E-01,  7.362E-01, &
-                    7.361E-01,  7.359E-01,  7.358E-01, &
-                    7.357E-01,  7.356E-01,  7.356E-01, &
-                    7.356E-01,  7.355E-01,  7.354E-01, &
-                    7.352E-01,  7.350E-01,  7.347E-01,  7.345E-01/
-  DATA C2_ASSSM_b1_19/ 5.833E-02,  5.835E-02,  5.841E-02, &
-                    5.850E-02,  5.859E-02,  5.870E-02, &
-                    5.880E-02,  5.891E-02,  5.904E-02, &
-                    5.914E-02,  5.920E-02,  5.924E-02, &
-                    5.928E-02,  5.934E-02,  5.944E-02, &
-                    5.959E-02,  5.979E-02,  6.003E-02,  6.020E-02/
-!COARSE MODE
-  DATA A1_CSSSM_b1_19/ 7.403E-01,  7.422E-01,  7.626E-01, &
-                    8.019E-01,  8.270E-01,  8.527E-01, &
-                    8.702E-01,  8.806E-01,  8.937E-01, &
-                    9.489E-01,  1.030E+00,  1.105E+00, &
-                    1.199E+00,  1.357E+00,  1.660E+00, &
-                    2.540E+00,  4.421E+00,  2.151E+00,  9.518E-01/
-  DATA A2_CSSSM_b1_19/ 4.522E-01,  4.532E-01,  4.644E-01, &
-                    4.859E-01,  4.996E-01,  5.137E-01, &
-                    5.233E-01,  5.290E-01,  5.361E-01, &
-                    5.655E-01,  6.085E-01,  6.483E-01, &
-                    6.979E-01,  7.819E-01,  9.488E-01, &
-                    1.450E+00,  2.523E+00,  1.228E+00,  5.433E-01/
-  DATA A3_CSSSM_b1_19/-8.516E-03, -8.535E-03, -8.744E-03, &
-                   -9.148E-03, -9.406E-03, -9.668E-03, &
-                   -9.848E-03, -9.955E-03, -1.009E-02, &
-                   -1.064E-02, -1.145E-02, -1.219E-02, &
-                   -1.312E-02, -1.470E-02, -1.783E-02, &
-                   -2.724E-02, -4.740E-02, -2.306E-02, -1.021E-02/
-  DATA B1_CSSSM_b1_19/ 2.535E-07,  2.530E-07,  2.479E-07, &
-                    2.380E-07,  2.317E-07,  2.252E-07, &
-                    2.208E-07,  2.182E-07,  2.149E-07, &
-                    2.051E-07,  1.912E-07,  1.784E-07, &
-                    1.624E-07,  1.353E-07,  1.012E-07, &
-                    6.016E-08,  2.102E-08,  0.000E+00,  0.000E+00/
-  DATA B2_CSSSM_b1_19/ 1.221E-07,  1.217E-07,  1.179E-07, &
-                    1.104E-07,  1.056E-07,  1.008E-07, &
-                    9.744E-08,  9.546E-08,  9.299E-08, &
-                    8.807E-08,  8.150E-08,  7.544E-08, &
-                    6.786E-08,  5.504E-08,  4.080E-08, &
-                    2.960E-08,  2.300E-08,  2.030E-08,  1.997E-08/
-  DATA C1_CSSSM_b1_19/ 7.659E-01,  7.658E-01,  7.652E-01, &
-                    7.639E-01,  7.631E-01,  7.623E-01, &
-                    7.618E-01,  7.614E-01,  7.610E-01, &
-                    7.598E-01,  7.581E-01,  7.566E-01, &
-                    7.546E-01,  7.513E-01,  7.472E-01, &
-                    7.423E-01,  7.376E-01,  7.342E-01,  7.334E-01/
-  DATA C2_CSSSM_b1_19/ 3.691E-02,  3.694E-02,  3.729E-02, &
-                    3.796E-02,  3.839E-02,  3.883E-02, &
-                    3.913E-02,  3.931E-02,  3.953E-02, &
-                    4.035E-02,  4.153E-02,  4.263E-02, &
-                    4.400E-02,  4.631E-02,  4.933E-02, &
-                    5.331E-02,  5.734E-02,  6.053E-02,  6.128E-02/
-!SUPER COARSE MODE
-  DATA A1_SSSSM_b1_19/ 2.836E-01,  2.876E-01,  2.563E-01, &
-                    2.414E-01,  2.541E-01,  2.546E-01, &
-                    2.572E-01,  2.638E-01,  2.781E-01, &
-                    3.167E-01,  4.209E-01,  5.286E-01, &
-                    6.959E-01,  9.233E-01,  1.282E+00, &
-                    1.836E+00,  2.981E+00,  4.355E+00,  4.059E+00/
-  DATA A2_SSSSM_b1_19/ 1.608E-01,  1.651E-01,  1.577E-01, &
-                    1.587E-01,  1.686E-01,  1.690E-01, &
-                    1.711E-01,  1.762E-01,  1.874E-01, &
-                    2.138E-01,  2.751E-01,  3.363E-01, &
-                    4.279E-01,  5.519E-01,  7.421E-01, &
-                    1.048E+00,  1.702E+00,  2.485E+00,  2.317E+00/
-  DATA A3_SSSSM_b1_19/-3.025E-03, -3.111E-03, -2.981E-03, &
-                   -3.005E-03, -3.193E-03, -3.200E-03, &
-                   -3.239E-03, -3.336E-03, -3.548E-03, &
-                   -4.047E-03, -5.196E-03, -6.345E-03, &
-                   -8.061E-03, -1.038E-02, -1.395E-02, &
-                   -1.970E-02, -3.197E-02, -4.669E-02, -4.352E-02/
-  DATA B1_SSSSM_b1_19/ 6.759E-07,  6.246E-07,  5.542E-07, &
-                    4.953E-07,  4.746E-07,  4.738E-07, &
-                    4.695E-07,  4.588E-07,  4.354E-07, &
-                    3.947E-07,  3.461E-07,  3.067E-07, &
-                    2.646E-07,  2.095E-07,  1.481E-07, &
-                    9.024E-08,  5.747E-08,  2.384E-08,  6.599E-09/
-  DATA B2_SSSSM_b1_19/ 5.977E-07,  5.390E-07,  4.468E-07, &
-                    3.696E-07,  3.443E-07,  3.433E-07, &
-                    3.380E-07,  3.249E-07,  2.962E-07, &
-                    2.483E-07,  1.989E-07,  1.623E-07, &
-                    1.305E-07,  9.015E-08,  6.111E-08, &
-                    3.761E-08,  2.903E-08,  2.337E-08,  2.147E-08/
-  DATA C1_SSSSM_b1_19/ 8.120E-01,  8.084E-01,  8.016E-01, &
-                    7.953E-01,  7.929E-01,  7.928E-01, &
-                    7.923E-01,  7.910E-01,  7.882E-01, &
-                    7.834E-01,  7.774E-01,  7.725E-01, &
-                    7.673E-01,  7.604E-01,  7.529E-01, &
-                    7.458E-01,  7.419E-01,  7.379E-01,  7.360E-01/
-  DATA C2_SSSSM_b1_19/ 2.388E-02,  2.392E-02,  2.457E-02,  2.552E-02, &
-                    2.615E-02,  2.618E-02,  2.631E-02,  2.663E-02, &
-                    2.735E-02,  2.875E-02,  3.113E-02,  3.330E-02, &
-                    3.615E-02,  3.997E-02,  4.521E-02,  5.038E-02, &
-                    5.358E-02,  5.705E-02,  5.887E-02/
-!*********************BAND 2************************************************
-!ACCUMULATION MODE
-  DATA A1_ASSSM_b2_19/1.256E+00, 1.246E+00, 1.226E+00, 1.187E+00, 1.148E+00, &
-                   1.105E+00, 1.062E+00, 1.014E+00, 9.616E-01, 9.205E-01, &
-                   8.970E-01, 8.800E-01, 8.632E-01, 8.371E-01, 7.943E-01, &
-                   7.308E-01, 6.448E-01, 5.414E-01, 4.693E-01/
-  DATA A2_ASSSM_b2_19/5.321E-01, 5.284E-01, 5.196E-01, 5.036E-01, 4.872E-01, &
-                   4.691E-01, 4.512E-01, 4.308E-01, 4.089E-01, 3.917E-01, &
-                   3.818E-01, 3.747E-01, 3.676E-01, 3.567E-01, 3.385E-01, &
-                   3.116E-01, 2.751E-01, 2.312E-01, 2.006E-01/
-  DATA A3_ASSSM_b2_19/-1.053E-02, -1.046E-02, -1.028E-02, -9.964E-03, -9.637E-03, &
-                   -9.279E-03, -8.923E-03, -8.518E-03, -8.084E-03, -7.741E-03, &
-                   -7.545E-03, -7.405E-03, -7.265E-03, -7.048E-03, -6.687E-03, &
-                   -6.156E-03, -5.433E-03, -4.565E-03, -3.961E-03/
-  DATA B1_ASSSM_b2_19/1.560E-02, 1.560E-02, 1.561E-02, 1.565E-02, 1.568E-02, &
-                   1.572E-02, 1.576E-02, 1.580E-02, 1.584E-02, 1.588E-02, &
-                   1.590E-02, 1.592E-02, 1.593E-02, 1.595E-02, 1.599E-02, &
-                   1.605E-02, 1.612E-02, 1.621E-02, 1.627E-02/
-  DATA B2_ASSSM_b2_19/1.073E-02, 1.074E-02, 1.076E-02, 1.079E-02, 1.082E-02, &
-                   1.085E-02, 1.089E-02, 1.093E-02, 1.097E-02, 1.100E-02, &
-                   1.102E-02, 1.103E-02, 1.105E-02, 1.107E-02, 1.110E-02, &
-                   1.115E-02, 1.122E-02, 1.130E-02, 1.136E-02/
-  DATA C1_ASSSM_b2_19/7.429E-01, 7.429E-01, 7.429E-01, 7.427E-01, 7.427E-01, &
-                   7.424E-01, 7.423E-01, 7.422E-01, 7.421E-01, 7.420E-01, &
-                   7.419E-01, 7.419E-01, 7.418E-01, 7.417E-01, 7.416E-01, &
-                   7.415E-01, 7.413E-01, 7.409E-01, 7.408E-01/
-  DATA C2_ASSSM_b2_19/3.031E-02, 3.028E-02, 3.022E-02, 3.011E-02, 2.999E-02, &
-                   2.986E-02, 2.973E-02, 2.959E-02, 2.943E-02, 2.931E-02, &
-                   2.924E-02, 2.919E-02, 2.913E-02, 2.905E-02, 2.893E-02, &
-                   2.874E-02, 2.847E-02, 2.817E-02, 2.795E-02/
-!COARSE MODE
-  DATA A1_CSSSM_b2_19/7.061E-01, 7.074E-01, 7.211E-01, 7.476E-01, 7.647E-01, &
-                   7.817E-01, 7.937E-01, 8.007E-01, 8.095E-01, 8.436E-01, &
-                   8.932E-01, 9.390E-01, 9.963E-01, 1.093E+00, 1.256E+00, &
-                   1.668E+00, 1.581E+00, 3.457E-01, 1.331E-01/
-  DATA A2_CSSSM_b2_19/3.617E-01, 3.621E-01, 3.662E-01, 3.739E-01, 3.789E-01, &
-                   3.840E-01, 3.874E-01, 3.895E-01, 3.921E-01, 4.001E-01, &
-                   4.117E-01, 4.223E-01, 4.356E-01, 4.581E-01, 5.099E-01, &
-                   6.831E-01, 6.663E-01, 1.481E-01, 5.703E-02/
-  DATA A3_CSSSM_b2_19/-6.953E-03, -6.961E-03, -7.048E-03, -7.216E-03, -7.322E-03, &
-                   -7.431E-03, -7.506E-03, -7.551E-03, -7.606E-03, -7.791E-03, &
-                   -8.059E-03, -8.305E-03, -8.613E-03, -9.134E-03, -1.023E-02, &
-                   -1.365E-02, -1.320E-02, -2.922E-03, -1.125E-03/
-  DATA B1_CSSSM_b2_19/1.007E-02, 1.008E-02, 1.012E-02, 1.019E-02, 1.024E-02, &
-                   1.029E-02, 1.033E-02, 1.035E-02, 1.038E-02, 1.056E-02, &
-                   1.083E-02, 1.109E-02, 1.140E-02, 1.194E-02, 1.270E-02, &
-                   1.390E-02, 1.524E-02, 1.639E-02, 1.667E-02/
-  DATA B2_CSSSM_b2_19/4.675E-03, 4.682E-03, 4.760E-03, 4.908E-03, 5.004E-03, &
-                   5.102E-03, 5.168E-03, 5.207E-03, 5.256E-03, 5.474E-03, &
-                   5.793E-03, 6.089E-03, 6.457E-03, 7.081E-03, 7.923E-03, &
-                   9.127E-03, 1.041E-02, 1.147E-02, 1.173E-02/
-  DATA C1_CSSSM_b2_19/7.571E-01, 7.571E-01, 7.570E-01, 7.568E-01, 7.565E-01, &
-                   7.564E-01, 7.563E-01, 7.562E-01, 7.562E-01, 7.557E-01, &
-                   7.552E-01, 7.545E-01, 7.539E-01, 7.527E-01, 7.509E-01, &
-                   7.478E-01, 7.440E-01, 7.404E-01, 7.394E-01/
-  DATA C2_CSSSM_b2_19/4.464E-02, 4.465E-02, 4.468E-02, 4.474E-02, 4.477E-02, &
-                   4.480E-02, 4.482E-02, 4.484E-02, 4.486E-02, 4.448E-02, &
-                   4.389E-02, 4.334E-02, 4.264E-02, 4.148E-02, 3.957E-02, &
-                   3.588E-02, 3.149E-02, 2.751E-02, 2.650E-02/
-!SUPER COARSE MODE
-  DATA A1_SSSSM_b2_19/2.357E-01, 2.490E-01, 2.666E-01, 2.920E-01, 3.120E-01, &
-                   3.128E-01, 3.169E-01, 3.272E-01, 3.498E-01, 3.960E-01, &
-                   4.822E-01, 5.634E-01, 6.763E-01, 8.278E-01, 1.047E+00, &
-                   1.340E+00, 1.927E+00, 1.648E+00, 1.031E+00/
-  DATA A2_SSSSM_b2_19/1.219E-01, 1.337E-01, 1.633E-01, 1.929E-01, 2.057E-01, &
-                   2.062E-01, 2.089E-01, 2.155E-01, 2.300E-01, 2.560E-01, &
-                   2.908E-01, 3.199E-01, 3.530E-01, 3.965E-01, 4.475E-01, &
-                   5.443E-01, 7.943E-01, 6.928E-01, 4.381E-01/
-  DATA A3_SSSSM_b2_19/-2.387E-03, -2.599E-03, -3.092E-03, -3.599E-03, -3.832E-03, &
-                   -3.842E-03, -3.890E-03, -4.012E-03, -4.276E-03, -4.763E-03, &
-                   -5.455E-03, -6.051E-03, -6.763E-03, -7.708E-03, -8.887E-03, &
-                   -1.091E-02, -1.585E-02, -1.373E-02, -8.665E-03/
-  DATA B1_SSSSM_b2_19/1.260E-02, 1.211E-02, 1.126E-02, 1.056E-02, 1.038E-02, &
-                   1.037E-02, 1.033E-02, 1.023E-02, 1.002E-02, 9.717E-03, &
-                   9.613E-03, 9.652E-03, 9.983E-03, 1.047E-02, 1.168E-02, &
-                   1.301E-02, 1.399E-02, 1.514E-02, 1.578E-02/
-  DATA B2_SSSSM_b2_19/2.336E-03, 2.419E-03, 2.506E-03, 2.610E-03, 2.690E-03, &
-                   2.694E-03, 2.711E-03, 2.752E-03, 2.844E-03, 3.043E-03, &
-                   3.455E-03, 3.871E-03, 4.507E-03, 5.373E-03, 6.786E-03, &
-                   8.238E-03, 9.208E-03, 1.032E-02, 1.091E-02/
-  DATA C1_SSSSM_b2_19/7.832E-01, 7.787E-01, 7.721E-01, 7.670E-01, 7.657E-01, &
-                   7.657E-01, 7.654E-01, 7.648E-01, 7.634E-01, 7.613E-01, &
-                   7.596E-01, 7.585E-01, 7.574E-01, 7.560E-01, 7.533E-01, &
-                   7.502E-01, 7.476E-01, 7.443E-01, 7.423E-01/
-  DATA C2_SSSSM_b2_19/3.144E-02, 3.268E-02, 3.515E-02, 3.748E-02, 3.837E-02, &
-                   3.840E-02, 3.860E-02, 3.906E-02, 4.006E-02, 4.173E-02, &
-                   4.338E-02, 4.435E-02, 4.459E-02, 4.467E-02, 4.202E-02, &
-                   3.864E-02, 3.559E-02, 3.183E-02, 2.964E-02/
-!***************************************************************************
-
-  spsol = 0
-  spinsol = 0 
-  spss = 0 
-
-  DATA alpha_aers_2bands/  & 
-       ! bc soluble
-       7.675,7.675,7.675,7.675,7.675,7.675,    &
-       7.675,7.675,10.433,11.984,13.767,15.567,& 
-       4.720,4.720,4.720,4.720,4.720,4.720,    & 
-       4.720,4.720,6.081,6.793,7.567,9.344,    & 
-       ! pom soluble
-       5.503,5.503,5.503,5.503,5.588,5.957,    & 
-       6.404,7.340,8.545,10.319,13.595,20.398, & 
-       1.402,1.402,1.402,1.402,1.431,1.562,    & 
-       1.715,2.032,2.425,2.991,4.193,7.133,    & 
-       ! sulfate    
-       4.681,5.062,5.460,5.798,6.224,6.733,    & 
-       7.556,8.613,10.687,12.265,16.32,21.692, & 
-       1.107,1.239,1.381,1.490,1.635,1.8030,   &
-       2.071,2.407,3.126,3.940,5.539,7.921,    &
-                                ! sulfate coarse
-       4.681,5.062,5.460,5.798,6.224,6.733,    & 
-       7.556,8.613,10.687,12.265,16.32,21.692, & 
-       1.107,1.239,1.381,1.490,1.635,1.8030,   &
-       2.071,2.407,3.126,3.940,5.539,7.921,    &
-                                ! seasalt Super Coarse Soluble (SS)
-       0.5090,0.6554,0.7129,0.7767,0.8529,1.2728, &
-       1.3820,1.5792,1.9173,2.2002,2.7173,4.1487, &
-       0.5167,0.6613,0.7221,0.7868,0.8622,1.3027, &
-       1.4227,1.6317,1.9887,2.2883,2.8356,4.3453, &
-                                ! seasalt  Coarse Soluble (CS)
-       0.5090,0.6554,0.7129,0.7767,0.8529,1.2728, &
-       1.3820,1.5792,1.9173,2.2002,2.7173,4.1487, &
-       0.5167,0.6613,0.7221,0.7868,0.8622,1.3027, &
-       1.4227,1.6317,1.9887,2.2883,2.8356,4.3453, &
-                                ! seasalt  Accumulation Soluble (AS)
-       4.125, 4.674, 5.005, 5.434, 5.985, 10.006, &
-       11.175,13.376,17.264,20.540,26.604, 42.349,&
-       4.187, 3.939, 3.919, 3.937, 3.995,  5.078, &
-       5.511, 6.434, 8.317,10.152,14.024, 26.537/
-
-  DATA alpha_aeri_2bands/  & 
-       ! dust insoluble
-       0.7661,0.7123,&
-       ! bc insoluble
-       10.360,4.437, &
-       ! pom insoluble
-       3.741,0.606/
-
-  DATA cg_aers_2bands/ &
-       ! bc soluble
-       .612, .612, .612, .612, .612, .612, &
-       .612, .612, .702, .734, .760, .796, &
-       .433, .433, .433, .433, .433, .433, &
-       .433, .433, .534, .575, .613, .669, &
-       ! pom soluble
-       .663, .663, .663, .663, .666, .674, &
-       .685, .702, .718, .737, .757, .777, &
-       .544, .544, .544, .544, .547, .554, &
-       .565, .583, .604, .631, .661, .698, &
-       ! sulfate    
-       .658, .669, .680, .688, .698, .707, &
-       .719, .733, .752, .760, .773, .786, &
-       .544, .555, .565, .573, .583, .593, &
-       .610, .628, .655, .666, .692, .719, &
-                                ! sulfate coarse
-       .658, .669, .680, .688, .698, .707, &
-       .719, .733, .752, .760, .773, .786, &
-       .544, .555, .565, .573, .583, .593, &
-       .610, .628, .655, .666, .692, .719, &
-                                ! seasalt Super Coarse soluble (SS)
-       .727, .747, .755, .761, .770, .788, &
-       .792, .799, .805, .809, .815, .826, &
-       .717, .738, .745, .752, .761, .779, &
-       .781, .786, .793, .797, .803, .813, &
-                                ! seasalt Coarse soluble (CS)
-       .727, .747, .755, .761, .770, .788, &
-       .792, .799, .805, .809, .815, .826, &
-       .717, .738, .745, .752, .761, .779, &
-       .781, .786, .793, .797, .803, .813, &
-                                ! Sesalt Accumulation Soluble (AS)
-       .727, .741, .748, .754, .761, .782, &
-       .787, .792, .797, .799, .801, .799, &
-       .606, .645, .658, .669, .681, .726, &
-       .734, .746, .761, .770, .782, .798/
-
-  DATA cg_aeri_2bands/ &
-       ! dust insoluble
-       .701, .670, &
-       ! bc insoluble
-       .471, .297, &
-       ! pom insoluble
-       .568, .365/
-
-  DATA piz_aers_2bands/&
-       ! bc soluble
-       .445, .445, .445, .445, .445, .445, &
-       .445, .445, .461, .480, .505, .528, &
-       .362, .362, .362, .362, .362, .362, &
-       .362, .362, .381, .405, .437, .483, &
-       ! pom soluble
-       .972, .972, .972, .972, .972, .974, &
-       .976, .979, .982, .986, .989, .992, &
-       .924, .924, .924, .924, .925, .927, &
-       .932, .938, .945, .952, .961, .970, &
-       ! sulfate
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       .992, .988, .988, .987, .986, .985,  &
-       .985, .985, .984, .984, .984, .984,  &
-                                ! sulfate coarse
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       .992, .988, .988, .987, .986, .985,  &
-       .985, .985, .984, .984, .984, .984,  &
-                                ! seasalt Super Coarse Soluble (SS)
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       0.992,0.989,0.987,0.986,0.986,0.980, &
-       0.980,0.978,0.976,0.976,0.974,0.971, &
-                                ! seasalt Coarse soluble (CS)
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       1.000,1.000,1.000,1.000,1.000,1.000, &
-       0.992,0.989,0.987,0.986,0.986,0.980, &
-       0.980,0.978,0.976,0.976,0.974,0.971, &
-                                ! seasalt Accumulation Soluble (AS)
-       1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
-       1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
-       0.970, 0.975, 0.976, 0.977, 0.978, 0.982, &
-       0.982, 0.983, 0.984, 0.984, 0.985, 0.985/
-
-  DATA piz_aeri_2bands/ &
-       ! dust insoluble
-       .963, .987, &
-       ! bc insoluble
-       .395, .264, &
-       ! pom insoluble
-       .966, .859/
-
-! Interpolation des coefficients optiques de 19 niveaux vers le nombre des niveaux du model
-  IF (firstcall) THEN
-     firstcall=.FALSE.
-     
-     IF (.NOT. ALLOCATED(A1_ASSSM_b1)) THEN
-        ALLOCATE(A1_ASSSM_b1(klev),A2_ASSSM_b1(klev), A3_ASSSM_b1(klev),&
-          B1_ASSSM_b1(klev), B2_ASSSM_b1(klev), C1_ASSSM_b1(klev), C2_ASSSM_b1(klev),&
-          A1_CSSSM_b1(klev), A2_CSSSM_b1(klev), A3_CSSSM_b1(klev),&
-          B1_CSSSM_b1(klev), B2_CSSSM_b1(klev), C1_CSSSM_b1(klev), C2_CSSSM_b1(klev),&
-          A1_SSSSM_b1(klev), A2_SSSSM_b1(klev), A3_SSSSM_b1(klev),&
-          B1_SSSSM_b1(klev), B2_SSSSM_b1(klev), C1_SSSSM_b1(klev), C2_SSSSM_b1(klev),&
-          A1_ASSSM_b2(klev), A2_ASSSM_b2(klev), A3_ASSSM_b2(klev),&
-          B1_ASSSM_b2(klev), B2_ASSSM_b2(klev), C1_ASSSM_b2(klev), C2_ASSSM_b2(klev),&
-          A1_CSSSM_b2(klev), A2_CSSSM_b2(klev), A3_CSSSM_b2(klev),&
-          B1_CSSSM_b2(klev), B2_CSSSM_b2(klev), C1_CSSSM_b2(klev), C2_CSSSM_b2(klev),&
-          A1_SSSSM_b2(klev), A2_SSSSM_b2(klev), A3_SSSSM_b2(klev),&
-          B1_SSSSM_b2(klev), B2_SSSSM_b2(klev), C1_SSSSM_b2(klev), C2_SSSSM_b2(klev), stat=ierr)
-        IF (ierr /= 0) CALL abort_physic('aeropt_2bands', 'pb in allocation 1',1)
-     END IF
-     
-! bande 1
-     CALL pres2lev(A1_ASSSM_b1_19, A1_ASSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_ASSSM_b1_19, A2_ASSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_ASSSM_b1_19, A3_ASSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_ASSSM_b1_19, B1_ASSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_ASSSM_b1_19, B2_ASSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_ASSSM_b1_19, C1_ASSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_ASSSM_b1_19, C2_ASSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-
-     CALL pres2lev(A1_CSSSM_b1_19, A1_CSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_CSSSM_b1_19, A2_CSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_CSSSM_b1_19, A3_CSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_CSSSM_b1_19, B1_CSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_CSSSM_b1_19, B2_CSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_CSSSM_b1_19, C1_CSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_CSSSM_b1_19, C2_CSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-
-     CALL pres2lev(A1_SSSSM_b1_19, A1_SSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_SSSSM_b1_19, A2_SSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_SSSSM_b1_19, A3_SSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_SSSSM_b1_19, B1_SSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_SSSSM_b1_19, B2_SSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_SSSSM_b1_19, C1_SSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_SSSSM_b1_19, C2_SSSSM_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-
-! bande 2
-     CALL pres2lev(A1_ASSSM_b2_19, A1_ASSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_ASSSM_b2_19, A2_ASSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_ASSSM_b2_19, A3_ASSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_ASSSM_b2_19, B1_ASSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_ASSSM_b2_19, B2_ASSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_ASSSM_b2_19, C1_ASSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_ASSSM_b2_19, C2_ASSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-
-     CALL pres2lev(A1_CSSSM_b2_19, A1_CSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_CSSSM_b2_19, A2_CSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_CSSSM_b2_19, A3_CSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_CSSSM_b2_19, B1_CSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_CSSSM_b2_19, B2_CSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_CSSSM_b2_19, C1_CSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_CSSSM_b2_19, C2_CSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-
-     CALL pres2lev(A1_SSSSM_b2_19, A1_SSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_SSSSM_b2_19, A2_SSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_SSSSM_b2_19, A3_SSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_SSSSM_b2_19, B1_SSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_SSSSM_b2_19, B2_SSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_SSSSM_b2_19, C1_SSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_SSSSM_b2_19, C2_SSSSM_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-
-  END IF ! firstcall
-
-  DO k=1, klev
-    DO i=1, klon
-      zrho=pplay(i,k)/t_seri(i,k)/RD    ! kg/m3
-      zdh(i,k)=pdel(i,k)/(RG*zrho)      ! m
-    ENDDO
-  ENDDO
-
-  IF (flag_aerosol .EQ. 1) THEN 
-     nb_aer = 2
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASSO4M_phy
-     aerosol_name(2) = id_CSSO4M_phy
-  ELSEIF (flag_aerosol .EQ. 2) THEN
-     nb_aer = 2
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASBCM_phy
-     aerosol_name(2) = id_AIBCM_phy
-  ELSEIF (flag_aerosol .EQ. 3) THEN 
-     nb_aer = 2
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASPOMM_phy
-     aerosol_name(2) = id_AIPOMM_phy
-  ELSEIF (flag_aerosol .EQ. 4) THEN 
-     nb_aer = 3
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_CSSSM_phy
-     aerosol_name(2) = id_SSSSM_phy
-     aerosol_name(3) = id_ASSSM_phy
-  ELSEIF (flag_aerosol .EQ. 5) THEN 
-     nb_aer = 1
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_CIDUSTM_phy
-  ELSEIF (flag_aerosol .EQ. 6) THEN 
-     nb_aer = 10
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASSO4M_phy
-     aerosol_name(2) = id_ASBCM_phy
-     aerosol_name(3) = id_AIBCM_phy
-     aerosol_name(4) = id_ASPOMM_phy
-     aerosol_name(5) = id_AIPOMM_phy
-     aerosol_name(6) = id_CSSSM_phy
-     aerosol_name(7) = id_SSSSM_phy
-     aerosol_name(8) = id_ASSSM_phy
-     aerosol_name(9) = id_CIDUSTM_phy
-     aerosol_name(10)= id_CSSO4M_phy
-  ENDIF
-
-
-  !
-  ! loop over modes, use of precalculated nmd and corresponding sigma
-  !    loop over wavelengths
-  !    for each mass species in mode
-  !      interpolate from Sext to retrieve Sext_at_gridpoint_per_species
-  !      compute optical_thickness_at_gridpoint_per_species
-
-!CDIR ON_ADB(fact_RH)
-!CDIR SHORTLOOP
-  DO n=1,nbre_RH-1
-    fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
-  ENDDO
-   
-  DO k=1, KLEV
-!CDIR ON_ADB(fact_RH)
-    DO i=1, KLON
-      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
-      RH_num(i,k) = INT( rh(i,k)/10. + 1.)
-      IF (rh(i,k).GT.85.) RH_num(i,k)=10
-      IF (rh(i,k).GT.90.) RH_num(i,k)=11
-      DELTA(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
-    ENDDO
-  ENDDO
-
-  used_aer(:)=.FALSE.
-    
-  DO m=1,nb_aer   ! tau is only computed for each mass
-    fac=1.0
-     IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN
-         soluble=.TRUE.
-         spsol=1
-         spss=0
-     ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 
-        soluble=.TRUE.
-        spsol=2 
-        spss=0
-     ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN 
-        soluble=.TRUE.
-        spsol=3
-        spss=0
-        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
-     ELSEIF  (aerosol_name(m).EQ.id_CSSO4M_phy) THEN
-        soluble=.TRUE.
-        spsol=4
-        spss=0
-        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
-     ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 
-         soluble=.TRUE.
-         spsol=5
-         spss=3
-     ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 
-         soluble=.TRUE.
-         spsol=6
-         spss=2
-     ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN
-         soluble=.TRUE.
-         spsol=7
-         spss=1
-     ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 
-         soluble=.FALSE.
-         spinsol=1
-         spss=0
-     ELSEIF  (aerosol_name(m).EQ.id_AIBCM_phy) THEN 
-         soluble=.FALSE.
-         spinsol=2
-         spss=0
-     ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 
-         soluble=.FALSE.
-         spinsol=3
-         spss=0
-     ELSE 
-         CYCLE
-     ENDIF
-
-    id=aerosol_name(m)
-    used_aer(id)=.TRUE.
-
-    IF (soluble) THEN
-
-      IF (spss.NE.0) THEN
-
-         IF (spss.EQ.1) THEN !accumulation mode
-            DO k=1, KLEV
-!CDIR ON_ADB(A1_ASSSM_b1)
-!CDIR ON_ADB(A2_ASSSM_b1)
-!CDIR ON_ADB(A3_ASSSM_b1)
-!CDIR ON_ADB(B1_ASSSM_b1)
-!CDIR ON_ADB(B2_ASSSM_b1)
-!CDIR ON_ADB(C1_ASSSM_b1)
-!CDIR ON_ADB(C2_ASSSM_b2)
-!CDIR ON_ADB(A1_ASSSM_b2)
-!CDIR ON_ADB(A2_ASSSM_b2)
-!CDIR ON_ADB(A3_ASSSM_b2)
-!CDIR ON_ADB(B1_ASSSM_b2)
-!CDIR ON_ADB(B2_ASSSM_b2)
-!CDIR ON_ADB(C1_ASSSM_b2)
-!CDIR ON_ADB(C2_ASSSM_b2)
-
-              DO i=1, KLON
-
-                H=rh(i,k)/100
-                tmp_var=m_allaer(i,k,spsol)/1.e6*zdh(i,k)*fac
-                tmp_var_pi=m_allaer_pi(i,k,spsol)/1.e6*zdh(i,k)*fac
-
-                ! band 1
-                tau_ae2b_int=A1_ASSSM_b1(k)+A2_ASSSM_b1(k)*H+A3_ASSSM_b1(k)/(H-1.05)
-                piz_ae2b_int=1-B1_ASSSM_b1(k)-B2_ASSSM_b1(k)*H
-                cg_ae2b_int=C1_ASSSM_b1(k)+C2_ASSSM_b1(k)*H
-
-                tau_ae(i,k,id,1) = tmp_var*tau_ae2b_int
-                tau_ae_pi(i,k,id,1) =  tmp_var_pi* tau_ae2b_int
-                piz_ae(i,k,id,1) = piz_ae2b_int
-                cg_ae(i,k,id,1)= cg_ae2b_int
-                
-                !band 2
-                tau_ae2b_int=A1_ASSSM_b2(k)+A2_ASSSM_b2(k)*H+A3_ASSSM_b2(k)/(H-1.05)
-                piz_ae2b_int=1-B1_ASSSM_b2(k)-B2_ASSSM_b2(k)*H
-                cg_ae2b_int=C1_ASSSM_b2(k)+C2_ASSSM_b2(k)*H
-
-                tau_ae(i,k,id,2) = tmp_var*tau_ae2b_int
-                tau_ae_pi(i,k,id,2) =  tmp_var_pi* tau_ae2b_int
-                piz_ae(i,k,id,2) = piz_ae2b_int
-                cg_ae(i,k,id,2)= cg_ae2b_int
-
-              ENDDO
-            ENDDO
-          ENDIF
-
-          IF (spss.EQ.2) THEN !coarse mode
-            DO k=1, KLEV
-!CDIR ON_ADB(A1_CSSSM_b1)
-!CDIR ON_ADB(A2_CSSSM_b1)
-!CDIR ON_ADB(A3_CSSSM_b1)
-!CDIR ON_ADB(B1_CSSSM_b1)
-!CDIR ON_ADB(B2_CSSSM_b1)
-!CDIR ON_ADB(C1_CSSSM_b1)
-!CDIR ON_ADB(C2_CSSSM_b2)
-!CDIR ON_ADB(A1_CSSSM_b2)
-!CDIR ON_ADB(A2_CSSSM_b2)
-!CDIR ON_ADB(A3_CSSSM_b2)
-!CDIR ON_ADB(B1_CSSSM_b2)
-!CDIR ON_ADB(B2_CSSSM_b2)
-!CDIR ON_ADB(C1_CSSSM_b2)
-!CDIR ON_ADB(C2_CSSSM_b2)
-
-              DO i=1, KLON
-
-                H=rh(i,k)/100
-                tmp_var=m_allaer(i,k,spsol)/1.e6*zdh(i,k)*fac
-                tmp_var_pi=m_allaer_pi(i,k,spsol)/1.e6*zdh(i,k)*fac
-                ! band 1
-                tau_ae2b_int=A1_CSSSM_b1(k)+A2_CSSSM_b1(k)*H+A3_CSSSM_b1(k)/(H-1.05)
-                piz_ae2b_int=1-B1_CSSSM_b1(k)-B2_CSSSM_b1(k)*H
-                cg_ae2b_int=C1_CSSSM_b1(k)+C2_CSSSM_b1(k)*H
-
-                tau_ae(i,k,id,1) = tmp_var*tau_ae2b_int
-                tau_ae_pi(i,k,id,1) =  tmp_var_pi* tau_ae2b_int
-                piz_ae(i,k,id,1) = piz_ae2b_int
-                cg_ae(i,k,id,1)= cg_ae2b_int
-
-                ! band 2
-                tau_ae2b_int=A1_CSSSM_b2(k)+A2_CSSSM_b2(k)*H+A3_CSSSM_b2(k)/(H-1.05)
-                piz_ae2b_int=1-B1_CSSSM_b2(k)-B2_CSSSM_b2(k)*H
-                cg_ae2b_int=C1_CSSSM_b2(k)+C2_CSSSM_b2(k)*H
-
-                tau_ae(i,k,id,2) = tmp_var*tau_ae2b_int
-                tau_ae_pi(i,k,id,2) =  tmp_var_pi* tau_ae2b_int
-                piz_ae(i,k,id,2) = piz_ae2b_int
-                cg_ae(i,k,id,2)= cg_ae2b_int
-
-             ENDDO
-           ENDDO
-         ENDIF
-
-         IF (spss.EQ.3) THEN !super coarse mode
-            DO k=1, KLEV
-!CDIR ON_ADB(A1_SSSSM_b1)
-!CDIR ON_ADB(A2_SSSSM_b1)
-!CDIR ON_ADB(A3_SSSSM_b1)
-!CDIR ON_ADB(B1_SSSSM_b1)
-!CDIR ON_ADB(B2_SSSSM_b1)
-!CDIR ON_ADB(C1_SSSSM_b1)
-!CDIR ON_ADB(C2_SSSSM_b2)
-!CDIR ON_ADB(A1_SSSSM_b2)
-!CDIR ON_ADB(A2_SSSSM_b2)
-!CDIR ON_ADB(A3_SSSSM_b2)
-!CDIR ON_ADB(B1_SSSSM_b2)
-!CDIR ON_ADB(B2_SSSSM_b2)
-!CDIR ON_ADB(C1_SSSSM_b2)
-!CDIR ON_ADB(C2_SSSSM_b2)
-
-              DO i=1, KLON
-
-                H=rh(i,k)/100
-                tmp_var=m_allaer(i,k,spsol)/1.e6*zdh(i,k)*fac
-                tmp_var_pi=m_allaer_pi(i,k,spsol)/1.e6*zdh(i,k)*fac
-
-                ! band 1 
-                tau_ae2b_int=A1_SSSSM_b1(k)+A2_SSSSM_b1(k)*H+A3_SSSSM_b1(k)/(H-1.05)
-                piz_ae2b_int=1-B1_SSSSM_b1(k)-B2_SSSSM_b1(k)*H
-                cg_ae2b_int=C1_SSSSM_b1(k)+C2_SSSSM_b1(k)*H
-
-                tau_ae(i,k,id,1) = tmp_var*tau_ae2b_int
-                tau_ae_pi(i,k,id,1) =  tmp_var_pi* tau_ae2b_int
-                piz_ae(i,k,id,1) = piz_ae2b_int
-                cg_ae(i,k,id,1)= cg_ae2b_int
-
-                ! band 2
-                tau_ae2b_int=A1_SSSSM_b2(k)+A2_SSSSM_b2(k)*H+A3_SSSSM_b2(k)/(H-1.05)
-                piz_ae2b_int=1-B1_SSSSM_b2(k)-B2_SSSSM_b2(k)*H
-                cg_ae2b_int=C1_SSSSM_b2(k)+C2_SSSSM_b2(k)*H
-
-                tau_ae(i,k,id,2) = tmp_var*tau_ae2b_int
-                tau_ae_pi(i,k,id,2) =  tmp_var_pi* tau_ae2b_int
-                piz_ae(i,k,id,2) = piz_ae2b_int
-                cg_ae(i,k,id,2)= cg_ae2b_int
-
-              ENDDO
-            ENDDO
-          ENDIF
-
-        ELSE
-                        
-!CDIR ON_ADB(alpha_aers_2bands)
-!CDIR ON_ADB(piz_aers_2bands)
-!CDIR ON_ADB(cg_aers_2bands)
-          DO k=1, KLEV
-            DO i=1, KLON
-              tmp_var=m_allaer(i,k,spsol)/1.e6*zdh(i,k)*fac
-              tmp_var_pi=m_allaer_pi(i,k,spsol)/1.e6*zdh(i,k)*fac
-!CDIR UNROLL=nbands
-              DO inu=1,nbands
-
-                tau_ae2b_int= alpha_aers_2bands(RH_num(i,k),inu,spsol)+ & 
-                              DELTA(i,k)* (alpha_aers_2bands(RH_num(i,k)+1,inu,spsol) - & 
-                              alpha_aers_2bands(RH_num(i,k),inu,spsol))
-                      
-                piz_ae2b_int = piz_aers_2bands(RH_num(i,k),inu,spsol) + & 
-                               DELTA(i,k)* (piz_aers_2bands(RH_num(i,k)+1,inu,spsol) - & 
-                               piz_aers_2bands(RH_num(i,k),inu,spsol))
-                      
-                cg_ae2b_int = cg_aers_2bands(RH_num(i,k),inu,spsol) + & 
-                              DELTA(i,k)* (cg_aers_2bands(RH_num(i,k)+1,inu,spsol) - & 
-                              cg_aers_2bands(RH_num(i,k),inu,spsol))
-
-                tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
-                tau_ae_pi(i,k,id,inu) =  tmp_var_pi* tau_ae2b_int
-                piz_ae(i,k,id,inu) = piz_ae2b_int
-                cg_ae(i,k,id,inu)= cg_ae2b_int
-                         
-              ENDDO
-            ENDDO
-          ENDDO
-        
-        ENDIF                     
-
-      ELSE                                                    ! For all aerosol insoluble components
-
-!CDIR ON_ADB(alpha_aers_2bands)
-!CDIR ON_ADB(piz_aers_2bands)
-!CDIR ON_ADB(cg_aers_2bands)
-        DO k=1, KLEV
-          DO i=1, KLON
-            tmp_var=m_allaer(i,k,naero_soluble+spinsol)/1.e6*zdh(i,k)*fac
-            tmp_var_pi=m_allaer_pi(i,k,naero_soluble+spinsol)/1.e6*zdh(i,k)*fac
-!CDIR UNROLL=nbands
-            DO inu=1,nbands
-              tau_ae2b_int = alpha_aeri_2bands(inu,spinsol)
-              piz_ae2b_int = piz_aeri_2bands(inu,spinsol)
-              cg_ae2b_int = cg_aeri_2bands(inu,spinsol) 
-
-              tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
-              tau_ae_pi(i,k,id,inu) = tmp_var_pi*tau_ae2b_int
-              piz_ae(i,k,id,inu) = piz_ae2b_int
-              cg_ae(i,k,id,inu)= cg_ae2b_int
-            ENDDO
-          ENDDO
-        ENDDO
-
-      ENDIF ! soluble
-
-    ENDDO  ! nb_aer  
-
-!correction bug OB
-!  DO m=1,nb_aer   
-  DO m=1,naero_tot   
-    IF (.NOT. used_aer(m)) THEN
-      tau_ae(:,:,m,:)=0.
-      tau_ae_pi(:,:,m,:)=0.
-      piz_ae(:,:,m,:)=0.
-      cg_ae(:,:,m,:)=0.
-    ENDIF
-  ENDDO
-
-  DO inu=1, nbands
-
-    !!DO mrfspecies=1,naero_grp
-    DO mrfspecies=2,3    !--only deal with total and natural aerosols
-
-      IF (mrfspecies .EQ. 2) THEN             ! = total aerosol AER	 
-
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSO4M_phy,inu)+tau_ae(i,k,id_CSSO4M_phy,inu)+ &
-                                           tau_ae(i,k,id_ASBCM_phy,inu)+tau_ae(i,k,id_AIBCM_phy,inu)+   &
-                                           tau_ae(i,k,id_ASPOMM_phy,inu)+tau_ae(i,k,id_AIPOMM_phy,inu)+ &
-                                           tau_ae(i,k,id_ASSSM_phy,inu)+tau_ae(i,k,id_CSSSM_phy,inu)+   &
-                                           tau_ae(i,k,id_SSSSM_phy,inu)+ tau_ae(i,k,id_CIDUSTM_phy,inu)
-            tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5)
-                 
-            piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ &
-                                            tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+ &
-                                            tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)+   &
-                                            tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+   &
-                                            tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+ &
-                                            tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+ &
-                                            tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+   &
-                                            tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+   &
-                                            tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+   &
-                                            tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) &
-                                            /tau_allaer(i,k,mrfspecies,inu)
-            piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1)
-
-            cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)* &
-              piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ &
-              tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)* &
-              cg_ae(i,k,id_CSSO4M_phy,inu)+ &
-              tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)* &
-              cg_ae(i,k,id_ASBCM_phy,inu)+ &
-              tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)* &
-              cg_ae(i,k,id_AIBCM_phy,inu)+ &
-              tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)* &
-              cg_ae(i,k,id_ASPOMM_phy,inu)+ &
-              tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)* &
-              cg_ae(i,k,id_AIPOMM_phy,inu)+ &
-              tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)* &
-              cg_ae(i,k,id_ASSSM_phy,inu)+ &
-              tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)* &
-              cg_ae(i,k,id_CSSSM_phy,inu)+ &
-              tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)* &
-              cg_ae(i,k,id_SSSSM_phy,inu)+ &
-              tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)* &
-              cg_ae(i,k,id_CIDUSTM_phy,inu))/ &
-              (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
-          ENDDO    
-        ENDDO 
-
-      ELSEIF (mrfspecies .EQ. 3) THEN             ! = natural aerosol NAT
-
-        DO k=1, KLEV
-          DO i=1, KLON
-
-              tau_allaer(i,k,mrfspecies,inu)=tau_ae_pi(i,k,id_ASSO4M_phy,inu)+ &
-                      tau_ae_pi(i,k,id_CSSO4M_phy,inu)+ &
-                      tau_ae_pi(i,k,id_ASBCM_phy,inu)+  &
-                      tau_ae_pi(i,k,id_AIBCM_phy,inu)+  &
-                      tau_ae_pi(i,k,id_ASPOMM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_AIPOMM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_ASSSM_phy,inu)+  &
-                      tau_ae_pi(i,k,id_CSSSM_phy,inu)+  &
-                      tau_ae_pi(i,k,id_SSSSM_phy,inu)+  &
-                      tau_ae_pi(i,k,id_CIDUSTM_phy,inu)
-              tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5)
-
-              piz_allaer(i,k,mrfspecies,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ &
-                      tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+ &
-                      tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)+   &
-                      tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+   &
-                      tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+   &
-                      tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+   &
-                      tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+   &
-                      tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) &
-                      /tau_allaer(i,k,mrfspecies,inu)
-              piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1)
-
-              cg_allaer(i,k,mrfspecies,inu)=(&
-                      tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ &
-                      tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)*cg_ae(i,k,id_CSSO4M_phy,inu)+ &
-                      tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)*cg_ae(i,k,id_ASBCM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)*cg_ae(i,k,id_ASSSM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu)+ &
-                      tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)*&
-                      cg_ae(i,k,id_CIDUSTM_phy,inu))/ &
-                      (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
-          ENDDO
-        ENDDO
-                   
-      ELSEIF (mrfspecies .EQ. 4) THEN             ! = BC
-
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASBCM_phy,inu)+tau_ae(i,k,id_AIBCM_phy,inu)
-            tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5)
-            piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu) &
-                      +tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu))/ &
-                      tau_allaer(i,k,mrfspecies,inu)
-            piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1)
-            cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu) *cg_ae(i,k,id_ASBCM_phy,inu)&
-                      +tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu))/ &
-                      (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
-          ENDDO
-        ENDDO
-              
-      ELSEIF (mrfspecies .EQ. 5) THEN             ! = SO4
-
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSO4M_phy,inu)+tau_ae(i,k,id_CSSO4M_phy,inu)
-            tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5)
-            piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu) &
-                      +tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu))/ &
-                      tau_allaer(i,k,mrfspecies,inu)
-            piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1)
-            cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_CSSO4M_phy,inu)* &
-            piz_ae(i,k,id_CSSO4M_phy,inu) *cg_ae(i,k,id_CSSO4M_phy,inu)&
-            +tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)* &
-            cg_ae(i,k,id_ASSO4M_phy,inu))/ &
-            (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
-          ENDDO
-        ENDDO
-
-      ELSEIF (mrfspecies .EQ. 6) THEN             ! = POM
-
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASPOMM_phy,inu)+tau_ae(i,k,id_AIPOMM_phy,inu)
-            tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5)
-            piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu) &
-                      +tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu))/ &
-                      tau_allaer(i,k,mrfspecies,inu)
-            piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1)
-            cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)&
-                      +tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu))/ &
-                      (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
-          ENDDO
-        ENDDO
-              
-      ELSEIF (mrfspecies .EQ. 7) THEN             ! = DUST
-
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_CIDUSTM_phy,inu)
-            tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5)
-            piz_allaer(i,k,mrfspecies,inu)=piz_ae(i,k,id_CIDUSTM_phy,inu)
-            cg_allaer(i,k,mrfspecies,inu)=cg_ae(i,k,id_CIDUSTM_phy,inu)
-          ENDDO
-        ENDDO
-
-      ELSEIF (mrfspecies .EQ. 8) THEN             ! = SS
-
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSSM_phy,inu)+tau_ae(i,k,id_CSSSM_phy,inu)+tau_ae(i,k,id_SSSSM_phy,inu)
-            tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5)
-            piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu) &
-                    +tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu) &
-                    +tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu))/ &
-                    tau_allaer(i,k,mrfspecies,inu)
-            piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1)
-            cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu) *cg_ae(i,k,id_ASSSM_phy,inu)&
-                    +tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu) &
-                    +tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu))/ &
-                    (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
-          ENDDO
-        ENDDO
-      
-      ELSEIF (mrfspecies .EQ. 9) THEN             ! = NO3
-      
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=0.   ! preliminary
-            piz_allaer(i,k,mrfspecies,inu)=0.
-            cg_allaer(i,k,mrfspecies,inu)=0.
-          ENDDO
-        ENDDO
-      
-      ELSE
-
-        DO k=1, KLEV
-          DO i=1, KLON
-            tau_allaer(i,k,mrfspecies,inu)=0.  
-            piz_allaer(i,k,mrfspecies,inu)=0.
-            cg_allaer(i,k,mrfspecies,inu)=0.
-          ENDDO
-        ENDDO
-           
-      ENDIF
-
-    ENDDO
-  ENDDO
-
-  DEALLOCATE(aerosol_name) 
-
-END SUBROUTINE AEROPT_2BANDS
+link ../phylmd/aeropt_2bands.F90
Index: LMDZ6/trunk/libf/phylmdiso/aeropt_5wv.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/aeropt_5wv.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/aeropt_5wv.F90	(revision 3940)
@@ -1,826 +1,1 @@
-!
-! $Id: aeropt_5wv.F90 2634 2016-09-24 17:14:59Z oboucher $
-!
-
-SUBROUTINE AEROPT_5WV(&
-   pdel, m_allaer, delt, &
-   RHcl, ai, flag_aerosol, &
-   pplay, t_seri, &
-   tausum, tau, presnivs)
-
-  USE DIMPHY
-  USE aero_mod
-  USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer
-  USE pres2lev_mod
-
-  !
-  !    Yves Balkanski le 12 avril 2006
-  !    Celine Deandreis
-  !    Anne Cozic  Avril 2009
-  !    a partir d'une sous-routine de Johannes Quaas pour les sulfates
-  !
-  !
-  ! Refractive indices for seasalt come from Shettle and Fenn (1979)
-  !
-  ! Refractive indices from water come from Hale and Querry (1973)
-  !
-  ! Refractive indices from Ammonium Sulfate Toon and Pollack (1976)
-  !
-  ! Refractive indices for Dust, internal mixture of minerals coated with 1.5% hematite 
-  ! by Volume (Balkanski et al., 2006)
-  !
-  ! Refractive indices for POM: Kinne (pers. Communication 
-  !
-  ! Refractive index for BC from Shettle and Fenn (1979)
-  !
-  ! Shettle, E. P., & Fenn, R. W. (1979), Models for the aerosols of the lower atmosphere and 
-  ! the effects of humidity variations on their optical properties, U.S. Air Force Geophysics 
-  ! Laboratory Rept. AFGL-TR-79-0214, Hanscomb Air Force Base, MA.
-  !
-  ! Hale, G. M. and M. R. Querry, Optical constants of water in the 200-nm to 200-m 
-  ! wavelength region, Appl. Opt., 12, 555-563, 1973.
-  !
-  ! Toon, O. B. and J. B. Pollack, The optical constants of several atmospheric aerosol species:
-  ! Ammonium sulfate, aluminum oxide, and sodium chloride, J. Geohys. Res., 81, 5733-5748,
-  ! 1976.
-  !
-  ! Balkanski, Y., M. Schulz, T. Claquin And O. Boucher, Reevaluation of mineral aerosol 
-  ! radiative forcings suggests a better agreement with satellite and AERONET data, Atmospheric 
-  ! Chemistry and Physics Discussions., 6, pp 8383-8419, 2006.
-  !
-  IMPLICIT NONE
-  INCLUDE "YOMCST.h"
-  !
-  ! Input arguments:
-  !
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: pdel
-  REAL, INTENT(in)                         :: delt
-  REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: RHcl     ! humidite relative ciel clair
-  INTEGER,INTENT(in)                       :: flag_aerosol
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: pplay
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: t_seri
-  REAL, DIMENSION(klev),      INTENT(in)   :: presnivs
-  !
-  ! Output arguments:
-  !
-  REAL, DIMENSION(klon), INTENT(out)          :: ai      ! POLDER aerosol index
-  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(out)      :: tausum
-  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(out) :: tau
-  !
-  ! Local
-  !
-  INTEGER, PARAMETER :: las = nwave_sw
-  LOGICAL :: soluble
-  
-  INTEGER :: i, k, ierr, m, aerindex
-  INTEGER :: spsol, spinsol, spss, la
-  INTEGER :: RH_num(klon,klev)
-  INTEGER, PARAMETER :: la443 = 1
-  INTEGER, PARAMETER :: la550 = 2
-  INTEGER, PARAMETER :: la670 = 3
-  INTEGER, PARAMETER :: la765 = 4
-  INTEGER, PARAMETER :: la865 = 5
-  INTEGER, PARAMETER :: nbre_RH=12
-  INTEGER, PARAMETER :: naero_soluble=7   !  1- BC soluble; 2- POM soluble; 3- SO4 acc.
-                                          !  4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
-  INTEGER, PARAMETER :: naero_insoluble=3 !  1- Dust; 2- BC insoluble; 3- POM insoluble
-  INTEGER, PARAMETER :: nb_level = 19     ! number of vertical levels
-  LOGICAL, SAVE :: firstcall=.TRUE.
-!$OMP THREADPRIVATE(firstcall)
-
-  REAL :: zrho
-
-  ! Coefficient optiques sur 19 niveaux
-  REAL, SAVE, DIMENSION(nb_level) :: presnivs_19  ! Pression milieux couche pour 19 niveaux (nb_level)
-!$OMP THREADPRIVATE(presnivs_19)
-
-  REAL, SAVE, DIMENSION(nb_level) :: A1_ASSSM_19, A2_ASSSM_19, A3_ASSSM_19,&
-          B1_ASSSM_19, B2_ASSSM_19, C1_ASSSM_19, C2_ASSSM_19,&
-          A1_CSSSM_19, A2_CSSSM_19, A3_CSSSM_19,&
-          B1_CSSSM_19, B2_CSSSM_19, C1_CSSSM_19, C2_CSSSM_19, &
-          A1_SSSSM_19, A2_SSSSM_19, A3_SSSSM_19,&
-          B1_SSSSM_19, B2_SSSSM_19, C1_SSSSM_19, C2_SSSSM_19
-!$OMP THREADPRIVATE(A1_ASSSM_19, A2_ASSSM_19, A3_ASSSM_19)
-!$OMP THREADPRIVATE(B1_ASSSM_19, B2_ASSSM_19, C1_ASSSM_19, C2_ASSSM_19)
-!$OMP THREADPRIVATE(A1_CSSSM_19, A2_CSSSM_19, A3_CSSSM_19)
-!$OMP THREADPRIVATE(B1_CSSSM_19, B2_CSSSM_19, C1_CSSSM_19, C2_CSSSM_19)
-!$OMP THREADPRIVATE(A1_SSSSM_19, A2_SSSSM_19, A3_SSSSM_19)
-!$OMP THREADPRIVATE(B1_SSSSM_19, B2_SSSSM_19, C1_SSSSM_19, C2_SSSSM_19)
-
-  ! Coefficient optiques interpole sur le nombre de niveau du modele
-  REAL, ALLOCATABLE,  DIMENSION(:), SAVE :: &
-          A1_ASSSM, A2_ASSSM, A3_ASSSM,&
-          B1_ASSSM, B2_ASSSM, C1_ASSSM, C2_ASSSM,&
-          A1_CSSSM, A2_CSSSM, A3_CSSSM,&
-          B1_CSSSM, B2_CSSSM, C1_CSSSM, C2_CSSSM, &
-          A1_SSSSM, A2_SSSSM, A3_SSSSM,&
-          B1_SSSSM, B2_SSSSM, C1_SSSSM, C2_SSSSM
-!$OMP THREADPRIVATE(A1_ASSSM, A2_ASSSM, A3_ASSSM)
-!$OMP THREADPRIVATE(B1_ASSSM, B2_ASSSM, C1_ASSSM, C2_ASSSM)
-!$OMP THREADPRIVATE(A1_CSSSM, A2_CSSSM, A3_CSSSM)
-!$OMP THREADPRIVATE(B1_CSSSM, B2_CSSSM, C1_CSSSM, C2_CSSSM)
-!$OMP THREADPRIVATE(A1_SSSSM, A2_SSSSM, A3_SSSSM)
-!$OMP THREADPRIVATE(B1_SSSSM, B2_SSSSM, C1_SSSSM, C2_SSSSM)
-
-
-  REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
-  REAL :: DELTA(klon,klev), rh(klon,klev), H
-  REAL :: tau_ae5wv_int ! Intermediate computation of epaisseur optique aerosol
-  REAL :: piz_ae5wv_int ! Intermediate single scattering albedo aerosol
-  REAL :: cg_ae5wv_int  ! Intermediate asymmetry parameter aerosol
-  REAL, PARAMETER :: RH_MAX=95.
-  REAL :: taue670(klon)       ! epaisseur optique aerosol absorption 550 nm
-  REAL :: taue865(klon)       ! epaisseur optique aerosol extinction 865 nm
-  REAL :: fac
-  INTEGER, ALLOCATABLE, DIMENSION(:)  :: aerosol_name
-  INTEGER :: nb_aer
-  
-  REAL :: tau3d(klon,klev), piz3d(klon,klev), cg3d(klon,klev)
-  REAL :: abs3d(klon,klev)     ! epaisseur optique d'absorption
-  REAL :: dh(klon,klev)
-  
-  REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! ext. coeff. Soluble comp. units *** m2/g 
-   !  1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
-  REAL :: alpha_aeri_5wv(las,naero_insoluble)         ! ext. coeff. Insoluble comp. 1- Dust: 2- BC; 3- POM
-  REAL :: cg_aers_5wv(nbre_RH,las,naero_soluble)      ! Asym. param. soluble comp. 
-   !  1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
-  REAL :: cg_aeri_5wv(las,naero_insoluble)            ! Asym. param. insoluble comp. 1- Dust: 2- BC; 3- POM
-  REAL :: piz_aers_5wv(nbre_RH,las,naero_soluble)   
-   !  1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
-  REAL :: piz_aeri_5wv(las,naero_insoluble)           ! Insoluble comp. 1- Dust: 2- BC; 3- POM
-  !
-  ! Proprietes optiques
-  !
-  REAL :: fact_RH(nbre_RH)
-  LOGICAL :: used_tau(naero_spc)
-  INTEGER :: n
-  
-  DATA presnivs_19/&
-       100426.5,  98327.6, 95346.5, 90966.8, 84776.9, &
-       76536.5,   66292.2, 54559.3, 42501.8, 31806, &
-       23787.5,   18252.7, 13996,   10320.8, 7191.1, &
-       4661.7,    2732.9,  1345.6,  388.2/
-
-!!ACCUMULATION MODE
-  DATA A1_ASSSM_19/ 4.373E+00,  4.361E+00,  4.331E+00, &
-                 4.278E+00,  4.223E+00,  4.162E+00, &
-                 4.103E+00,  4.035E+00,  3.962E+00, &
-                 3.904E+00,  3.871E+00,  3.847E+00, &
-                 3.824E+00,  3.780E+00,  3.646E+00, &
-                 3.448E+00,  3.179E+00,  2.855E+00,  2.630E+00/
-  DATA A2_ASSSM_19/ 2.496E+00,  2.489E+00,  2.472E+00, &
-                 2.442E+00,  2.411E+00,  2.376E+00, &
-                 2.342E+00,  2.303E+00,  2.261E+00, &
-                 2.228E+00,  2.210E+00,  2.196E+00, &
-                 2.183E+00,  2.158E+00,  2.081E+00, &
-                 1.968E+00,  1.814E+00,  1.630E+00,  1.501E+00/
-  DATA A3_ASSSM_19/-4.688E-02, -4.676E-02, -4.644E-02, &
-                -4.587E-02, -4.528E-02, -4.463E-02, &
-                -4.399E-02, -4.326E-02, -4.248E-02, &
-                -4.186E-02, -4.151E-02, -4.125E-02, &
-                -4.100E-02, -4.053E-02, -3.910E-02, &
-                -3.697E-02, -3.408E-02, -3.061E-02, -2.819E-02/
-  DATA B1_ASSSM_19/ 1.165E-08,  1.145E-08,  1.097E-08, &
-                 1.012E-08,  9.233E-09,  8.261E-09, &
-                 7.297E-09,  6.201E-09,  5.026E-09, &
-                 4.098E-09,  3.567E-09,  3.187E-09, &
-                 2.807E-09,  2.291E-09,  2.075E-09, &
-                 1.756E-09,  1.322E-09,  8.011E-10, 4.379E-10/
-  DATA B2_ASSSM_19/ 2.193E-08,  2.192E-08,  2.187E-08, &
-                 2.179E-08,  2.171E-08,  2.162E-08, &
-                 2.153E-08,  2.143E-08,  2.132E-08, &
-                 2.124E-08,  2.119E-08,  2.115E-08, &
-                 2.112E-08,  2.106E-08,  2.100E-08, &
-                 2.090E-08,  2.077E-08,  2.061E-08,  2.049E-08/
-  DATA C1_ASSSM_19/ 7.365E-01,  7.365E-01,  7.365E-01, &
-                 7.364E-01,  7.363E-01,  7.362E-01, &
-                 7.361E-01,  7.359E-01,  7.358E-01, &
-                 7.357E-01,  7.356E-01,  7.356E-01, &
-                 7.356E-01,  7.355E-01,  7.354E-01, &
-                 7.352E-01,  7.350E-01,  7.347E-01,  7.345E-01/
-  DATA C2_ASSSM_19/ 5.833E-02,  5.835E-02,  5.841E-02, &
-                 5.850E-02,  5.859E-02,  5.870E-02, &
-                 5.880E-02,  5.891E-02,  5.904E-02, &
-                 5.914E-02,  5.920E-02,  5.924E-02, &
-                 5.928E-02,  5.934E-02,  5.944E-02, &
-                 5.959E-02,  5.979E-02,  6.003E-02,  6.020E-02/
-!COARSE MODE
-  DATA A1_CSSSM_19/ 7.403E-01,  7.422E-01,  7.626E-01, &
-                 8.019E-01,  8.270E-01,  8.527E-01, &
-                 8.702E-01,  8.806E-01,  8.937E-01, &
-                 9.489E-01,  1.030E+00,  1.105E+00, &
-                 1.199E+00,  1.357E+00,  1.660E+00, &
-                 2.540E+00,  4.421E+00,  2.151E+00,  9.518E-01/
-  DATA A2_CSSSM_19/ 4.522E-01,  4.532E-01,  4.644E-01, &
-                 4.859E-01,  4.996E-01,  5.137E-01, &
-                 5.233E-01,  5.290E-01,  5.361E-01, &
-                 5.655E-01,  6.085E-01,  6.483E-01, &
-                 6.979E-01,  7.819E-01,  9.488E-01, &
-                 1.450E+00,  2.523E+00,  1.228E+00,  5.433E-01/
-  DATA A3_CSSSM_19/-8.516E-03, -8.535E-03, -8.744E-03, &
-                -9.148E-03, -9.406E-03, -9.668E-03, &
-                -9.848E-03, -9.955E-03, -1.009E-02, &
-                -1.064E-02, -1.145E-02, -1.219E-02, &
-                -1.312E-02, -1.470E-02, -1.783E-02, &
-                -2.724E-02, -4.740E-02, -2.306E-02, -1.021E-02/
-  DATA B1_CSSSM_19/ 2.535E-07,  2.530E-07,  2.479E-07, &
-                 2.380E-07,  2.317E-07,  2.252E-07, &
-                 2.208E-07,  2.182E-07,  2.149E-07, &
-                 2.051E-07,  1.912E-07,  1.784E-07, &
-                 1.624E-07,  1.353E-07,  1.012E-07, &
-                 6.016E-08,  2.102E-08,  0.000E+00,  0.000E+00/
-  DATA B2_CSSSM_19/ 1.221E-07,  1.217E-07,  1.179E-07, &
-                 1.104E-07,  1.056E-07,  1.008E-07, &
-                 9.744E-08,  9.546E-08,  9.299E-08, &
-                 8.807E-08,  8.150E-08,  7.544E-08, &
-                 6.786E-08,  5.504E-08,  4.080E-08, &
-                 2.960E-08,  2.300E-08,  2.030E-08,  1.997E-08/
-  DATA C1_CSSSM_19/ 7.659E-01,  7.658E-01,  7.652E-01, &
-                 7.639E-01,  7.631E-01,  7.623E-01, &
-                 7.618E-01,  7.614E-01,  7.610E-01, &
-                 7.598E-01,  7.581E-01,  7.566E-01, &
-                 7.546E-01,  7.513E-01,  7.472E-01, &
-                 7.423E-01,  7.376E-01,  7.342E-01,  7.334E-01/
-  DATA C2_CSSSM_19/ 3.691E-02,  3.694E-02,  3.729E-02, &
-                 3.796E-02,  3.839E-02,  3.883E-02, &
-                 3.913E-02,  3.931E-02,  3.953E-02, &
-                 4.035E-02,  4.153E-02,  4.263E-02, &
-                 4.400E-02,  4.631E-02,  4.933E-02, &
-                 5.331E-02,  5.734E-02,  6.053E-02,  6.128E-02/
-!SUPER COARSE MODE
-  DATA A1_SSSSM_19/ 2.836E-01,  2.876E-01,  2.563E-01, &
-                 2.414E-01,  2.541E-01,  2.546E-01, &
-                 2.572E-01,  2.638E-01,  2.781E-01, &
-                 3.167E-01,  4.209E-01,  5.286E-01, &
-                 6.959E-01,  9.233E-01,  1.282E+00, &
-                 1.836E+00,  2.981E+00,  4.355E+00,  4.059E+00/
-  DATA A2_SSSSM_19/ 1.608E-01,  1.651E-01,  1.577E-01, &
-                 1.587E-01,  1.686E-01,  1.690E-01, &
-                 1.711E-01,  1.762E-01,  1.874E-01, &
-                 2.138E-01,  2.751E-01,  3.363E-01, &
-                 4.279E-01,  5.519E-01,  7.421E-01, &
-                 1.048E+00,  1.702E+00,  2.485E+00,  2.317E+00/
-  DATA A3_SSSSM_19/-3.025E-03, -3.111E-03, -2.981E-03, &
-                -3.005E-03, -3.193E-03, -3.200E-03, &
-                -3.239E-03, -3.336E-03, -3.548E-03, &
-                -4.047E-03, -5.196E-03, -6.345E-03, &
-                -8.061E-03, -1.038E-02, -1.395E-02, &
-                -1.970E-02, -3.197E-02, -4.669E-02, -4.352E-02/
-  DATA B1_SSSSM_19/ 6.759E-07,  6.246E-07,  5.542E-07, &
-                 4.953E-07,  4.746E-07,  4.738E-07, &
-                 4.695E-07,  4.588E-07,  4.354E-07, &
-                 3.947E-07,  3.461E-07,  3.067E-07, &
-                 2.646E-07,  2.095E-07,  1.481E-07, &
-                 9.024E-08,  5.747E-08,  2.384E-08,  6.599E-09/
-  DATA B2_SSSSM_19/ 5.977E-07,  5.390E-07,  4.468E-07, &
-                 3.696E-07,  3.443E-07,  3.433E-07, &
-                 3.380E-07,  3.249E-07,  2.962E-07, &
-                 2.483E-07,  1.989E-07,  1.623E-07, &
-                 1.305E-07,  9.015E-08,  6.111E-08, &
-                 3.761E-08,  2.903E-08,  2.337E-08,  2.147E-08/
-  DATA C1_SSSSM_19/ 8.120E-01,  8.084E-01,  8.016E-01, &
-                 7.953E-01,  7.929E-01,  7.928E-01, &
-                 7.923E-01,  7.910E-01,  7.882E-01, &
-                 7.834E-01,  7.774E-01,  7.725E-01, &
-                 7.673E-01,  7.604E-01,  7.529E-01, &
-                 7.458E-01,  7.419E-01,  7.379E-01,  7.360E-01/
-  DATA C2_SSSSM_19/ 2.388E-02,  2.392E-02,  2.457E-02,  2.552E-02, &
-                 2.615E-02,  2.618E-02,  2.631E-02,  2.663E-02, &
-                 2.735E-02,  2.875E-02,  3.113E-02,  3.330E-02, &
-                 3.615E-02,  3.997E-02,  4.521E-02,  5.038E-02, &
-                 5.358E-02,  5.705E-02,  5.887E-02/
-!*********************************************************************
-!
-! 
-! From here on we look at the optical parameters at 5 wavelengths:  
-! 443nm, 550, 670, 765 and 865 nm 
-!                                   le 12 AVRIL 2006 
-!  
- DATA alpha_aers_5wv/ & 
-                                ! bc soluble 
-       7.930,7.930,7.930,7.930,7.930,7.930,     & 
-       7.930,7.930,10.893,12.618,14.550,16.613, & 
-       7.658,7.658,7.658,7.658,7.658,7.658,     & 
-       7.658,7.658,10.351,11.879,13.642,15.510, & 
-       7.195,7.195,7.195,7.195,7.195,7.195,     & 
-       7.195,7.195,9.551,10.847,12.381,13.994,  & 
-       6.736,6.736,6.736,6.736,6.736,6.736,     & 
-       6.736,6.736,8.818,9.938,11.283,12.687,   & 
-       6.277,6.277,6.277,6.277,6.277,6.277,     & 
-       6.277,6.277,8.123,9.094,10.275,11.501,   & 
-                                ! pom soluble 
-       6.676,6.676,6.676,6.676,6.710,6.934,   & 
-       7.141,7.569,8.034,8.529,9.456,10.511,  & 
-       5.109,5.109,5.109,5.109,5.189,5.535,   & 
-       5.960,6.852,8.008,9.712,12.897,19.676, & 
-       3.718,3.718,3.718,3.718,3.779,4.042,   & 
-       4.364,5.052,5.956,7.314,9.896,15.688,  & 
-       2.849,2.849,2.849,2.849,2.897,3.107,   & 
-       3.365,3.916,4.649,5.760,7.900,12.863,  & 
-       2.229,2.229,2.229,2.229,2.268,2.437,   & 
-       2.645,3.095,3.692,4.608,6.391,10.633,  & 
-                                ! Sulfate (Accumulation) 
-       5.751,6.215,6.690,7.024,7.599,8.195,      & 
-       9.156,10.355,12.660,14.823,18.908,24.508, & 
-       4.320,4.675,5.052,5.375,5.787,6.274,      & 
-       7.066,8.083,10.088,12.003,15.697,21.133,  & 
-       3.079,3.351,3.639,3.886,4.205,4.584,      & 
-       5.206,6.019,7.648,9.234,12.391,17.220,    & 
-       2.336,2.552,2.781,2.979,3.236,3.540,      & 
-       4.046,4.711,6.056,7.388,10.093,14.313,    & 
-       1.777,1.949,2.134,2.292,2.503,2.751,      & 
-       3.166,3.712,4.828,5.949,8.264,11.922,     & 
-                                ! Sulfate (Coarse) 
-       5.751,6.215,6.690,7.024,7.599,8.195,      & 
-       9.156,10.355,12.660,14.823,18.908,24.508, & 
-       4.320,4.675,5.052,5.375,5.787,6.274,      & 
-       7.066,8.083,10.088,12.003,15.697,21.133,  & 
-       3.079,3.351,3.639,3.886,4.205,4.584,      & 
-       5.206,6.019,7.648,9.234,12.391,17.220,    & 
-       2.336,2.552,2.781,2.979,3.236,3.540,      & 
-       4.046,4.711,6.056,7.388,10.093,14.313,    & 
-       1.777,1.949,2.134,2.292,2.503,2.751,      & 
-       3.166,3.712,4.828,5.949,8.264,11.922,     & 
-                                ! Seasalt soluble super_coarse (computed below for 550nm) 
-       0.50,0.90,1.05,1.21,1.40,2.41, &  
-       2.66,3.11,3.88,4.52,5.69,8.84, &  
-       0.000,0.000,0.000,0.000,0.000,0.000, &  
-       0.000,0.000,0.000,0.000,0.000,0.000, &  
-     0.52,0.93,1.08,1.24,1.43,2.47, &  
-     2.73,3.20,3.99,4.64,5.84,9.04, &  
-     0.52,0.93,1.09,1.25,1.44,2.50, &  
-     2.76,3.23,4.03,4.68,5.89,9.14, &  
-     0.52,0.94,1.09,1.26,1.45,2.51, &  
-     2.78,3.25,4.06,4.72,5.94,9.22, &  
-                                ! seasalt soluble coarse (computed below for 550nm) 
-       0.50,0.90,1.05,1.21,1.40,2.41, &  
-       2.66,3.11,3.88,4.52,5.69,8.84, &  
-       0.000,0.000,0.000,0.000,0.000,0.000, &  
-       0.000,0.000,0.000,0.000,0.000,0.000, &  
-     0.52,0.93,1.08,1.24,1.43,2.47, &  
-     2.73,3.20,3.99,4.64,5.84,9.04, &  
-     0.52,0.93,1.09,1.25,1.44,2.50, &  
-     2.76,3.23,4.03,4.68,5.89,9.14, &  
-     0.52,0.94,1.09,1.26,1.45,2.51, &  
-     2.78,3.25,4.06,4.72,5.94,9.22, &  
-                                ! seasalt soluble accumulation (computed below for 550nm) 
-     4.28, 7.17, 8.44, 9.85,11.60,22.44,  &  
-     25.34,30.54,39.38,46.52,59.33,91.77, &  
-       0.000,0.000,0.000,0.000,0.000,0.000, &  
-       0.000,0.000,0.000,0.000,0.000,0.000, &  
-     2.48, 4.22, 5.02, 5.94, 7.11,15.29,  &  
-     17.70,22.31,30.73,38.06,52.15,90.59, &  
-     1.90, 3.29, 3.94, 4.69, 5.65, 12.58, &  
-     14.68,18.77,26.41,33.25,46.77,85.50, &  
-     1.47, 2.59, 3.12, 3.74, 4.54, 10.42, &  
-     12.24,15.82,22.66,28.91,41.54,79.33/ 
-
-  DATA alpha_aeri_5wv/ &
-                                 ! dust insoluble 
-        0.759, 0.770, 0.775, 0.775, 0.772, & 
-                                 !!jb bc insoluble 
-        11.536,10.033, 8.422, 7.234, 6.270, & 
-                                 ! pom insoluble 
-        5.042, 3.101, 1.890, 1.294, 0.934/ 
-   ! 
-  DATA cg_aers_5wv/ &  
-                                 ! bc soluble 
-      .651, .651, .651, .651, .651, .651, & 
-      .651, .651, .738, .764, .785, .800, & 
-      .597, .597, .597, .597, .597, .597, & 
-      .597, .597, .695, .725, .751, .770, & 
-      .543, .543, .543, .543, .543, .543, & 
-      .543, .543, .650, .684, .714, .736, &  
-      .504, .504, .504, .504, .504, .504, & 
-      .504, .504, .614, .651, .683, .708, &  
-      .469, .469, .469, .469, .469, .469, & 
-      .469, .469, .582, .620, .655, .681, & 
-                                 ! pom soluble 
-      .679, .679, .679, .679, .683, .691, & 
-      .703, .720, .736, .751, .766, .784, & 
-      .656, .656, .656, .656, .659, .669, & 
-      .681, .699, .717, .735, .750, .779, &  
-      .623, .623, .623, .623, .627, .637, & 
-      .649, .668, .688, .709, .734, .762, & 
-      .592, .592, .592, .592, .595, .605, & 
-      .618, .639, .660, .682, .711, .743, & 
-      .561, .561, .561, .561, .565, .575, & 
-      .588, .609, .632, .656, .688, .724, & 
-                                 ! Accumulation sulfate 
-      .671, .684, .697, .704, .714, .723, & 
-      .734, .746, .762, .771, .781, .789, & 
-      .653, .666, .678, .687, .697, .707, & 
-      .719, .732, .751, .762, .775, .789, & 
-      .622, .635, .648, .657, .667, .678, & 
-      .691, .705, .728, .741, .758, .777, & 
-      .591, .604, .617, .627, .638, .650, & 
-      .664, .679, .704, .719, .739, .761, & 
-      .560, .574, .587, .597, .609, .621, &  
-      .637, .653, .680, .697, .719, .745, & 
-                                 ! Coarse sulfate 
-      .671, .684, .697, .704, .714, .723, & 
-      .734, .746, .762, .771, .781, .789, & 
-      .653, .666, .678, .687, .697, .707, & 
-      .719, .732, .751, .762, .775, .789, & 
-      .622, .635, .648, .657, .667, .678, & 
-      .691, .705, .728, .741, .758, .777, & 
-      .591, .604, .617, .627, .638, .650, & 
-      .664, .679, .704, .719, .739, .761, & 
-      .560, .574, .587, .597, .609, .621, &  
-      .637, .653, .680, .697, .719, .745, & 
-                                 ! For super coarse seasalt (computed below for 550nm!) 
-      0.730,0.753,0.760,0.766,0.772,0.793, &  
-      0.797,0.802,0.809,0.813,0.820,0.830, &  
-      0.000,0.000,0.000,0.000,0.000,0.000, &  
-      0.000,0.000,0.000,0.000,0.000,0.000, &  
-      0.721,0.744,0.750,0.756,0.762,0.784, &  
-      0.787,0.793,0.800,0.804,0.811,0.822, &  
-      0.717,0.741,0.747,0.753,0.759,0.780, &  
-      0.784,0.789,0.795,0.800,0.806,0.817, &  
-      0.715,0.739,0.745,0.751,0.757,0.777, &   
-      0.781,0.786,0.793,0.797,0.803,0.814, &  
-                                 ! For coarse-soluble seasalt (computed below for 550nm!) 
-      0.730,0.753,0.760,0.766,0.772,0.793, &  
-      0.797,0.802,0.809,0.813,0.820,0.830, &  
-      0.000,0.000,0.000,0.000,0.000,0.000, &  
-      0.000,0.000,0.000,0.000,0.000,0.000, &  
-      0.721,0.744,0.750,0.756,0.762,0.784, &  
-      0.787,0.793,0.800,0.804,0.811,0.822, &  
-      0.717,0.741,0.747,0.753,0.759,0.780, &  
-      0.784,0.789,0.795,0.800,0.806,0.817, &  
-      0.715,0.739,0.745,0.751,0.757,0.777, &   
-      0.781,0.786,0.793,0.797,0.803,0.814, &  
-                                 ! accumulation-seasalt soluble (computed below for 550nm!)  
-      0.698,0.722,0.729,0.736,0.743,0.765, &  
-      0.768,0.773,0.777,0.779,0.781,0.779, &  
-      0.000,0.000,0.000,0.000,0.000,0.000, &  
-      0.000,0.000,0.000,0.000,0.000,0.000, &  
-      0.658,0.691,0.701,0.710,0.720,0.756, &  
-      0.763,0.771,0.782,0.788,0.795,0.801, &  
-      0.632,0.668,0.679,0.690,0.701,0.743, &  
-      0.750,0.762,0.775,0.783,0.792,0.804, &  
-      0.605,0.644,0.656,0.669,0.681,0.729, &  
-      0.737,0.750,0.765,0.775,0.787,0.803/
- !
-  DATA cg_aeri_5wv/&
-     ! dust insoluble
-     0.714, 0.697, 0.688, 0.683, 0.679, &
-     ! bc insoluble
-     0.511, 0.445, 0.384, 0.342, 0.307, &
-     !c pom insoluble
-     0.596, 0.536, 0.466, 0.409, 0.359/
-  !
-  DATA piz_aers_5wv/&
-                           ! bc soluble 
-  .445, .445, .445, .445, .445, .445, & 
-  .445, .445, .470, .487, .508, .531, & 
-  .442, .442, .442, .442, .442, .442, & 
-  .442, .442, .462, .481, .506, .533, & 
-  .427, .427, .427, .427, .427, .427, & 
-  .427, .427, .449, .470, .497, .526, & 
-  .413, .413, .413, .413, .413, .413, & 
-  .413, .413, .437, .458, .486, .516, & 
-  .399, .399, .399, .399, .399, .399, & 
-  .399, .399, .423, .445, .473, .506, & 
-                           ! pom soluble 
-  .975, .975, .975, .975, .975, .977, & 
-  .979, .982, .984, .987, .990, .994, & 
-  .972, .972, .972, .972, .973, .974, & 
-  .977, .980, .983, .986, .989, .993, & 
-  .963, .963, .963, .963, .964, .966, & 
-  .969, .974, .977, .982, .986, .991, & 
-  .955, .955, .955, .955, .955, .958, & 
-  .962, .967, .972, .977, .983, .989, & 
-  .944, .944, .944, .944, .944, .948, & 
-  .952, .959, .962, .972, .979, .987, & 
-                           ! sulfate soluble accumulation 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-                           ! sulfate soluble coarse 
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-                           ! seasalt super coarse (computed below for 550nm) 
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, & 
-                           ! seasalt coarse (computed below for 550nm) 
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-                           ! seasalt soluble accumulation (computed below for 550nm) 
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000, &  
-  1.000,1.000,1.000,1.000,1.000,1.000/ 
-
- !
-  DATA piz_aeri_5wv/&
-     ! dust insoluble
-     0.944, 0.970, 0.977, 0.982, 0.987, &
-     ! bc insoluble
-     0.415, 0.387, 0.355, 0.328, 0.301, &
-     ! pom insoluble
-     0.972, 0.963, 0.943, 0.923, 0.897/
-
-! Interpolation des coefficients optiques de 19 niveaux vers le nombre des niveaux du model
-  IF (firstcall) THEN
-     firstcall=.FALSE.
-! Allocation
-    IF (.NOT. ALLOCATED(A1_ASSSM)) THEN
-        ALLOCATE(A1_ASSSM(klev),A2_ASSSM(klev), A3_ASSSM(klev),&
-          B1_ASSSM(klev), B2_ASSSM(klev), C1_ASSSM(klev), C2_ASSSM(klev),&
-          A1_CSSSM(klev), A2_CSSSM(klev), A3_CSSSM(klev),&
-          B1_CSSSM(klev), B2_CSSSM(klev), C1_CSSSM(klev), C2_CSSSM(klev),&
-          A1_SSSSM(klev), A2_SSSSM(klev), A3_SSSSM(klev),&
-          B1_SSSSM(klev), B2_SSSSM(klev), C1_SSSSM(klev), C2_SSSSM(klev), stat=ierr)
-        IF (ierr /= 0) CALL abort_physic('aeropt_5mw', 'pb in allocation 1',1)
-     END IF
-
-!Accumulation mode
-     CALL pres2lev(A1_ASSSM_19, A1_ASSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_ASSSM_19, A2_ASSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_ASSSM_19, A3_ASSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_ASSSM_19, B1_ASSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_ASSSM_19, B2_ASSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_ASSSM_19, C1_ASSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_ASSSM_19, C2_ASSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-!Coarse mode
-     CALL pres2lev(A1_CSSSM_19, A1_CSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_CSSSM_19, A2_CSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_CSSSM_19, A3_CSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_CSSSM_19, B1_CSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_CSSSM_19, B2_CSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_CSSSM_19, C1_CSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_CSSSM_19, C2_CSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-!Super coarse mode
-     CALL pres2lev(A1_SSSSM_19, A1_SSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A2_SSSSM_19, A2_SSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(A3_SSSSM_19, A3_SSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B1_SSSSM_19, B1_SSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(B2_SSSSM_19, B2_SSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C1_SSSSM_19, C1_SSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-     CALL pres2lev(C2_SSSSM_19, C2_SSSSM, nb_level, klev, presnivs_19, presnivs, 1, 1, .FALSE.)
-
-  END IF ! firstcall
-
-  ! Initialisations
-  tau(:,:,:,:) =0.
-  tausum(:,:,:)= 0.
-  ai(:)=0.0
-
-  DO k=1, klev
-    DO i=1, klon
-      zrho=pplay(i,k)/t_seri(i,k)/RD     ! kg/m3
-      dh(i,k)=pdel(i,k)/(RG*zrho)    ! m
-    ENDDO
-  ENDDO
-
-  IF (flag_aerosol .EQ. 1) THEN 
-     nb_aer = 2
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASSO4M_phy
-     aerosol_name(2) = id_CSSO4M_phy
-  ELSEIF (flag_aerosol .EQ. 2) THEN
-     nb_aer = 2
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASBCM_phy
-     aerosol_name(2) = id_AIBCM_phy
-  ELSEIF (flag_aerosol .EQ. 3) THEN 
-     nb_aer = 2
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASPOMM_phy
-     aerosol_name(2) = id_AIPOMM_phy
-  ELSEIF (flag_aerosol .EQ. 4) THEN 
-     nb_aer = 3
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_CSSSM_phy
-     aerosol_name(2) = id_SSSSM_phy
-     aerosol_name(3) = id_ASSSM_phy
-  ELSEIF (flag_aerosol .EQ. 5) THEN 
-     nb_aer = 1
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_CIDUSTM_phy
-  ELSEIF (flag_aerosol .EQ. 6) THEN 
-     nb_aer = 10
-     ALLOCATE (aerosol_name(nb_aer)) 
-     aerosol_name(1) = id_ASSO4M_phy
-     aerosol_name(2) = id_ASBCM_phy
-     aerosol_name(3) = id_AIBCM_phy
-     aerosol_name(4) = id_ASPOMM_phy
-     aerosol_name(5) = id_AIPOMM_phy
-     aerosol_name(6) = id_CSSSM_phy
-     aerosol_name(7) = id_SSSSM_phy
-     aerosol_name(8) = id_ASSSM_phy
-     aerosol_name(9) = id_CIDUSTM_phy
-     aerosol_name(10) = id_CSSO4M_phy
-  ENDIF
-
-  ! 
-  ! loop over modes, use of precalculated nmd and corresponding sigma
-  !    loop over wavelengths
-  !    for each mass species in mode
-  !      interpolate from Sext to retrieve Sext_at_gridpoint_per_species
-  !      compute optical_thickness_at_gridpoint_per_species
-  
-  !
-  ! Calculations that need to be done since we are not in the subroutines INCA
-  !      
-
-  DO n=1,nbre_RH-1
-    fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
-  ENDDO
-   
-  DO k=1, klev
-    DO i=1, klon
-      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
-      RH_num(i,k) = INT( rh(i,k)/10. + 1.)
-!--test olivier pour pas de reindicage
-!      RH_num(i,k) =1
-      IF (rh(i,k).GT.85.) RH_num(i,k)=10
-      IF (rh(i,k).GT.90.) RH_num(i,k)=11
-      DELTA(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
-    ENDDO
-  ENDDO
-
-  used_tau(:)=.FALSE.
-    
-  DO m=1,nb_aer   ! tau is only computed for each mass    
-    fac=1.0
-    IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN
-        soluble=.TRUE.
-        spsol=1
-        spss=0
-    ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 
-        soluble=.TRUE.
-        spsol=2 
-        spss=0
-    ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN
-        soluble=.TRUE.
-        spsol=3
-        spss=0
-        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
-    ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN
-        soluble=.TRUE.
-        spsol=4
-        spss=0
-        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
-    ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 
-        soluble=.TRUE.
-        spsol=5
-        spss=3
-    ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 
-        soluble=.TRUE.
-        spsol=6
-        spss=2
-    ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN
-        soluble=.TRUE.
-        spsol=7
-        spss=1
-    ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 
-        soluble=.FALSE.
-        spinsol=1
-        spss=0
-    ELSEIF  (aerosol_name(m).EQ.id_AIBCM_phy) THEN 
-        soluble=.FALSE.
-        spinsol=2
-        spss=0
-    ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 
-        soluble=.FALSE.
-        spinsol=3
-        spss=0
-    ELSE 
-        CYCLE
-    ENDIF
-
-    IF (soluble) then
-      used_tau(spsol)=.TRUE.
-    ELSE
-      used_tau(naero_soluble+spinsol)=.TRUE.
-    ENDIF
-
-    aerindex=aerosol_name(m)
-
-    DO la=1,las
-
-    !--only 550 and 865 nm are used
-    IF (la.NE.la550.AND.la.NE.la865) CYCLE
-
-      IF (soluble) THEN
-
-        IF ((la.EQ.2).AND.(spss.NE.0)) THEN !la=2 corresponds to 550 nm
-          IF (spss.EQ.1) THEN !accumulation mode
-            DO k=1, klev
-              DO i=1, klon
-                H=rh(i,k)/100.
-                tau_ae5wv_int=A1_ASSSM(k)+A2_ASSSM(k)*H+A3_ASSSM(k)/(H-1.05)
-                tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac
-                tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
-              ENDDO
-            ENDDO
-          ENDIF
-  
-          IF (spss.EQ.2) THEN !coarse mode
-            DO k=1, klev
-              DO i=1, klon
-                H=rh(i,k)/100.
-                tau_ae5wv_int=A1_CSSSM(k)+A2_CSSSM(k)*H+A3_CSSSM(k)/(H-1.05)
-                tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac
-                tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
-              ENDDO
-            ENDDO
-          ENDIF
-
-          IF (spss.EQ.3) THEN !super coarse mode
-            DO k=1, klev
-              DO i=1, klon
-                H=rh(i,k)/100.
-                tau_ae5wv_int=A1_SSSSM(k)+A2_SSSSM(k)*H+A3_SSSSM(k)/(H-1.05)
-                tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac
-                tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
-              ENDDO
-            ENDDO
-          ENDIF
-
-        ELSE
-          DO k=1, klev
-            DO i=1, klon
-              tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
-                             (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - & 
-                              alpha_aers_5wv(RH_num(i,k),la,spsol))
-              tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac
-              tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
-            ENDDO
-          ENDDO
-        ENDIF
-
-      ELSE                                                  ! For insoluble aerosol
-
-        DO k=1, klev
-          DO i=1, klon
-            tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
-            tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac
-            tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
-          ENDDO
-        ENDDO
-
-      ENDIF
-
-    ENDDO   ! boucle sur les longueurs d'onde
-  ENDDO     ! Boucle  sur les masses de traceurs
-
-  DO m=1,naero_spc
-    IF (.NOT.used_tau(m)) tau(:,:,:,m)=0.
-  ENDDO  
-
-!--AOD calculations for diagnostics
-  od550aer(:)=SUM(tausum(:,la550,:),dim=2)
-  od865aer(:)=SUM(tausum(:,la865,:),dim=2)
-
-!--extinction coefficient for diagnostic
-  ec550aer(:,:)=SUM(tau(:,:,la550,:),dim=3)/dh(:,:)
-  
-!--acc mode AOD calculation for diagnostic
-  od550lt1aer(:)=tausum(:,la550,id_ASSO4M_phy)+tausum(:,la550,id_ASBCM_phy)+tausum(:,la550,id_AIBCM_phy)+  &
-                 tausum(:,la550,id_ASPOMM_phy)+tausum(:,la550,id_AIPOMM_phy)+tausum(:,la550,id_ASSSM_phy)+ &
-                 0.03*tausum(:,la550,id_CSSSM_phy)+0.4*tausum(:,la550,id_CIDUSTM_phy)
-
-  DEALLOCATE(aerosol_name) 
-  
-END SUBROUTINE AEROPT_5WV
+link ../phylmd/aeropt_5wv.F90
Index: LMDZ6/trunk/libf/phylmdiso/albedo.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/albedo.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/albedo.F90	(revision 3940)
@@ -1,161 +1,1 @@
-! $Id: albedo.F90 2413 2015-12-18 19:27:39Z oboucher $
-module albedo
-
-  IMPLICIT NONE
-
-contains
-
-  SUBROUTINE alboc(rjour, rlat, albedo)
-    USE dimphy
-    ! ======================================================================
-    ! Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM du LMD)
-    ! Date: le 16 mars 1995
-    ! Objet: Calculer l'albedo sur l'ocean
-    ! Methode: Integrer numeriquement l'albedo pendant une journee
-
-    ! Arguments;
-    ! rjour (in,R)  : jour dans l'annee (a compter du 1 janvier)
-    ! rlat (in,R)   : latitude en degre
-    ! albedo (out,R): albedo obtenu (de 0 a 1)
-    ! ======================================================================
-    include "YOMCST.h"
-    include "clesphys.h"
-
-    INTEGER npts ! il controle la precision de l'integration
-    PARAMETER (npts=120) ! 120 correspond a l'interval 6 minutes
-
-    REAL rlat(klon), rjour, albedo(klon)
-    REAL zdist, zlonsun, zpi, zdeclin
-    REAL rmu, alb, srmu, salb, fauxo, aa, bb
-    INTEGER i, k
-    ! ccIM
-    LOGICAL ancien_albedo
-    PARAMETER (ancien_albedo=.FALSE.)
-    ! SAVE albedo
-
-    IF (ancien_albedo) THEN
-
-       zpi = 4.*atan(1.)
-
-       ! Calculer la longitude vraie de l'orbite terrestre:
-       CALL orbite(rjour, zlonsun, zdist)
-
-       ! Calculer la declinaison du soleil (qui varie entre + et - R_incl):
-       zdeclin = asin(sin(zlonsun*zpi/180.0)*sin(r_incl*zpi/180.0))
-
-       DO i = 1, klon
-          aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
-          bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
-
-          ! Midi local (angle du temps = 0.0):
-          rmu = aa + bb*cos(0.0)
-          rmu = max(0.0, rmu)
-          fauxo = (1.47-acos(rmu))/.15
-          alb = 0.03 + 0.630/(1.+fauxo*fauxo)
-          srmu = rmu
-          salb = alb*rmu
-
-          ! Faire l'integration numerique de midi a minuit (le facteur 2
-          ! prend en compte l'autre moitie de la journee):
-          DO k = 1, npts
-             rmu = aa + bb*cos(real(k)/real(npts)*zpi)
-             rmu = max(0.0, rmu)
-             fauxo = (1.47-acos(rmu))/.15
-             alb = 0.03 + 0.630/(1.+fauxo*fauxo)
-             srmu = srmu + rmu*2.0
-             salb = salb + alb*rmu*2.0
-          END DO
-          IF (srmu/=0.0) THEN
-             albedo(i) = salb/srmu
-          ELSE ! nuit polaire (on peut prendre une valeur quelconque)
-             albedo(i) = 1.0
-          END IF
-       END DO
-
-       ! nouvel albedo
-
-    ELSE
-
-       zpi = 4.*atan(1.)
-
-       ! Calculer la longitude vraie de l'orbite terrestre:
-       CALL orbite(rjour, zlonsun, zdist)
-
-       ! Calculer la declinaison du soleil (qui varie entre + et - R_incl):
-       zdeclin = asin(sin(zlonsun*zpi/180.0)*sin(r_incl*zpi/180.0))
-
-       DO i = 1, klon
-          aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
-          bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
-
-          ! Midi local (angle du temps = 0.0):
-          rmu = aa + bb*cos(0.0)
-          rmu = max(0.0, rmu)
-          ! IM cf. PB  alb = 0.058/(rmu + 0.30)
-          ! alb = 0.058/(rmu + 0.30) * 1.5
-          alb = 0.058/(rmu+0.30)*1.2
-          ! alb = 0.058/(rmu + 0.30) * 1.3
-          srmu = rmu
-          salb = alb*rmu
-
-          ! Faire l'integration numerique de midi a minuit (le facteur 2
-          ! prend en compte l'autre moitie de la journee):
-          DO k = 1, npts
-             rmu = aa + bb*cos(real(k)/real(npts)*zpi)
-             rmu = max(0.0, rmu)
-             ! IM cf. PB      alb = 0.058/(rmu + 0.30)
-             ! alb = 0.058/(rmu + 0.30) * 1.5
-             alb = 0.058/(rmu+0.30)*1.2
-             ! alb = 0.058/(rmu + 0.30) * 1.3
-             srmu = srmu + rmu*2.0
-             salb = salb + alb*rmu*2.0
-          END DO
-          IF (srmu/=0.0) THEN
-             albedo(i) = salb/srmu
-          ELSE ! nuit polaire (on peut prendre une valeur quelconque)
-             albedo(i) = 1.0
-          END IF
-       END DO
-    END IF
-    RETURN
-  END SUBROUTINE alboc
-  ! =====================================================================
-  SUBROUTINE alboc_cd(rmu0, albedo)
-    USE dimphy
-
-    ! Auteur(s): Z.X. Li (LMD/CNRS)
-    ! date: 19940624
-    ! Calculer l'albedo sur l'ocean en fonction de l'angle zenithal moyen
-    ! Formule due a Larson and Barkstrom (1977) Proc. of the symposium
-    ! on radiation in the atmosphere, 19-28 August 1976, science Press,
-    ! 1977 pp 451-453, ou These de 3eme cycle de Sylvie Joussaume.
-
-    ! Arguments
-    ! rmu0    (in): cosinus de l'angle solaire zenithal
-    ! albedo (out): albedo de surface de l'ocean
-    ! ======================================================================
-    include "clesphys.h"
-    REAL, intent(in):: rmu0(klon)
-    real, intent(out):: albedo(klon)
-
-    REAL fauxo
-    INTEGER i
-    LOGICAL ancien_albedo
-    PARAMETER (ancien_albedo=.FALSE.)
-
-    IF (ancien_albedo) THEN
-       DO i = 1, klon
-          fauxo = (1.47-acos(max(rmu0(i), 0.0)))/0.15
-          albedo(i) = 0.03+.630/(1.+fauxo*fauxo)
-          albedo(i) = max(min(albedo(i),0.60), 0.04)
-       END DO
-    ELSE
-       DO i = 1, klon
-          albedo(i) = 0.058/(max(rmu0(i), 0.0)+0.30)
-          albedo(i) = max(min(albedo(i),0.60), 0.04)
-       END DO
-    END IF
-
-  END SUBROUTINE alboc_cd
-
-end module albedo
+link ../phylmd/albedo.F90
Index: LMDZ6/trunk/libf/phylmdiso/albsno.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/albsno.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/albsno.F90	(revision 3940)
@@ -1,62 +1,1 @@
-!
-! $Header$
-!
-SUBROUTINE albsno(klon, knon, dtime, agesno, alb_neig_grid, precip_snow)
-
-  IMPLICIT NONE
-
-  INCLUDE "clesphys.h"
-
-! Input arguments
-!****************************************************************************************
-  INTEGER, INTENT(IN)                  :: klon, knon
-  REAL, INTENT(IN)                     :: dtime
-  REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow
-
-! In/Output arguments
-!****************************************************************************************
-  REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
-
-! Output arguments
-!****************************************************************************************
-  REAL, DIMENSION(klon), INTENT(OUT)   :: alb_neig_grid
-
-! Local variables
-!****************************************************************************************
-  INTEGER                              :: i, nv
-  INTEGER, PARAMETER                   :: nvm = 8 
-  REAL                                 :: as
-  REAL, DIMENSION(klon,nvm)            :: veget
-  REAL, DIMENSION(nvm),SAVE            :: init, decay
-  !$OMP THREADPRIVATE(init, decay)
-
-  DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./
-  DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./
-!****************************************************************************************
-
-  if (albsno0>=0.) then
-     init(:)=albsno0
-     decay(:)=0.
-  endif
-
-  veget = 0.
-  veget(:,1) = 1.     ! desert partout
-  DO i = 1, knon
-     alb_neig_grid(i) = 0.0
-  ENDDO
-  DO nv = 1, nvm
-     DO i = 1, knon
-        as = init(nv)+decay(nv)*EXP(-agesno(i)/5.)
-        alb_neig_grid(i) = alb_neig_grid(i) + veget(i,nv)*as
-     ENDDO
-  ENDDO
-  
-
-! modilation en fonction de l'age de la neige
-  DO i = 1, knon
-     agesno(i)  = (agesno(i) + (1.-agesno(i)/50.)*dtime/86400.)&
-          &             * EXP(-1.*MAX(0.0,precip_snow(i))*dtime/0.3)
-     agesno(i) =  MAX(agesno(i),0.0)
-  ENDDO
-  
-END SUBROUTINE albsno
+link ../phylmd/albsno.F90
Index: LMDZ6/trunk/libf/phylmdiso/alpale.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/alpale.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/alpale.F90	(revision 3940)
@@ -1,197 +1,1 @@
-SUBROUTINE alpale ( debut, itap, dtime, paprs, omega, t_seri,   &
-                    alp_offset, it_wape_prescr,  wape_prescr, fip_prescr, &
-                    ale_bl_prescr, alp_bl_prescr, &
-                    wake_pe, wake_fip,  &
-                    Ale_bl, Ale_bl_trig, Alp_bl, &
-                    Ale, Alp, Ale_wake, Alp_wake )
-
-! **************************************************************
-! *
-! ALPALE                                                       *
-! *
-! *
-! written by   : Jean-Yves Grandpeix, 12/05/2016              *
-! modified by :                                               *
-! **************************************************************
-
-  USE dimphy
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
-  USE phys_local_var_mod, ONLY: zw2       ! Variables internes non sauvegardees de la physique
-!
-  IMPLICIT NONE
-
-!================================================================
-! Auteur(s)   : Jean-Yves Grandpeix, 12/05/2016
-! Objet : Sums up all contributions to Ale and Alp
-!================================================================
-
-! Input arguments
-!----------------
-  LOGICAL, INTENT(IN)                                        :: debut
-  INTEGER, INTENT(IN)                                        :: itap
-  REAL, INTENT(IN)                                           :: dtime
-  INTEGER, INTENT(IN)                                        :: it_wape_prescr
-  REAL, INTENT(IN)                                           :: wape_prescr, fip_prescr
-  REAL, INTENT(IN)                                           :: Ale_bl_prescr, Alp_bl_prescr
-  REAL, INTENT(IN)                                           :: alp_offset
-  REAL, DIMENSION(klon,klev+1), INTENT(IN)                   :: paprs
-  REAL, DIMENSION(klon,klev), INTENT(IN)                     :: t_seri
-  REAL, DIMENSION(klon,klev), INTENT(IN)                     :: omega
-  REAL, DIMENSION(klon), INTENT(IN)                          :: wake_pe, wake_fip
-  REAL, DIMENSION(klon), INTENT(IN)                          :: Ale_bl, Ale_bl_trig, Alp_bl
-
-
-! Output arguments
-!----------------
-  REAL, DIMENSION(klon), INTENT(OUT)                         :: Ale, Alp
-  REAL, DIMENSION(klon), INTENT(OUT)                         :: Ale_wake, Alp_wake
-
-  include "thermcell.h"
-  include "YOMCST.h"
-  include "YOETHF.h"
-
-! Local variables
-!----------------
-  INTEGER                                                    :: i, k
-  REAL, DIMENSION(klon)                                      :: www
-  REAL, SAVE                                                 :: ale_max=1000.
-  REAL, SAVE                                                 :: alp_max=2.
-  CHARACTER*20 modname
-  CHARACTER*80 abort_message
-
-
-    !$OMP THREADPRIVATE(ale_max,alp_max)
-
-       ! Calcul de l'energie disponible ALE (J/kg) et de la puissance
-       ! disponible ALP (W/m2) pour le soulevement des particules dans
-       ! le modele convectif
-       !
-       do i = 1,klon
-          ALE(i) = 0.
-          ALP(i) = 0.
-       enddo
-       !
-       !calcul de ale_wake et alp_wake
-       if (iflag_wake>=1) then
-          if (itap .le. it_wape_prescr) then
-             do i = 1,klon
-                ale_wake(i) = wape_prescr
-                alp_wake(i) = fip_prescr
-             enddo
-          else
-             do i = 1,klon
-                !jyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
-                !cc           ale_wake(i) = 0.5*wake_cstar(i)**2
-                ale_wake(i) = wake_pe(i)
-                alp_wake(i) = wake_fip(i)
-             enddo
-          endif
-       else
-          do i = 1,klon
-             ale_wake(i) = 0.
-             alp_wake(i) = 0.
-          enddo
-       endif
-       !combinaison avec ale et alp de couche limite: constantes si pas
-       !de couplage, valeurs calculees dans le thermique sinon
-       if (iflag_coupl.eq.0) then
-          if (debut.and.prt_level.gt.9) &
-               WRITE(lunout,*)'ALE et ALP imposes'
-          do i = 1,klon
-             !on ne couple que ale
-             !           ALE(i) = max(ale_wake(i),Ale_bl(i))
-             ALE(i) = max(ale_wake(i),ale_bl_prescr)
-             !on ne couple que alp
-             !           ALP(i) = alp_wake(i) + Alp_bl(i)
-             ALP(i) = alp_wake(i) + alp_bl_prescr
-          enddo
-       else
-          IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique'
-          !         do i = 1,klon
-          !             ALE(i) = max(ale_wake(i),Ale_bl(i))
-          ! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
-          !             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
-          !         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
-          !         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
-          !         enddo
-
-          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-          ! Modif FH 2010/04/27. Sans doute temporaire.
-          ! Deux options pour le alp_offset : constant si >?? 0 ou
-          ! proportionnel ??a w si <0
-          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-          ! Estimation d'une vitesse verticale effective pour ALP
-          if (1==0) THEN
-             www(1:klon)=0.
-             do k=2,klev-1
-                do i=1,klon
-                   www(i)=max(www(i),-omega(i,k)*RD*t_seri(i,k) &
-                        /(RG*paprs(i,k)) *zw2(i,k)*zw2(i,k))
-                   ! if (paprs(i,k)>pbase(i)) then
-                   ! calcul approche de la vitesse verticale en m/s
-                   !  www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k))
-                   !             endif
-                   !   Le 0.1 est en gros H / ps = 1e4 / 1e5
-                enddo
-             enddo
-             do i=1,klon
-                if (www(i)>0. .and. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i)
-             enddo
-          ENDIF
-
-
-          do i = 1,klon
-             ALE(i) = max(ale_wake(i),Ale_bl(i))
-             !cc nrlmd le 10/04/2012----------Stochastic triggering------------
-             if (iflag_trig_bl.ge.1) then
-                ALE(i) = max(ale_wake(i),Ale_bl_trig(i))
-             endif
-             !cc fin nrlmd le 10/04/2012
-             if (alp_offset>=0.) then
-                ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
-             else
-                abort_message ='Ne pas passer la car www non calcule'
-                CALL abort_physic (modname,abort_message,1)
-
-                ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-                !                                _                  _
-                ! Ajout d'une composante 3 * A * w w'2 a w'3 avec
-                ! w=www : w max sous pbase ou A est la fraction
-                ! couverte par les ascendances w' on utilise le fait
-                ! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE)
-                ! (on ajoute 0.1 pour les singularites)
-                ALP(i)=alp_wake(i)*(1.+3.*www(i)/( sqrt(ale_wake(i))+0.1) ) &
-                     +alp_bl(i)  *(1.+3.*www(i)/( sqrt(ale_bl(i))  +0.1) )
-                !    ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
-                !             if (alp(i)<0.) then
-                !                print*,'ALP ',alp(i),alp_wake(i) &
-                !                     ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
-                !             endif
-             endif
-          enddo
-          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-       endif
-       do i=1,klon
-          if (alp(i)>alp_max) then
-             IF(prt_level>9)WRITE(lunout,*)                             &
-                  'WARNING SUPER ALP (seuil=',alp_max, &
-                  '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i)
-             alp(i)=alp_max
-          endif
-          if (ale(i)>ale_max) then
-             IF(prt_level>9)WRITE(lunout,*)                             &
-                  'WARNING SUPER ALE (seuil=',ale_max, &
-                  '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i)
-             ale(i)=ale_max
-          endif
-       enddo
-
-       !fin calcul ale et alp
-       !=======================================================================
-
-
-  RETURN
-  END
-
+link ../phylmd/alpale.F90
Index: LMDZ6/trunk/libf/phylmdiso/alpale_th.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/alpale_th.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/alpale_th.F90	(revision 3940)
@@ -1,332 +1,1 @@
-!
-! $Id: alpale_th.F90 3531 2019-06-06 15:08:45Z fairhead $
-!
-SUBROUTINE alpale_th ( dtime, lmax_th, t_seri, cell_area,  &
-                       cin, s2, n2,  &
-                       ale_bl_trig, ale_bl_stat, ale_bl,  &
-                       alp_bl, alp_bl_stat, &
-                       proba_notrig, random_notrig, birth_rate)
-
-! **************************************************************
-! *
-! ALPALE_TH                                                    *
-! *
-! *
-! written by   : Jean-Yves Grandpeix, 11/05/2016              *
-! modified by :                                               *
-! **************************************************************
-
-  USE dimphy
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
-!
-  IMPLICIT NONE
-
-!================================================================
-! Auteur(s)   : Jean-Yves Grandpeix, 11/05/2016
-! Objet : Contribution of the thermal scheme to Ale and Alp
-!================================================================
-
-! Input arguments
-!----------------
-  REAL, INTENT(IN)                                           :: dtime
-  REAL, DIMENSION(klon), INTENT(IN)                          :: cell_area
-  INTEGER, DIMENSION(klon), INTENT(IN)                       :: lmax_th
-  REAL, DIMENSION(klon,klev), INTENT(IN)                     :: t_seri
-  REAL, DIMENSION(klon), INTENT(IN)                          :: ale_bl_stat
-  REAL, DIMENSION(klon), INTENT(IN)                          :: cin
-  REAL, DIMENSION(klon), INTENT(IN)                          :: s2, n2
-                                                                
-  REAL, DIMENSION(klon), INTENT(INOUT)                       :: ale_bl_trig, ale_bl
-  REAL, DIMENSION(klon), INTENT(INOUT)                       :: alp_bl
-  REAL, DIMENSION(klon), INTENT(INOUT)                       :: alp_bl_stat
-  REAL, DIMENSION(klon), INTENT(INOUT)                       :: proba_notrig
-
-  REAL, DIMENSION(klon), INTENT(OUT)                         :: random_notrig
-
-  REAL, DIMENSION(klon), INTENT(OUT)                         :: birth_rate
-
-  include "thermcell.h"
-
-! Local variables
-!----------------
-  INTEGER                                                    :: i
-  LOGICAL, SAVE                                              :: first = .TRUE.
-  REAL, SAVE                                                 :: random_notrig_max=1.
-  REAL, SAVE                                                 :: cv_feed_area
-  REAL                                                       :: birth_number
-  REAL, DIMENSION(klon)                                      :: ale_bl_ref
-  REAL, DIMENSION(klon)                                      :: tau_trig
-!
-    !$OMP THREADPRIVATE(random_notrig_max) 
-    !$OMP THREADPRIVATE(cv_feed_area) 
-    !$OMP THREADPRIVATE(first)
-!
- REAL umexp  ! expression of (1.-exp(-x))/x valid for all x, especially when x->0
- REAL x
-     CHARACTER (LEN=20) :: modname='alpale_th'
-     CHARACTER (LEN=80) :: abort_message
-     
- umexp(x) = max(sign(1.,x-1.e-3),0.)*(1.-exp(-x))/max(x,1.e-3) + &
-            (1.-max(sign(1.,x-1.e-3),0.))*(1.-0.5*x*(1.-x/3.*(1.-0.25*x)))  !!! correct formula            (jyg)
-!!!            (1.-max(sign(1.,x-1.e-3),0.))*(-0.5*x*(1.-x/3.*(1.-0.25*x))) !!! bug introduced by mistake  (jyg)
-!!!            (1.-max(sign(1.,x-1.e-3),0.))*(1.-0.5*x*(1.-x/3.*(1.-0.25*x)))  !!! initial correct formula (jyg)
-!
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!  JYG, 20160513 : Introduction of the Effective Lifting Power (ELP), which 
-! takes into account the area (cv_feed_area) covered by thermals contributing 
-! to each cumulonimbus.
-!   The use of ELP prevents singularities when the trigger probability tends to
-! zero. It is activated by iflag_clos_bl = 3.
-!   The ELP values are stored in the ALP_bl variable.
-!   
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!
-!!
-!!  The following 3 lines should be commented if one wants to activate the 
-!! multiplication of no-trigger probabilities between calls to the convection 
-!! scheme.
-!!
-             do i=1,klon
-                proba_notrig(i)=1.
-             enddo
-!!
-!!
-!---------------------------------------
-  IF (iflag_clos_bl .LT. 3) THEN
-!---------------------------------------
-!
-!      Original code (Nicolas Rochetin)
-!     --------------------------------
-
-    IF (first) THEN
-       random_notrig_max=1.
-       CALL getin_p('random_notrig_max',random_notrig_max)
-       first=.FALSE.
-    ENDIF
-          !cc nrlmd le 10/04/2012
-          !-----------Stochastic triggering-----------
-          if (iflag_trig_bl.ge.1) then
-             !
-             IF (prt_level .GE. 10) THEN
-                WRITE(lunout,*)'cin, ale_bl_stat, alp_bl, alp_bl_stat ', &
-                     cin, ale_bl_stat, alp_bl, alp_bl_stat
-             ENDIF
-
-
-             !----Initialisations
-             do i=1,klon
-!!jyg                proba_notrig(i)=1.
-                random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
-                if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
-                if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then 
-                   tau_trig(i)=tau_trig_shallow
-                else
-                   tau_trig(i)=tau_trig_deep
-                endif
-             enddo
-             !
-             IF (prt_level .GE. 10) THEN
-                WRITE(lunout,*)'random_notrig, tau_trig ', &
-                     random_notrig, tau_trig
-                WRITE(lunout,*)'s_trig,s2,n2 ', &
-                     s_trig,s2,n2
-             ENDIF
-
-             !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
-             IF (iflag_trig_bl.eq.1) then
-
-                !----Tirage al\'eatoire et calcul de ale_bl_trig
-                do i=1,klon
-                   if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
-                      proba_notrig(i)=proba_notrig(i)* &
-                         (1.-exp(-s_trig/s2(i)))**(n2(i)*dtime/tau_trig(i))
-                      !        print *, 'proba_notrig(i) ',proba_notrig(i)
-                      if (random_notrig(i) .ge. proba_notrig(i)) then 
-                         ale_bl_trig(i)=ale_bl_stat(i)
-                      else
-                         ale_bl_trig(i)=0.
-                      endif
-                      birth_rate(i) = n2(i)*exp(-s_trig/s2(i))/(tau_trig(i)*cell_area(i))
-!!!                      birth_rate(i) = max(birth_rate(i),1.e-18)
-                   else
-!!jyg                      proba_notrig(i)=1.
-                      birth_rate(i) = 0.
-                      random_notrig(i)=0.
-                      ale_bl_trig(i)=0.
-                   endif
-                enddo
-
-             ELSE IF (iflag_trig_bl.ge.2) then
-
-                do i=1,klon
-                   if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
-                      proba_notrig(i)=proba_notrig(i)* &
-                         (1.-exp(-s_trig/s2(i)))**(n2(i)*dtime/tau_trig(i))
-                      !        print *, 'proba_notrig(i) ',proba_notrig(i)
-                      if (random_notrig(i) .ge. proba_notrig(i)) then 
-                         ale_bl_trig(i)=Ale_bl(i)
-                      else
-                         ale_bl_trig(i)=0.
-                      endif
-                      birth_rate(i) = n2(i)*exp(-s_trig/s2(i))/(tau_trig(i)*cell_area(i))
-!!!                      birth_rate(i) = max(birth_rate(i),1.e-18)
-                   else
-!!jyg                      proba_notrig(i)=1.
-                      birth_rate(i) = 0.
-                      random_notrig(i)=0.
-                      ale_bl_trig(i)=0.
-                   endif
-                enddo
-
-             ENDIF
-
-             !
-             IF (prt_level .GE. 10) THEN
-                WRITE(lunout,*)'proba_notrig, ale_bl_trig ', &
-                     proba_notrig, ale_bl_trig
-             ENDIF
-
-          endif !(iflag_trig_bl)
-
-          !-----------Statistical closure-----------
-          if (iflag_clos_bl.eq.1) then 
-
-             do i=1,klon
-                !CR: alp probabiliste
-                if (ale_bl_trig(i).gt.0.) then
-                   alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
-                endif
-             enddo
-
-          else if (iflag_clos_bl.eq.2) then
-
-             !CR: alp calculee dans thermcell_main
-             do i=1,klon
-                alp_bl(i)=alp_bl_stat(i)
-             enddo
-
-          else
-
-             alp_bl_stat(:)=0.
-
-          endif !(iflag_clos_bl)
-
-!
-!---------------------------------------
-  ELSEIF (iflag_clos_bl .EQ. 3) THEN  ! (iflag_clos_bl .LT. 3)
-!---------------------------------------
-!
-!      New code with Effective Lifting Power
-!     -------------------------------------
-    IF (first) THEN
-       cv_feed_area = 1.e10   ! m2
-       CALL getin_p('cv_feed_area', cv_feed_area)
-       first=.FALSE.
-    ENDIF
-
-          !-----------Stochastic triggering-----------
-     if (iflag_trig_bl.ge.1) then
-        !
-        IF (prt_level .GE. 10) THEN
-           WRITE(lunout,*)'cin, ale_bl_stat, alp_bl_stat ', &
-                cin, ale_bl_stat, alp_bl_stat
-        ENDIF
-
-        ! Use ale_bl_stat (Rochetin's code) or ale_bl (old code) according to 
-        ! iflag_trig_bl value.
-        IF (iflag_trig_bl.eq.1) then         ! use ale_bl_stat (Rochetin computation)
-         do i=1,klon
-              ale_bl_ref(i)=ale_bl_stat(i)
-         enddo
-        ELSE IF (iflag_trig_bl.ge.2) then    ! use ale_bl (old computation)
-         do i=1,klon
-              ale_bl_ref(i)=Ale_bl(i)
-         enddo
-        ENDIF ! (iflag_trig_bl.eq.1)
-
-
-        !----Initializations and random number generation
-        do i=1,klon
-!!jyg           proba_notrig(i)=1.
-           random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
-           if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then 
-              tau_trig(i)=tau_trig_shallow
-           else
-              tau_trig(i)=tau_trig_deep
-           endif
-        enddo
-        !
-        IF (prt_level .GE. 10) THEN
-           WRITE(lunout,*)'random_notrig, tau_trig ', &
-                random_notrig, tau_trig
-           WRITE(lunout,*)'s_trig,s2,n2 ', &
-                s_trig,s2,n2
-        ENDIF
-
-        !----alp_bl computation
-        do i=1,klon
-           if ( (ale_bl_ref(i) .gt. abs(cin(i))+1.e-10) )  then
-              birth_number = n2(i)*exp(-s_trig/s2(i))
-              birth_rate(i) = birth_number/(tau_trig(i)*cell_area(i))
-!!!              birth_rate(i) = max(birth_rate(i),1.e-18)
-              proba_notrig(i)=proba_notrig(i)*exp(-birth_number*dtime/tau_trig(i))
-              Alp_bl(i) = Alp_bl(i)* &
-                          umexp(-birth_number*cv_feed_area/cell_area(i))/ &
-                          umexp(-birth_number*dtime/tau_trig(i))*  &
-                          tau_trig(i)*cv_feed_area/(dtime*cell_area(i))
-          else 
-!!jyg              proba_notrig(i)=1.
-              birth_rate(i)=0.
-              random_notrig(i)=0.
-              alp_bl(i)=0.
-           endif
-        enddo
-
-        !----ale_bl_trig computation
-         do i=1,klon
-           if (random_notrig(i) .ge. proba_notrig(i)) then 
-              ale_bl_trig(i)=ale_bl_ref(i)
-           else
-              ale_bl_trig(i)=0.
-           endif
-         enddo
-
-        !
-        IF (prt_level .GE. 10) THEN
-           WRITE(lunout,*)'proba_notrig, ale_bl_trig ', &
-                proba_notrig, ale_bl_trig
-        ENDIF
-
-     endif !(iflag_trig_bl .ge. 1)
-
-!---------------------------------------
-  ENDIF ! (iflag_clos_bl .LT. 3)
-!---------------------------------------
-
-          IF (prt_level .GE. 10) THEN
-             WRITE(lunout,*)'alpale_th: ale_bl_trig, alp_bl_stat, birth_rate ', &
-                      ale_bl_trig(1), alp_bl_stat(1), birth_rate(1)
-          ENDIF
-
-          !cc fin nrlmd le 10/04/2012
-!
-          !IM/FH: 2011/02/23 
-          ! Couplage Thermiques/Emanuel seulement si T<0
-          if (iflag_coupl==2) then
-             IF (prt_level .GE. 10) THEN
-                WRITE(lunout,*)'Couplage Thermiques/Emanuel seulement si T<0'
-             ENDIF
-             do i=1,klon
-                if (t_seri(i,lmax_th(i))>273.) then
-                   Ale_bl(i)=0.
-                endif
-             enddo
-!    print *,'In order to run with iflag_coupl=2, you have to comment out the following stop'
-!             STOP
-             abort_message='In order to run with iflag_coupl=2, you have to comment out the following abort'
-             CALL abort_physic(modname,abort_message,1)
-          endif
-   RETURN
-   END
-
+link ../phylmd/alpale_th.F90
Index: LMDZ6/trunk/libf/phylmdiso/alpale_wk.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/alpale_wk.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/alpale_wk.F90	(revision 3940)
@@ -1,84 +1,1 @@
-SUBROUTINE alpale_wk ( dtime, cell_area, zoccur, sigmaw, wdens, fip ,  &
-                       fip_cond)
-
-! **************************************************************
-!                                                              *
-! ALPALE_WK                                                    *
-!                                                              *
-!                                                              *
-! written by   : Jean-Yves Grandpeix, 07/08/2017               *
-! modified by :                                                *
-! **************************************************************
-
-  USE dimphy, ONLY: klon
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
-!
-  IMPLICIT NONE
-
-!================================================================
-! Auteur(s)   : Jean-Yves Grandpeix, 07/08/2017
-! Objet : Contribution of the wake scheme to Ale and Alp
-!================================================================
-
-! Input arguments
-!----------------
-  REAL, INTENT(IN)                                           :: dtime
-  REAL, DIMENSION(klon),    INTENT(IN)                       :: cell_area
-  INTEGER, DIMENSION(klon), INTENT (IN)                      :: zoccur
-  REAL, DIMENSION(klon),    INTENT(IN)                       :: sigmaw
-  REAL, DIMENSION(klon),    INTENT(IN)                       :: wdens
-  REAL, DIMENSION(klon),    INTENT(IN)                       :: fip
-! Output arguments
-!-----------------
-  REAL, DIMENSION(klon), INTENT(OUT)                         :: fip_cond
-
-
-! Local variables
-!----------------
-  INTEGER                                                    :: i
-  LOGICAL, SAVE                                              :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-  REAL, ALLOCATABLE, SAVE, DIMENSION(:)                      :: cellrad
-  !$OMP THREADPRIVATE(cellrad)
-  REAL, DIMENSION(klon)                                      :: wkrad
-  REAL, DIMENSION(klon)                                      :: proba_gf
-
-  INCLUDE "YOMCST.h"   ! rpi
-
-IF (first) THEN
-  ALLOCATE (cellrad(klon))
-!  Compute pseudo grid-cell radius cellrad, such that pi*cellrad^2=cell_area
-  print *,'alpale_wk: cell_area(1) ',cell_area(1)
-  cellrad(:)=sqrt(cell_area(:)/rpi)
-  first = .FALSE.
-ENDIF
-
-!  Compute wake radius
-!!  print *,'alpale_wk: sigmaw(1), wdens(1) ', sigmaw(1), wdens(1)
-  DO i = 1,klon
-    IF (zoccur(i) .GE. 1) THEN
-      wkrad(i) = sqrt(sigmaw(i)/(rpi*wdens(i)))
-    ELSE
-      wkrad(i) = 0.
-    ENDIF ! (zoccur(i) .GE. 1)
-  ENDDO
-
-!  Compute probability that the grid-cell is intersected by a gust front
-!!  print *,'alpale_wk: wkrad(1), cellrad(1) ', wkrad(1), cellrad(1)
-!!  proba_gf(:) = exp(-wdens(:)*rpi*max(wkrad(:)-cellrad(:),0.)**2) - &   ! Formules
-!!                exp(-wdens(:)*rpi*(wkrad(:)+cellrad(:))**2)             ! fausses !
-  proba_gf(:) = 1. - exp(-wdens(:)*rpi*((wkrad(:)+cellrad(:))**2 - &
-                                        max(wkrad(:)-cellrad(:),0.)**2) )
-!
-  proba_gf(:) = max(proba_gf(:),1.e-3)
-!  Compute Fip conditionned on the presence of some gust front within the 
-!  grid-cell
-!!  print *,'alpale_wk: proba_gf(1), fip(1), ', proba_gf(1), fip(1)
-  fip_cond(:) = fip(:)/proba_gf(:)
-!!    print *,'alpale_wk: wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1) ', &
-!!                        wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1)
-
-   RETURN
-   END SUBROUTINE alpale_wk
-
+link ../phylmd/alpale_wk.F90
Index: LMDZ6/trunk/libf/phylmdiso/atm2geo.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/atm2geo.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/atm2geo.F90	(revision 3940)
@@ -1,72 +1,1 @@
-!
-! $Id: atm2geo.F90 3465 2019-03-14 09:34:31Z fairhead $
-!
-SUBROUTINE atm2geo ( im, jm, pte, ptn, plon, plat, pxx, pyy, pzz )
-  USE dimphy
-  USE mod_phys_lmdz_para
-  USE mod_grid_phy_lmdz, only: grid_type, unstructured, regular_lonlat
-  IMPLICIT NONE
-  INCLUDE 'YOMCST.h'
-
-  CHARACTER (len = 6)                :: clmodnam
-  CHARACTER (len = 20)               :: modname = 'atm2geo'
-  CHARACTER (len = 80)               :: abort_message
-
-!
-! Change wind local atmospheric coordinates to geocentric
-!
-! Geocentric :
-! axe x is eastward : crosses (0 N, 0 E) point.
-! axe y crosses (0 N, 90 E) point.
-! axe z is 'up' : crosses north pole
-  INTEGER, INTENT (in)                 :: im, jm
-  REAL, DIMENSION (im,jm), INTENT (in) :: pte  ! Eastward vector component
-  REAL, DIMENSION (im,jm), INTENT (in) :: ptn  ! Northward vector component
-  REAL, DIMENSION (im,jm), INTENT (in) :: plon, plat
-  REAL, DIMENSION (im,jm), INTENT(out) :: pxx, pyy, pzz  ! Component in the geocentric referential 
-  REAL :: rad, reps
-
-  rad = rpi / 180.0E0
-  reps = 1.0e-5
-  
-  pxx(:,:) = & 
-       - pte(:,:) * SIN(rad * plon(:,:)) &
-       - ptn(:,:) * SIN(rad * plat(:,:)) * COS(rad * plon(:,:))
-
-  pyy(:,:) = &
-       + pte(:,:) * COS(rad * plon(:,:)) &
-       - ptn(:,:) * SIN(rad * plat(:,:)) * SIN(rad * plon(:,:))
-  
-  pzz(:,:) = &
-       + ptn(:,:) * COS(rad * plat (:,:))
-  
-  IF (grid_type==regular_lonlat) THEN
-  ! Value at North Pole  
-    IF (is_north_pole_dyn) THEN
-       pxx(:, 1) = - pte (1, 1)
-       pyy(:, 1) = - ptn (1, 1) 
-       pzz(:, 1) = pzz(1,1) ! => 0
-    ENDIF
-
-  ! Value at South Pole
-    IF (is_south_pole_dyn) THEN
-      pxx(:,jm) = pxx(1,jm)
-       pyy(:,jm) = pyy(1,jm)
-       pzz(:,jm) = pzz(1,jm) ! => 0
-    ENDIF
- 
-  ELSE IF (grid_type==unstructured) THEN
-     ! Pole nord pour Dynamico
-     WHERE ( plat(:,:) >= 90.0d+0-reps )
-        pxx (:,:) = -ptn (:,:)
-        pyy (:,:) =  pte (:,:)
-        pzz (:,:) =  0.0e0
-     END WHERE
-
-  ELSE
-     abort_message='Problem: unknown grid type'
-     CALL abort_physic(modname,abort_message,1)
-  END IF
-
-  
-END SUBROUTINE atm2geo
+link ../phylmd/atm2geo.F90
Index: LMDZ6/trunk/libf/phylmdiso/borne_var_surf.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/borne_var_surf.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/borne_var_surf.F90	(revision 3940)
@@ -1,111 +1,1 @@
-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
-
-!==================================================================
-! 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
-!==================================================================
-
-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.EQ.-2.AND.q2m(i,nsrf).LT.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.EQ.-1.AND.(ftsol(i,nsrf).LE.t1(i).OR.q2m(i,nsrf).LT.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.EQ.1.AND.ftsol(i,nsrf).LE.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.EQ.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
-!==================================================================
-
-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
-END
-
-
+link ../phylmd/borne_var_surf.F90
Index: LMDZ6/trunk/libf/phylmdiso/buffer_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/buffer_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/buffer_mod.F90	(revision 3940)
@@ -1,86 +1,1 @@
-MODULE buffer_mod
-
-PRIVATE
-  REAL,PARAMETER :: grow_factor=1.5
-
-  INTEGER, POINTER, SAVE :: buffer_i(:)
-  INTEGER,SAVE :: size_buffer_i = 0
-!$OMP THREADPRIVATE(buffer_i,size_buffer_i)
-
-  REAL,POINTER,SAVE      :: buffer_r(:)
-  INTEGER,SAVE :: size_buffer_r = 0 
-!$OMP THREADPRIVATE(buffer_r,size_buffer_r)
-  
-  LOGICAL,POINTER,SAVE   :: buffer_l(:)
-  INTEGER,SAVE :: size_buffer_l = 0
-!$OMP THREADPRIVATE(buffer_l,size_buffer_l)
-
-  CHARACTER,POINTER,SAVE :: buffer_c(:)
-  INTEGER,SAVE :: size_buffer_c = 0
-!$OMP THREADPRIVATE(buffer_c,size_buffer_c)
-
-INTERFACE get_buffer
-  MODULE PROCEDURE get_buffer_i, get_buffer_r, get_buffer_l, get_buffer_c
-END INTERFACE
-  
-PUBLIC :: get_buffer
-
-CONTAINS
-
-  SUBROUTINE get_buffer_i(buff,buff_size)
-  IMPLICIT NONE
-    INTEGER,POINTER    :: buff(:)
-    INTEGER,INTENT(IN) :: buff_size 
-
-    IF (buff_size>size_buffer_i) THEN
-      DEALLOCATE(buffer_i)
-      size_buffer_i=MAX(2,INT(size_buffer_i*grow_factor))
-      ALLOCATE(buffer_i(size_buffer_i))
-    ENDIF
-    
-    buff=>buffer_i
-  END SUBROUTINE get_buffer_i
-
-  SUBROUTINE get_buffer_r(buff,buff_size)
-  IMPLICIT NONE
-    REAL,POINTER       :: buff(:)
-    INTEGER,INTENT(IN) :: buff_size 
-
-    IF (buff_size>size_buffer_r) THEN
-      DEALLOCATE(buffer_r)
-      size_buffer_r=MAX(2,INT(size_buffer_r*grow_factor))
-      ALLOCATE(buffer_r(size_buffer_r))
-    ENDIF
-    
-    buff=>buffer_r
-  END SUBROUTINE get_buffer_r
-
-  SUBROUTINE get_buffer_l(buff,buff_size)
-  IMPLICIT NONE
-    LOGICAL,POINTER    :: buff(:)
-    INTEGER,INTENT(IN) :: buff_size 
-
-    IF (buff_size>size_buffer_l) THEN
-      DEALLOCATE(buffer_l)
-      size_buffer_l=MAX(2,INT(size_buffer_l*grow_factor))
-      ALLOCATE(buffer_l(size_buffer_l))
-    ENDIF
-    
-    buff=>buffer_l
-  END SUBROUTINE get_buffer_l
-  
-  SUBROUTINE get_buffer_c(buff,buff_size)
-  IMPLICIT NONE
-    CHARACTER,POINTER  :: buff(:)
-    INTEGER,INTENT(IN) :: buff_size 
-
-    IF (buff_size>size_buffer_c) THEN
-      DEALLOCATE(buffer_c)
-      size_buffer_c=MAX(2,INT(size_buffer_c*grow_factor))
-      ALLOCATE(buffer_c(size_buffer_c))
-    ENDIF
-    
-    buff=>buffer_c
-  END SUBROUTINE get_buffer_c
-  
-END MODULE buffer_mod
+link ../phylmd/buffer_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/cal_tools_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cal_tools_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cal_tools_m.F90	(revision 3940)
@@ -1,89 +1,1 @@
-MODULE cal_tools_m
-
-  USE ioipsl, ONLY: ioconf_calendar, ioget_mon_len, lock_calendar,             &
-                     ioget_calendar, ioget_year_len
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-!
-FUNCTION year_len(y,cal_in)
-!
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER                                :: year_len
-  INTEGER,                    INTENT(IN) :: y
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: cal_in
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=20) :: cal_lmdz
-!-------------------------------------------------------------------------------
-  !--- No specified calendar: we need lmdz days number for current year
-  IF(.NOT.PRESENT(cal_in)) THEN; year_len=ioget_year_len(y); RETURN; END IF
-
-  !--- Get the lmdz calendar to reset at the end of the function
-  CALL ioget_calendar(cal_lmdz)
-
-  !--- Unlock calendar and set it to wanted one
-  CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
-
-  !--- Get the number of days in this year
-  year_len=ioget_year_len(y)
-
-  !--- Back to original calendar
-  CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_lmdz))
-
-END FUNCTION year_len
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-FUNCTION mid_month(y,cal_in)
-!
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER,                    INTENT(IN) :: y           ! year
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: cal_in      ! calendar
-  REAL,                    DIMENSION(14) :: mid_month   ! mid-bins times
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=20)      :: cal_lmdz          ! lmdz current calendar
-  INTEGER, DIMENSION(14) :: tlen              ! months lengths (days)
-  INTEGER                :: m                 ! months counter
-  INTEGER                :: nd                ! number of days
-!-------------------------------------------------------------------------------
-  IF(PRESENT(cal_in)) THEN
-    CALL ioget_calendar(cal_lmdz)             !--- Keep track of lmdz calendar
-    CALL lock_calendar(.FALSE.)               !--- Unlock calendar
-    CALL ioconf_calendar(TRIM(cal_in))        !--- Change calendar to "cal_in"
-  END IF
-
-  !--- Get the length of each month
-  tlen(1 )=ioget_mon_len(y-1,12)
-  DO m=1,12; tlen(m+1)=ioget_mon_len(y,m); END DO
-  tlen(14)=ioget_mon_len(y+1, 1)
-
-  !--- Mid-bins times
-  mid_month(1)=-0.5*REAL(tlen(1))
-  DO m=2,14; mid_month(m)=mid_month(m-1)+0.5*REAL(tlen(m-1)+tlen(m)); END DO
-
-  IF(PRESENT(cal_in)) THEN
-    CALL lock_calendar(.FALSE.)               !--- Unlock calendar
-    CALL ioconf_calendar(TRIM(cal_lmdz))      !--- Restore original calendar
-  END IF
-
-END FUNCTION mid_month
-!
-!-------------------------------------------------------------------------------
-
-
-END MODULE cal_tools_m
-!
-!*******************************************************************************
-
+link ../phylmd/cal_tools_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/calbeta.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calbeta.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/calbeta.F90	(revision 3940)
@@ -1,102 +1,1 @@
-!
-! $Header$
-!
-SUBROUTINE calbeta(dtime,indice,knon,snow,qsol, &
-     vbeta,vcal,vdif)
-
-  USE dimphy
-  USE indice_sol_mod
-  IMPLICIT none
-!======================================================================
-! Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM au LMD)
-! date: 19940414
-!======================================================================
-!
-! Calculer quelques parametres pour appliquer la couche limite
-! ------------------------------------------------------------ 
-! Variables d'entrees
-!****************************************************************************************
-  REAL, INTENT(IN)                   :: dtime
-  INTEGER, INTENT(IN)                :: indice
-  INTEGER, INTENT(IN)                :: knon
-  REAL, DIMENSION(klon), INTENT(IN)  :: snow
-  REAL, DIMENSION(klon), INTENT(IN)  :: qsol
-
-  
-! Variables de sorties
-!****************************************************************************************
-  REAL, DIMENSION(klon), INTENT(OUT) :: vbeta
-  REAL, DIMENSION(klon), INTENT(OUT) :: vcal
-  REAL, DIMENSION(klon), INTENT(OUT) :: vdif
-
-! Variables locales
-!****************************************************************************************
-  REAL, PARAMETER :: tau_gl=86400.0*5.0 ! temps de relaxation pour la glace de mer
-!cc      PARAMETER (tau_gl=86400.0*30.0)
-  REAL, PARAMETER :: mx_eau_sol=150.0
-  REAL, PARAMETER :: calsol=1.0/(2.5578E+06*0.15)
-  REAL, PARAMETER :: calsno=1.0/(2.3867E+06*0.15)
-  REAL, PARAMETER :: calice=1.0/(5.1444E+06*0.15)
-  
-  INTEGER         :: i
-
-!****************************************************************************************  
-   
-  vbeta(:) = 0.0
-  vcal(:) = 0.0
-  vdif(:) = 0.0
-  
-  IF (indice.EQ.is_oce) THEN
-     DO i = 1, knon
-        vcal(i)   = 0.0
-        vbeta(i)  = 1.0
-        vdif(i) = 0.0
-     ENDDO
-  ENDIF
-  
-  IF (indice.EQ.is_sic) THEN
-     DO i = 1, knon
-        vcal(i) = calice
-        IF (snow(i) .GT. 0.0) vcal(i) = calsno
-        vbeta(i)  = 1.0
-        vdif(i) = 1.0/tau_gl
-!          vdif(i) = calice/tau_gl ! c'etait une erreur
-     ENDDO
-  ENDIF
-  
-  IF (indice.EQ.is_ter) THEN
-     DO i = 1, knon
-        vcal(i) = calsol
-        IF (snow(i) .GT. 0.0) vcal(i) = calsno
-        vbeta(i)  = MIN(2.0*qsol(i)/mx_eau_sol, 1.0)
-        vdif(i) = 0.0
-     ENDDO
-  ENDIF
-  
-  IF (indice.EQ.is_lic) THEN
-     DO i = 1, knon
-        vcal(i) = calice
-        IF (snow(i) .GT. 0.0) vcal(i) = calsno
-        vbeta(i)  = 1.0
-        vdif(i) = 0.0
-     ENDDO
-  ENDIF
-  
-END SUBROUTINE calbeta
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+link ../phylmd/calbeta.F90
Index: LMDZ6/trunk/libf/phylmdiso/calbeta_clim.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calbeta_clim.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/calbeta_clim.F90	(revision 3940)
@@ -1,72 +1,1 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/calbeta.F90,v 1.2 2007/06/22 12:49:51
-! fairhead Exp $
-!
-
-SUBROUTINE calbeta_clim(klon,time,lat_radian,beta)
-
-  !======================================================================
-  ! Auteur(s): A.K. TRAORE
-  !======================================================================
-
-  !USE phys_local_var_mod, ONLY : ideal_beta !pour faire la variable dans le
-  ! physiq.f pour des sorties directes de beta
-
-  USE phys_cal_mod, only: year_len
-  USE print_control_mod, ONLY: prt_level
-
-  implicit none
-  integer klon,nt,j,it
-  real logbeta(klon),pi
-  real lat(klon),lat_radian(klon)
-  integer time
-  real time_radian
-  real lat_sahel,beta(klon)
-  real lat_nord,lat_sud
-
-  !==============================================
-
-  pi=2.*asin(1.)
-  beta=0.
-
-  !calcul des cordonnees
-
-  ! print*,'LATITUDES BETA ',lat_radian
-  time_radian=(time+15.)*2.*pi / year_len
-
-  if (prt_level >= 1) print *, 'time_radian time', time_radian, time
-
-  lat(:)=180.*lat_radian(:)/pi !lat(:)=lat_radian(:)
-
-  lat_sahel=-5*sin(time_radian)+13
-  lat_nord=lat_sahel+25.
-  lat_sud=lat_sahel-25.
-  do j=1,klon
-     !===========
-     if (lat(j) < 5. ) then
-
-        logbeta(j)=0.2*(lat(j)-lat_sud)-1.6
-        beta(j)=10**(logbeta(j))
-        beta(j)=max(beta(j),0.03)
-        beta(j)=min(beta(j),0.22)
-        ! print*,'j,lat,lat_radian,beta',j,lat(j),lat_radian(j),beta(j)
-        !===========
-     elseif (lat(j) < 22.) then !lat(j)<22.
-
-        logbeta(j)=-0.25*(lat(j)-lat_sahel)-1.6
-        beta(j)=10**(logbeta(j))
-        beta(j)=max(beta(j),1.e-2)
-        beta(j)=min(beta(j),0.22)
-        ! print*,'j,lat,lat_radian,beta',j,lat(j),lat_radian(j),beta(j)
-        !===========
-     else
-        logbeta(j)=0.25*(lat(j)-lat_nord)-1.
-        beta(j)=10**(logbeta(j))
-        beta(j)=max(beta(j),1.e-2)
-        beta(j)=min(beta(j),0.25)
-        ! print*,'j,lat,lat_radian,beta',j,lat(j),lat_radian(j),beta(j)
-     endif
-     !===========
-  enddo
-
-end SUBROUTINE calbeta_clim
+link ../phylmd/calbeta_clim.F90
Index: LMDZ6/trunk/libf/phylmdiso/calcratqs.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calcratqs.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/calcratqs.F90	(revision 3940)
@@ -1,188 +1,1 @@
-SUBROUTINE calcratqs(klon,klev,prt_level,lunout,       &
-           iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
-           ratqsbas,ratqshaut,ratqsp0,ratqsdp, &
-           tau_ratqs,fact_cldcon,   &
-           ptconv,ptconvth,clwcon0th, rnebcon0th,      &
-           paprs,pplay,q_seri,zqsat,fm_therm,          &
-           ratqs,ratqsc)
-
-implicit none
-
-!========================================================================
-! Computation of ratqs, the width of the subrid scale water distribution
-! (normalized by the mean value)
-! Various options controled by flags iflag_con and iflag_ratqs
-! F Hourdin 2012/12/06
-!========================================================================
-
-! Declarations
-
-! Input
-integer,intent(in) :: klon,klev,prt_level,lunout
-integer,intent(in) :: iflag_con,iflag_cld_th,iflag_ratqs
-real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
-real,intent(in) :: ratqsp0, ratqsdp
-real, dimension(klon,klev+1),intent(in) :: paprs
-real, dimension(klon,klev),intent(in) :: pplay,q_seri,zqsat,fm_therm
-logical, dimension(klon,klev),intent(in) :: ptconv
-real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
-
-! Output
-real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc
-logical, dimension(klon,klev),intent(inout) :: ptconvth
-
-! local
-integer i,k
-real, dimension(klon,klev) :: ratqss
-real facteur,zfratqs1,zfratqs2
-
-!-------------------------------------------------------------------------
-!  Caclul des ratqs
-!-------------------------------------------------------------------------
-
-!      print*,'calcul des ratqs'
-!   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q
-!   ----------------
-!   on ecrase le tableau ratqsc calcule par clouds_gno
-      if (iflag_cld_th.eq.1) then
-         do k=1,klev
-         do i=1,klon
-            if(ptconv(i,k)) then
-              ratqsc(i,k)=ratqsbas &
-              +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
-            else
-               ratqsc(i,k)=0.
-            endif
-         enddo
-         enddo
-
-!-----------------------------------------------------------------------
-!  par nversion de la fonction log normale
-!-----------------------------------------------------------------------
-      else if (iflag_cld_th.eq.4) then
-         ptconvth(:,:)=.false.
-         ratqsc(:,:)=0.
-         if(prt_level.ge.9) print*,'avant clouds_gno thermique'
-         call clouds_gno &
-         (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
-         if(prt_level.ge.9) print*,' CLOUDS_GNO OK'
-       
-       endif
-
-!   ratqs stables
-!   -------------
-
-      if (iflag_ratqs.eq.0) then
-
-! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
-         do k=1,klev
-            do i=1, klon
-               ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* &
-               min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) 
-            enddo 
-         enddo
-
-! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de 
-! 300 hPa (ratqshaut), varie lineariement en fonction de la pression
-! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1
-! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2
-! Il s'agit de differents tests dans la phase de reglage du modele
-! avec thermiques.
-
-      else if (iflag_ratqs.eq.1) then
-
-         do k=1,klev
-            do i=1, klon
-               if (pplay(i,k).ge.60000.) then
-                  ratqss(i,k)=ratqsbas
-               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
-                  ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
-               else
-                  ratqss(i,k)=ratqshaut
-               endif
-            enddo
-         enddo
-
-      else if (iflag_ratqs.eq.2) then
-
-         do k=1,klev
-            do i=1, klon
-               if (pplay(i,k).ge.60000.) then
-                  ratqss(i,k)=ratqsbas*(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
-               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
-                    ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
-               else
-                    ratqss(i,k)=ratqshaut
-               endif
-            enddo
-         enddo
-
-      else if (iflag_ratqs==3) then
-         do k=1,klev
-           ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) &
-           *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. )
-         enddo
-
-      else if (iflag_ratqs==4) then
-         do k=1,klev
-           ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
-!          *( tanh( (50000.-pplay(:,k))/20000.) + 1.)
-           *( tanh( (ratqsp0-pplay(:,k))/ratqsdp) + 1.)
-         enddo
-
-      endif
-
-
-
-
-!  ratqs final
-!  -----------
-
-      if (iflag_cld_th.eq.1 .or.iflag_cld_th.eq.2.or.iflag_cld_th.eq.4) then
-
-! On ajoute une constante au ratqsc*2 pour tenir compte de 
-! fluctuations turbulentes de petite echelle
-
-         do k=1,klev
-            do i=1,klon
-               if ((fm_therm(i,k).gt.1.e-10)) then
-                  ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
-               endif
-            enddo
-         enddo
-
-!   les ratqs sont une combinaison de ratqss et ratqsc
-       if(prt_level.ge.9) write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
-
-         if (tau_ratqs>1.e-10) then
-            facteur=exp(-pdtphys/tau_ratqs)
-         else
-            facteur=0.
-         endif
-         ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH 22/09/2009
-! La ligne ci-dessous faisait osciller le modele et donnait une solution
-! assymptotique bidon et dépendant fortement du pas de temps.
-!        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-         ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
-      else if (iflag_cld_th<=6) then
-!   on ne prend que le ratqs stable pour fisrtilp
-         ratqs(:,:)=ratqss(:,:)
-      else
-          zfratqs1=exp(-pdtphys/10800.)
-          zfratqs2=exp(-pdtphys/10800.)
-          do k=1,klev
-             do i=1,klon
-                if (ratqsc(i,k).gt.1.e-10) then
-                   ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cld_th/100.)*ratqsc(i,k)*(1.-zfratqs2)
-                endif
-                ratqs(i,k)=min(ratqs(i,k)*zfratqs1+ratqss(i,k)*(1.-zfratqs1),0.5)
-             enddo
-          enddo
-      endif
-
-
-return
-end
+link ../phylmd/calcratqs.F90
Index: LMDZ6/trunk/libf/phylmdiso/calcratqs_inter.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calcratqs_inter.F90	(revision 3940)
+++ LMDZ6/trunk/libf/phylmdiso/calcratqs_inter.F90	(revision 3940)
@@ -0,0 +1,1 @@
+link ../phylmd/calcratqs_inter.F90
Index: LMDZ6/trunk/libf/phylmdiso/calcul_REGDYN.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calcul_REGDYN.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/calcul_REGDYN.h	(revision 3940)
@@ -1,22 +1,1 @@
-c
-c $Header$
-c
-c calculs statistiques distribution nuage ftion du regime dynamique 
-c
-c Ce calcul doit etre fait a partir de valeurs mensuelles ??
-      CALL histo_o500_pctau(nbregdyn,pct_ocean,o500,fq_isccp,
-     &histoW,nhistoW)
-c
-c nhistoWt = somme de toutes les nhistoW
-      DO nreg=1, nbregdyn
-       DO k = 1, kmaxm1
-        DO l = 1, lmaxm1
-         DO iw = 1, iwmax
-          nhistoWt(k,l,iw,nreg)=nhistoWt(k,l,iw,nreg)+
-     &    nhistoW(k,l,iw,nreg)
-         ENDDO
-        ENDDO
-       ENDDO
-      ENDDO
-c
-cIM 190504 END
+link ../phylmd/calcul_REGDYN.h
Index: LMDZ6/trunk/libf/phylmdiso/calcul_STDlev.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calcul_STDlev.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/calcul_STDlev.h	(revision 3940)
@@ -1,239 +1,1 @@
-!
-! $Header$
-!
-!IM on initialise les variables 
-!
-!       missing_val=nf90_fill_real
-!
-       IF (.not. ok_all_xml) then
-        CALL ini_undefSTD(itap,itapm1)
-       ENDIF
-!
-!IM on interpole les champs sur les niveaux STD de pression 
-!IM a chaque pas de temps de la physique
-!
-!-------------------------------------------------------c
-! positionnement de l'argument logique a .false.        c
-! pour ne pas recalculer deux fois la meme chose !      c
-! a cet effet un appel a plevel_new a ete deplace       c
-! a la fin de la serie d'appels                         c
-! la boucle 'DO k=1, nlevSTD' a ete internalisee        c
-! dans plevel_new, d'ou la creation de cette routine... c
-!-------------------------------------------------------c
-!
-        CALL plevel_new(klon,klev,nlevSTD,.true.,pplay,rlevSTD, &
-                    t_seri,tlevSTD)
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   u_seri,ulevSTD)
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   v_seri,vlevSTD)
-!
-
-!
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zphi/RG,philevSTD)
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   qx(:,:,ivap),qlevSTD)
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_rh*100.,rhlevSTD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=u_seri(i,l)*v_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,uvSTD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*q_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,vqSTD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*t_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,vTSTD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=omega(i,l)*qx(i,l,ivap)
-         ENDDO !i 
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,wqSTD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*zphi(i,l)/RG
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,vphiSTD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=omega(i,l)*t_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,wTSTD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=u_seri(i,l)*u_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,u2STD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*v_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,v2STD)
-!
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=t_seri(i,l)*t_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,T2STD)
-
-!
-      zx_tmp_fi3d(:,:)=wo(:,:,1) * dobson_u * 1e3 / zmasse / rmo3 * rmd
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,O3STD)
-!
-      if (read_climoz == 2) THEN
-      zx_tmp_fi3d(:,:)=wo(:,:,2) * dobson_u * 1e3 / zmasse / rmo3 * rmd
-        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, &
-                   zx_tmp_fi3d,O3daySTD)
-      endif
-!
-        DO l=1, klev
-        DO i=1, klon
-         zx_tmp_fi3d(i,l)=paprs(i,l)
-        ENDDO !i
-        ENDDO !l
-        CALL plevel_new(klon,klev,nlevSTD,.true.,zx_tmp_fi3d,rlevSTD, &
-                   omega,wlevSTD)
-!
-!IM on somme les valeurs toutes les freq_calNMC secondes
-!IM on moyenne a la fin du mois, du jour ou toutes les 6h
-!
-       IF (.not. ok_all_xml) then
-        CALL undefSTD(itap, read_climoz)
-        CALL moy_undefSTD(itap,itapm1)
-       ENDIF
-!
-       CALL plevel(klon,klev,.true.,pplay,50000., &
-                    zphi/RG,geo500)
-
-!IM on interpole a chaque pas de temps le SWup(clr) et SWdn(clr) a 200 hPa
-!
-      CALL plevel(klon,klevp1,.true.,paprs,20000., &
-           swdn0,SWdn200clr)
-      CALL plevel(klon,klevp1,.false.,paprs,20000., &
-           swdn,SWdn200)
-      CALL plevel(klon,klevp1,.false.,paprs,20000., &
-           swup0,SWup200clr)
-      CALL plevel(klon,klevp1,.false.,paprs,20000., &
-           swup,SWup200)
-!
-      CALL plevel(klon,klevp1,.false.,paprs,20000., &
-           lwdn0,LWdn200clr)
-      CALL plevel(klon,klevp1,.false.,paprs,20000., &
-           lwdn,LWdn200)
-      CALL plevel(klon,klevp1,.false.,paprs,20000., &
-           lwup0,LWup200clr)
-      CALL plevel(klon,klevp1,.false.,paprs,20000., &
-           lwup,LWup200)
-!
-      twriteSTD(:,:,1)=tsumSTD(:,:,1)
-      qwriteSTD(:,:,1)=qsumSTD(:,:,1)
-      rhwriteSTD(:,:,1)=rhsumSTD(:,:,1)
-      phiwriteSTD(:,:,1)=phisumSTD(:,:,1)
-      uwriteSTD(:,:,1)=usumSTD(:,:,1)
-      vwriteSTD(:,:,1)=vsumSTD(:,:,1)
-      wwriteSTD(:,:,1)=wsumSTD(:,:,1)
-
-      twriteSTD(:,:,2)=tsumSTD(:,:,2)
-      qwriteSTD(:,:,2)=qsumSTD(:,:,2)
-      rhwriteSTD(:,:,2)=rhsumSTD(:,:,2)
-      phiwriteSTD(:,:,2)=phisumSTD(:,:,2)
-      uwriteSTD(:,:,2)=usumSTD(:,:,2)
-      vwriteSTD(:,:,2)=vsumSTD(:,:,2)
-      wwriteSTD(:,:,2)=wsumSTD(:,:,2)
-
-      twriteSTD(:,:,3)=tlevSTD(:,:)
-      qwriteSTD(:,:,3)=qlevSTD(:,:)
-      rhwriteSTD(:,:,3)=rhlevSTD(:,:)
-      phiwriteSTD(:,:,3)=philevSTD(:,:)
-      uwriteSTD(:,:,3)=ulevSTD(:,:)
-      vwriteSTD(:,:,3)=vlevSTD(:,:)
-      wwriteSTD(:,:,3)=wlevSTD(:,:)
-
-      twriteSTD(:,:,4)=tlevSTD(:,:)
-      qwriteSTD(:,:,4)=qlevSTD(:,:)
-      rhwriteSTD(:,:,4)=rhlevSTD(:,:)
-      phiwriteSTD(:,:,4)=philevSTD(:,:)
-      uwriteSTD(:,:,4)=ulevSTD(:,:)
-      vwriteSTD(:,:,4)=vlevSTD(:,:)
-      wwriteSTD(:,:,4)=wlevSTD(:,:)
-!
-!IM initialisation 5eme fichier de sortie 
-      twriteSTD(:,:,5)=tlevSTD(:,:)
-      qwriteSTD(:,:,5)=qlevSTD(:,:)
-      rhwriteSTD(:,:,5)=rhlevSTD(:,:)
-      phiwriteSTD(:,:,5)=philevSTD(:,:)
-      uwriteSTD(:,:,5)=ulevSTD(:,:)
-      vwriteSTD(:,:,5)=vlevSTD(:,:)
-      wwriteSTD(:,:,5)=wlevSTD(:,:)
-!
-!IM initialisation 6eme fichier de sortie 
-      twriteSTD(:,:,6)=tlevSTD(:,:)
-      qwriteSTD(:,:,6)=qlevSTD(:,:)
-      rhwriteSTD(:,:,6)=rhlevSTD(:,:)
-      phiwriteSTD(:,:,6)=philevSTD(:,:)
-      uwriteSTD(:,:,6)=ulevSTD(:,:)
-      vwriteSTD(:,:,6)=vlevSTD(:,:)
-      wwriteSTD(:,:,6)=wlevSTD(:,:)
-!IM for NMC files
-      DO n=1, nlevSTD3
-       DO k=1, nlevSTD
-        if(rlevSTD3(n).EQ.rlevSTD(k)) THEN
-         twriteSTD3(:,n)=tlevSTD(:,k)
-         qwriteSTD3(:,n)=qlevSTD(:,k)
-         rhwriteSTD3(:,n)=rhlevSTD(:,k)
-         phiwriteSTD3(:,n)=philevSTD(:,k)
-         uwriteSTD3(:,n)=ulevSTD(:,k)
-         vwriteSTD3(:,n)=vlevSTD(:,k)
-         wwriteSTD3(:,n)=wlevSTD(:,k)
-        endif !rlevSTD3(n).EQ.rlevSTD(k)
-       ENDDO 
-      ENDDO 
-!
-      DO n=1, nlevSTD8
-       DO k=1, nlevSTD
-        if(rlevSTD8(n).EQ.rlevSTD(k)) THEN
-         tnondefSTD8(:,n)=tnondef(:,k,2)
-         twriteSTD8(:,n)=tsumSTD(:,k,2)
-         qwriteSTD8(:,n)=qsumSTD(:,k,2)
-         rhwriteSTD8(:,n)=rhsumSTD(:,k,2)
-         phiwriteSTD8(:,n)=phisumSTD(:,k,2)
-         uwriteSTD8(:,n)=usumSTD(:,k,2)
-         vwriteSTD8(:,n)=vsumSTD(:,k,2)
-         wwriteSTD8(:,n)=wsumSTD(:,k,2)
-        endif !rlevSTD8(n).EQ.rlevSTD(k)
-       ENDDO 
-      ENDDO 
+link ../phylmd/calcul_STDlev.h
Index: LMDZ6/trunk/libf/phylmdiso/calcul_divers.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calcul_divers.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/calcul_divers.h	(revision 3940)
@@ -1,57 +1,1 @@
-!
-! $Id: calcul_divers.h 3435 2019-01-22 15:21:59Z fairhead $
-!
-!
-! Initialisations diverses au tout debut
-      IF(itap.EQ.1) THEN
-         itapm1=0
-      ENDIF
-
-! Initialisation debut de mois
-      IF(itap.EQ.itapm1+1) THEN
-        nday_rain(:)=0.
-!       print*,'initialisation mois suivants day_rain itap',itap
-      ENDIF
-
-! Calcul fin de journee : total_rain, nday_rain
-      IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
-!        print*,'calcul nday_rain itap ',itap
-         DO i = 1, klon
-            total_rain(i)=rain_fall(i)+snow_fall(i)  
-            IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.
-         ENDDO
-      ENDIF
-
-! Initialisation fin de mois
-      IF(MOD(itap-itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.0) THEN
-        itapm1=itapm1+NINT(mth_len*un_jour/phys_tstep)
-!       print*,'initialisation itapm1 ',itapm1
-      ENDIF
-!
-! calcul temperatures minimale et maximale moyennees sur le mois 
-!
-!initialisation debut de mois ou de journee pour les fichiers mensuels
-  IF(itap.EQ.itapm1+1) THEN
-     t2m_min_mon=0.
-     t2m_max_mon=0.
-  ENDIF
-  IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN
-     zt2m_min_mon=zt2m
-     zt2m_max_mon=zt2m
-  ENDIF
-!calcul a chaque pas de temps pour les fichiers mensuels
-     DO i = 1, klon
-        zt2m_min_mon(i)=MIN(zt2m(i),zt2m_min_mon(i))
-        zt2m_max_mon(i)=MAX(zt2m(i),zt2m_max_mon(i))
-     ENDDO
-!fin de journee
-  IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
-   t2m_min_mon=t2m_min_mon+zt2m_min_mon 
-   t2m_max_mon=t2m_max_mon+zt2m_max_mon 
-  ENDIF
-!fin mois
-  IF(itap==itapm1) THEN
-   t2m_min_mon=t2m_min_mon/mth_len
-   t2m_max_mon=t2m_max_mon/mth_len
-  ENDIF
-!
+link ../phylmd/calcul_divers.h
Index: LMDZ6/trunk/libf/phylmdiso/calcul_fluxs_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/calcul_fluxs_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/calcul_fluxs_mod.F90	(revision 3940)
@@ -1,341 +1,1 @@
-!
-! $Id: calcul_fluxs_mod.F90 3319 2018-04-30 15:45:16Z jyg $
-!
-MODULE calcul_fluxs_mod
-
-  IMPLICIT NONE
-
-CONTAINS
-  SUBROUTINE calcul_fluxs( knon, nisurf, dtime, &
-       tsurf, p1lay, cal, beta, cdragh, cdragq, ps, &
-       precip_rain, precip_snow, snow, qsurf, &
-       radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay, gustiness, &
-       fqsat, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-       tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
- 
-    
-    USE dimphy, ONLY : klon
-    USE indice_sol_mod
-
-    INCLUDE "clesphys.h"
-
-! Cette routine calcule les fluxs en h et q a l'interface et eventuellement
-! une temperature de surface (au cas ou ok_veget = false)
-!
-! L. Fairhead 4/2000
-!
-! input:
-!   knon         nombre de points a traiter
-!   nisurf       surface a traiter
-!   tsurf        temperature de surface
-!   p1lay        pression 1er niveau (milieu de couche)
-!   cal          capacite calorifique du sol
-!   beta         evap reelle
-!   cdragh       coefficient d'echange temperature
-!   cdragq       coefficient d'echange evaporation
-!   ps           pression au sol
-!   precip_rain  precipitations liquides
-!   precip_snow  precipitations solides
-!   snow         champs hauteur de neige
-!   runoff       runoff en cas de trop plein
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   radsol       rayonnement net aus sol (LW + SW)
-!   dif_grnd     coeff. diffusion vers le sol profond
-!
-! output:
-!   tsurf_new    temperature au sol
-!   qsurf        humidite de l'air au dessus du sol
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   dflux_s      derivee du flux de chaleur sensible / Ts
-!   dflux_l      derivee du flux de chaleur latente  / Ts
-!   sens_prec_liq flux sensible lié aux echanges de precipitations liquides
-!   sens_prec_sol                                    precipitations solides
-!   lat_prec_liq  flux latent lié aux echanges de precipitations liquides
-!   lat_prec_sol                                  precipitations solides
-
-    INCLUDE "YOETHF.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "YOMCST.h"
-
-! Parametres d'entree
-!****************************************************************************************
-    INTEGER, INTENT(IN)                  :: knon, nisurf
-    REAL   , INTENT(IN)                  :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)    :: petAcoef, peqAcoef
-    REAL, DIMENSION(klon), INTENT(IN)    :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)    :: ps, q1lay
-    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf, p1lay, cal, beta, cdragh,cdragq
-    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow ! pas utiles
-    REAL, DIMENSION(klon), INTENT(IN)    :: radsol, dif_grnd
-    REAL, DIMENSION(klon), INTENT(IN)    :: t1lay, u1lay, v1lay,gustiness
-    REAL,                  INTENT(IN)    :: fqsat ! correction factor on qsat (generally 0.98 over salty water, 1 everywhere else)
-
-! Parametres entree-sorties
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT) :: snow  ! snow pas utile
-
-! Parametres sorties
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)   :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)   :: tsurf_new, evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)   :: dflux_s, dflux_l
-    REAL, DIMENSION(klon), OPTIONAL      :: sens_prec_liq, sens_prec_sol
-    REAL, DIMENSION(klon), OPTIONAL      :: lat_prec_liq, lat_prec_sol
-
-! Variables locales
-!****************************************************************************************
-    INTEGER                              :: i
-    REAL, DIMENSION(klon)                :: zx_mh, zx_nh, zx_oh
-    REAL, DIMENSION(klon)                :: zx_mq, zx_nq, zx_oq
-    REAL, DIMENSION(klon)                :: zx_pkh, zx_dq_s_dt, zx_qsat
-    REAL, DIMENSION(klon)                :: zx_sl, zx_coefh, zx_coefq, zx_wind
-    REAL, DIMENSION(klon)                :: d_ts
-    REAL                                 :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh
-    REAL                                 :: qsat_new, q1_new
-    REAL, PARAMETER                      :: t_grnd = 271.35, t_coup = 273.15
-    REAL, PARAMETER                      :: max_eau_sol = 150.0
-    CHARACTER (len = 20)                 :: modname = 'calcul_fluxs'
-    LOGICAL                              :: fonte_neige
-    LOGICAL, SAVE                        :: check = .FALSE.
-    !$OMP THREADPRIVATE(check)
-
-! End definition
-!****************************************************************************************
-
-    IF (check) WRITE(*,*)'Entree ', modname,' surface = ',nisurf
-    
-    IF (check) THEN
-       WRITE(*,*)' radsol (min, max)', &
-            MINVAL(radsol(1:knon)), MAXVAL(radsol(1:knon))
-    ENDIF
-  
-! Traitement neige et humidite du sol
-!****************************************************************************************
-!
-!!$  WRITE(*,*)'test calcul_flux, surface ', nisurf
-!!PB test
-!!$    if (nisurf == is_oce) then
-!!$      snow = 0.
-!!$      qsol = max_eau_sol
-!!$    else
-!!$      where (precip_snow > 0.) snow = snow + (precip_snow * dtime)
-!!$      where (snow > epsilon(snow)) snow = max(0.0, snow - (evap * dtime))
-!!$!      snow = max(0.0, snow + (precip_snow - evap) * dtime)
-!!$      where (precip_rain > 0.) qsol = qsol + (precip_rain - evap) * dtime
-!!$    endif 
-!!$    IF (nisurf /= is_ter) qsol = max_eau_sol
-
-
-! 
-! Initialisation
-!****************************************************************************************
-    evap = 0.
-    fluxsens=0.
-    fluxlat=0.
-    dflux_s = 0.
-    dflux_l = 0.
-    if (PRESENT(sens_prec_liq)) sens_prec_liq = 0.
-    if (PRESENT(sens_prec_sol)) sens_prec_sol = 0.
-    if (PRESENT(lat_prec_liq)) lat_prec_liq = 0.
-    if (PRESENT(lat_prec_sol)) lat_prec_sol = 0.
-!
-! zx_qs = qsat en kg/kg
-!****************************************************************************************
-    DO i = 1, knon
-       zx_pkh(i) = (ps(i)/ps(i))**RKAPPA
-       IF (thermcep) THEN
-          zdelta=MAX(0.,SIGN(1.,rtt-tsurf(i)))
-          zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-          zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q1lay(i))
-          zx_qs= r2es * FOEEW(tsurf(i),zdelta)/ps(i)
-          zx_qs=MIN(0.5,zx_qs)
-          zcor=1./(1.-retv*zx_qs)
-          zx_qs=zx_qs*zcor
-          zx_dq_s_dh = FOEDE(tsurf(i),zdelta,zcvm5,zx_qs,zcor) &
-               /RLVTT / zx_pkh(i)
-       ELSE
-          IF (tsurf(i).LT.t_coup) THEN
-             zx_qs = qsats(tsurf(i)) / ps(i)
-             zx_dq_s_dh = dqsats(tsurf(i),zx_qs)/RLVTT &
-                  / zx_pkh(i)
-          ELSE
-             zx_qs = qsatl(tsurf(i)) / ps(i)
-             zx_dq_s_dh = dqsatl(tsurf(i),zx_qs)/RLVTT &
-                  / zx_pkh(i)
-          ENDIF
-       ENDIF
-       zx_dq_s_dt(i) = RCPD * zx_pkh(i) * zx_dq_s_dh
-       zx_qsat(i) = zx_qs
-       zx_wind(i)=min_wind_speed+SQRT(gustiness(i)+u1lay(i)**2+v1lay(i)**2)
-       zx_coefh(i) = cdragh(i) * zx_wind(i) * p1lay(i)/(RD*t1lay(i))
-       zx_coefq(i) = cdragq(i) * zx_wind(i) * p1lay(i)/(RD*t1lay(i))
-!      zx_wind(i)=min_wind_speed+SQRT(gustiness(i)+u1lay(i)**2+v1lay(i)**2) &
-!                * p1lay(i)/(RD*t1lay(i))
-!      zx_coefh(i) = cdragh(i) * zx_wind(i)
-!      zx_coefq(i) = cdragq(i) * zx_wind(i)
-    ENDDO
-
-
-! === Calcul de la temperature de surface ===
-! zx_sl = chaleur latente d'evaporation ou de sublimation
-!****************************************************************************************
-
-    DO i = 1, knon
-       zx_sl(i) = RLVTT
-       IF (tsurf(i) .LT. RTT) zx_sl(i) = RLSTT
-    ENDDO
-    
-
-    DO i = 1, knon
-! Q
-       zx_oq(i) = 1. - (beta(i) * zx_coefq(i) * peqBcoef(i) * dtime)
-       zx_mq(i) = beta(i) * zx_coefq(i) * &
-            (peqAcoef(i) -             &
-! conv num avec precedente version
-            fqsat * zx_qsat(i) + fqsat * zx_dq_s_dt(i) * tsurf(i))  &
-!           fqsat * ( zx_qsat(i) - zx_dq_s_dt(i) * tsurf(i)) ) &
-            / zx_oq(i)
-       zx_nq(i) = beta(i) * zx_coefq(i) * (- fqsat * zx_dq_s_dt(i)) &
-            / zx_oq(i)
-       
-! H
-       zx_oh(i) = 1. - (zx_coefh(i) * petBcoef(i) * dtime)
-       zx_mh(i) = zx_coefh(i) * petAcoef(i) / zx_oh(i)
-       zx_nh(i) = - (zx_coefh(i) * RCPD * zx_pkh(i))/ zx_oh(i)
-     
-! Tsurface
-       tsurf_new(i) = (tsurf(i) + cal(i)/(RCPD * zx_pkh(i)) * dtime * &
-            (radsol(i) + zx_mh(i) + zx_sl(i) * zx_mq(i)) & 
-            + dif_grnd(i) * t_grnd * dtime)/ &
-            ( 1. - dtime * cal(i)/(RCPD * zx_pkh(i)) * ( &
-            zx_nh(i) + zx_sl(i) * zx_nq(i)) &  
-            + dtime * dif_grnd(i))
-
-!
-! Y'a-t-il fonte de neige?
-!
-!    fonte_neige = (nisurf /= is_oce) .AND. &
-!     & (snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) &
-!     & .AND. (tsurf_new(i) >= RTT)
-!    if (fonte_neige) tsurf_new(i) = RTT  
-       d_ts(i) = tsurf_new(i) - tsurf(i)
-!    zx_h_ts(i) = tsurf_new(i) * RCPD * zx_pkh(i)
-!    zx_q_0(i) = zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
-
-!== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
-!== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
-       evap(i) = - zx_mq(i) - zx_nq(i) * tsurf_new(i) 
-       fluxlat(i) = - evap(i) * zx_sl(i)
-       fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
-       
-! Derives des flux dF/dTs (W m-2 K-1):
-       dflux_s(i) = zx_nh(i)
-       dflux_l(i) = (zx_sl(i) * zx_nq(i))
-
-! Nouvelle valeure de l'humidite au dessus du sol
-       qsat_new=zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
-       q1_new = peqAcoef(i) - peqBcoef(i)*evap(i)*dtime
-       qsurf(i)=q1_new*(1.-beta(i)) + beta(i)*qsat_new
-!
-! en cas de fonte de neige
-!
-!    if (fonte_neige) then
-!      bilan_f = radsol(i) + fluxsens(i) - (zx_sl(i) * evap (i)) - &
-!     &          dif_grnd(i) * (tsurf_new(i) - t_grnd) - &
-!     &          RCPD * (zx_pkh(i))/cal(i)/dtime * (tsurf_new(i) - tsurf(i))
-!      bilan_f = max(0., bilan_f)
-!      fq_fonte = bilan_f / zx_sl(i)
-!      snow(i) = max(0., snow(i) - fq_fonte * dtime)
-!      qsol(i) = qsol(i) + (fq_fonte * dtime)
-!    endif
-!!$    if (nisurf == is_ter)  &
-!!$     &  run_off(i) = run_off(i) + max(qsol(i) - max_eau_sol, 0.0)
-!!$    qsol(i) = min(qsol(i), max_eau_sol) 
-!
-! calcul de l'enthalpie des precipitations liquides et solides
-!
-!       if (PRESENT(enth_prec_liq))                   &
-!       enth_prec_liq(i) = rcw * (t1lay(i) - tsurf(i)) * &
-!                          precip_rain(i)
-!       if (PRESENT(enth_prec_sol))                  &
-!       enth_prec_sol(i) = rcs * (t1lay(i) - tsurf(i)) * &
-!                          precip_snow(i)
-! On calcule par rapport a T=0
-       if (PRESENT(sens_prec_liq))                   &
-         sens_prec_liq(i) = rcw * (t1lay(i) - RTT) * &
-                          precip_rain(i)
-       if (PRESENT(sens_prec_sol))                   &
-         sens_prec_sol(i) = rcs * (t1lay(i) - RTT) * &
-                          precip_snow(i)
-       if (PRESENT(lat_prec_liq))                    &
-         lat_prec_liq(i) =  precip_rain(i) * (RLVTT - RLVTT) 
-       if (PRESENT(lat_prec_sol))                    &
-         lat_prec_sol(i) = precip_snow(i) * (RLSTT - RLVTT)
-    ENDDO
-
-    
-!       if (PRESENT(sens_prec_liq))                  &
-!          WRITE(*,*)' calculs_fluxs sens_prec_liq (min, max)', &
-!          MINVAL(sens_prec_liq(1:knon)), MAXVAL(sens_prec_liq(1:knon))
-!       if (PRESENT(sens_prec_sol))                  &
-!          WRITE(*,*)' calculs_fluxs sens_prec_sol (min, max)', &
-!          MINVAL(sens_prec_sol(1:knon)), MAXVAL(sens_prec_sol(1:knon))
- 
-!
-!****************************************************************************************
-!
-  END SUBROUTINE calcul_fluxs
-!
-!****************************************************************************************
-!
-  SUBROUTINE calcul_flux_wind(knon, dtime, &
-       u0, v0, u1, v1, gustiness, cdrag_m, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       p1lay, t1lay, &
-       flux_u1, flux_v1)
-
-    USE dimphy
-    INCLUDE "YOMCST.h"
-    INCLUDE "clesphys.h"
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                  :: knon
-    REAL, INTENT(IN)                     :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)    :: u0, v0  ! u and v at niveau 0
-    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness  ! u and v at niveau 1
-    REAL, DIMENSION(klon), INTENT(IN)    :: cdrag_m ! cdrag pour momentum
-    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay   ! pression 1er niveau (milieu de couche)
-    REAL, DIMENSION(klon), INTENT(IN)    :: t1lay   ! temperature 
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)   :: flux_u1
-    REAL, DIMENSION(klon), INTENT(OUT)   :: flux_v1
-
-! Local variables
-!****************************************************************************************
-    INTEGER                              :: i
-    REAL                                 :: mod_wind, buf
-
-!****************************************************************************************
-! Calculate the surface flux
-!
-!****************************************************************************************
-    DO i=1,knon
-       mod_wind = min_wind_speed + SQRT(gustiness(i)+(u1(i) - u0(i))**2 + (v1(i)-v0(i))**2)
-       buf = cdrag_m(i) * mod_wind * p1lay(i)/(RD*t1lay(i))
-       flux_u1(i) = (AcoefU(i) - u0(i)) / (1/buf - BcoefU(i)*dtime )
-       flux_v1(i) = (AcoefV(i) - v0(i)) / (1/buf - BcoefV(i)*dtime )
-    END DO
-
-  END SUBROUTINE calcul_flux_wind
-!
-!****************************************************************************************
-!
-END MODULE calcul_fluxs_mod
+link ../phylmd/calcul_fluxs_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/carbon_cycle_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/carbon_cycle_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/carbon_cycle_mod.F90	(revision 3940)
@@ -1,527 +1,1 @@
-MODULE carbon_cycle_mod
-!=======================================================================
-!   Authors: Patricia Cadule and Laurent Fairhead
-!            base sur un travail anterieur mene par Patricia Cadule et Josefine Ghattas
-!
-!  Purpose and description:
-!  -----------------------
-! Control module for the carbon CO2 tracers :
-!   - Initialisation of carbon cycle fields
-!   - Definition of fluxes to be exchanged
-!
-! Rest of code is in tracco2i.F90
-!
-! Le cas online/offline est defini par le flag carbon_cycle_cpl (y/n)
-! Le transport du traceur CO2 est defini par le flag carbon_cycle_tr (y/n)
-! la provenance des champs (termes de puits) est denini par le flag level_coupling_esm
-!
-! level_coupling_esm : level of coupling of the biogeochemical fields between
-! LMDZ, ORCHIDEE and NEMO
-! Definitions of level_coupling_esm in physiq.def
-! level_coupling_esm = 0  ! No field exchange between LMDZ and ORCHIDEE models
-!                         ! No field exchange between LMDZ and NEMO
-! level_coupling_esm = 1  ! Field exchange between LMDZ and ORCHIDEE models
-!                         ! No field exchange between LMDZ and NEMO models
-! level_coupling_esm = 2  ! No field exchange between LMDZ and ORCHIDEE models
-!                         ! Field exchange between LMDZ and NEMO models
-! level_coupling_esm = 3  ! Field exchange between LMDZ and ORCHIDEE models
-!                         ! Field exchange between LMDZ and NEMO models
-!=======================================================================
-
-  IMPLICIT NONE
-  SAVE
-  PRIVATE
-  PUBLIC :: carbon_cycle_init, infocfields_init
-
-! Variables read from parmeter file physiq.def
-  LOGICAL, PUBLIC :: carbon_cycle_cpl       ! Coupling of CO2 fluxes between LMDZ/ORCHIDEE and LMDZ/OCEAN(PISCES) 
-!$OMP THREADPRIVATE(carbon_cycle_cpl)
-  LOGICAL, PUBLIC :: carbon_cycle_tr        ! 3D transport of CO2 in the atmosphere, parameter read in conf_phys
-!$OMP THREADPRIVATE(carbon_cycle_tr)
-  LOGICAL, PUBLIC :: carbon_cycle_rad       ! CO2 interactive radiatively 
-!$OMP THREADPRIVATE(carbon_cycle_rad)
-  INTEGER, PUBLIC :: level_coupling_esm ! Level of coupling for the ESM - 0, 1, 2, 3
-!$OMP THREADPRIVATE(level_coupling_esm)
-  REAL, PUBLIC :: RCO2_glo
-!$OMP THREADPRIVATE(RCO2_glo)
-  REAL, PUBLIC :: RCO2_tot
-!$OMP THREADPRIVATE(RCO2_tot)
-
-  LOGICAL :: carbon_cycle_emis_comp_omp=.FALSE.
-  LOGICAL :: carbon_cycle_emis_comp=.FALSE. ! Calculation of emission compatible
-!$OMP THREADPRIVATE(carbon_cycle_emis_comp)
-
-  LOGICAL :: RCO2_inter_omp
-  LOGICAL :: RCO2_inter  ! RCO2 interactive : if true calculate new value RCO2 for the radiation scheme
-!$OMP THREADPRIVATE(RCO2_inter)
-
-! Scalare values when no transport, from physiq.def
-  REAL :: fos_fuel_s_omp
-  REAL :: fos_fuel_s  ! carbon_cycle_fos_fuel dans physiq.def
-!$OMP THREADPRIVATE(fos_fuel_s)
-  REAL :: emis_land_s ! not yet implemented
-!$OMP THREADPRIVATE(emis_land_s)
-
-  REAL :: airetot     ! Total area of the earth surface
-!$OMP THREADPRIVATE(airetot)
-
-  INTEGER :: ntr_co2  ! Number of tracers concerning the carbon cycle
-!$OMP THREADPRIVATE(ntr_co2)
-
-! fco2_ocn_day : flux CO2 from ocean for 1 day (cumulated) [gC/m2/d]. Allocation and initalization done in cpl_mod
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocn_day 
-!$OMP THREADPRIVATE(fco2_ocn_day)
-
-  REAL, DIMENSION(:), ALLOCATABLE :: fco2_land_day   ! flux CO2 from land for 1 day (cumulated)  [gC/m2/d]
-!$OMP THREADPRIVATE(fco2_land_day)
-  REAL, DIMENSION(:), ALLOCATABLE :: fco2_lu_day     ! Emission from land use change for 1 day (cumulated) [gC/m2/d]
-!$OMP THREADPRIVATE(fco2_lu_day)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ff ! Emission from fossil fuel [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_ff)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_bb ! Emission from biomass burning [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_bb)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land  ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_land)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_nbp  ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_land_nbp)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_nep  ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_land_nep)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fLuc  ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_land_fLuc)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fwoodharvest  ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_land_fwoodharvest)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fHarvest  ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_land_fHarvest)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean ! Net flux from ocean [kgCO2/m2/s]
-!$OMP THREADPRIVATE(fco2_ocean)
-
-  REAL, DIMENSION(:,:), ALLOCATABLE :: dtr_add       ! Tracer concentration to be injected 
-!$OMP THREADPRIVATE(dtr_add)
-
-! Following 2 fields will be allocated and initialized in surf_land_orchidee
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_inst  ! flux CO2 from land at one time step
-!$OMP THREADPRIVATE(fco2_land_inst)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_lu_inst    ! Emission from land use change at one time step
-!$OMP THREADPRIVATE(fco2_lu_inst)
-
-! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE 
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0
-!$OMP THREADPRIVATE(co2_send)
-
-  INTEGER, PARAMETER, PUBLIC :: id_CO2=1              !--temporaire OB -- to be changed
-
-! nbfields : total number of fields 
-  INTEGER, PUBLIC :: nbcf
-!$OMP THREADPRIVATE(nbcf)
-
-! nbcf_in : number of fields IN
-  INTEGER, PUBLIC  :: nbcf_in
-!$OMP THREADPRIVATE(nbcf_in)
-
-! nbcf_in_orc : number of fields IN 
-  INTEGER, PUBLIC  :: nbcf_in_orc
-!$OMP THREADPRIVATE(nbcf_in_orc)
-
-! nbcf_in_inca : number of fields IN (from INCA)
-  INTEGER, PUBLIC  :: nbcf_in_inca
-!$OMP THREADPRIVATE(nbcf_in_inca)
-
-! nbcf_in_nemo : number of fields IN (from nemo)
-  INTEGER, PUBLIC  :: nbcf_in_nemo
-!$OMP THREADPRIVATE(nbcf_in_nemo)
-
-! nbcf_in_ant : number of fields IN (from anthropogenic sources)
-  INTEGER, PUBLIC  :: nbcf_in_ant
-!$OMP THREADPRIVATE(nbcf_in_ant)
-
-! nbcf_out : number of fields OUT
-  INTEGER, PUBLIC :: nbcf_out
-!$OMP THREADPRIVATE(nbcf_out)
-
-! Name of variables
-  CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname     ! coupling field short name for restart (?) and diagnostics
-!$OMP THREADPRIVATE(cfname)
-
-  CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_in  ! coupling field short name for restart (?) and diagnostics
-!$OMP THREADPRIVATE(cfname_in)
-
-  CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_out ! coupling field short name for restart (?) and diagnostics
-!$OMP THREADPRIVATE(cfname_out)
-
-  CHARACTER(len=15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_in  !  coupling field units for diagnostics
-!$OMP THREADPRIVATE(cfunits_in)
-
-  CHARACTER(len=15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_out !  coupling field units for diagnostics
-!$OMP THREADPRIVATE(cfunits_out)
-
-  CHARACTER(len=120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_in  ! coupling field long name for diagnostics
-!$OMP THREADPRIVATE(cftext_in)
-
-  CHARACTER(len=120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_out ! coupling field long name for diagnostics
-!$OMP THREADPRIVATE(cftext_out)
-
-  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod1 ! model 1 (rreference) : LMDz
-!$OMP THREADPRIVATE(cfmod1)
-
-  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod2 ! model 2
-!$OMP THREADPRIVATE(cfmod2)
-
-  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_out_names
-!$OMP THREADPRIVATE(field_out_names)
-
-  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_in_names
-!$OMP THREADPRIVATE(field_in_names)
-
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_in   !  klon,nbcf_in
-!$OMP THREADPRIVATE(fields_in)
-
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_in  !  knon,nbcf_in
-!$OMP THREADPRIVATE(yfields_in)
-
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_out  !  klon,nbcf_out
-!$OMP THREADPRIVATE(fields_out)
-
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_out !  knon,nbcf_out
-!$OMP THREADPRIVATE(yfields_out)
-
-  TYPE, PUBLIC :: co2_trac_type
-     CHARACTER(len = 8) :: name       ! Tracer name in tracer.def
-     INTEGER            :: id         ! Index in total tracer list, tr_seri
-     CHARACTER(len=30)  :: file       ! File name
-     LOGICAL            :: cpl        ! True if this tracers is coupled from ORCHIDEE or PISCES. 
-                                      ! False if read from file.
-     INTEGER            :: updatefreq ! Frequence to inject in second
-     INTEGER            :: readstep   ! Actual time step to read in file
-     LOGICAL            :: updatenow  ! True if this tracer should be updated this time step
-  END TYPE co2_trac_type
-  INTEGER,PARAMETER :: maxco2trac=5  ! Maximum number of different CO2 fluxes
-  TYPE(co2_trac_type), DIMENSION(maxco2trac) :: co2trac
-
-CONTAINS
-  
-  SUBROUTINE carbon_cycle_init()
-    ! This subroutine is called from tracco2i_init, which is called from phytrac_init only at first timestep.
-    ! - Allocate variables. These variables must be allocated before first call to phys_output_write in physiq.
-
-    USE dimphy
-    USE IOIPSL
-    USE print_control_mod, ONLY: lunout
-
-    IMPLICIT NONE
-    INCLUDE "clesphys.h"
- 
-! Local variables
-    INTEGER               :: ierr
-
-    IF (carbon_cycle_cpl) THEN
-
-       ierr=0
-
-       IF (.NOT.ALLOCATED(fco2_land)) ALLOCATE(fco2_land(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land',1)
-       fco2_land(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_land_nbp)) ALLOCATE(fco2_land_nbp(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nbp',1)
-       fco2_land_nbp(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_land_nep)) ALLOCATE(fco2_land_nep(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nep',1)
-       fco2_land_nep(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_land_fLuc)) ALLOCATE(fco2_land_fLuc(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fLuc',1)
-       fco2_land_fLuc(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_land_fwoodharvest)) ALLOCATE(fco2_land_fwoodharvest(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fwoodharvest',1)
-       fco2_land_fwoodharvest(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_land_fHarvest)) ALLOCATE(fco2_land_fHarvest(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fHarvest',1)
-       fco2_land_fHarvest(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_ff)) ALLOCATE(fco2_ff(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ff',1)
-       fco2_ff(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_bb)) ALLOCATE(fco2_bb(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_bb',1)
-       fco2_bb(1:klon) = 0.
-
-       IF (.NOT.ALLOCATED(fco2_ocean)) ALLOCATE(fco2_ocean(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean',1)
-       fco2_bb(1:klon) = 0.
-    ENDIF
-
-  END SUBROUTINE carbon_cycle_init
-
-  SUBROUTINE infocfields_init
-
-!    USE control_mod, ONLY: planet_type
-    USE phys_cal_mod, ONLY : mth_cur
-    USE mod_synchro_omp
-    USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root
-    USE mod_phys_lmdz_transfert_para
-    USE mod_phys_lmdz_omp_transfert
-    USE dimphy, ONLY: klon
-
-    IMPLICIT NONE
-
-!=======================================================================
-!
-!   Authors: Patricia Cadule and Laurent Fairhead  
-!   -------
-!
-!  Purpose and description:
-!  -----------------------
-!
-! Infofields
-! this routine enables to define the field exchanges in both directions between
-! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this
-! routing might apply to other models (e.g., NEMO, INCA, ...).
-! Therefore, currently with this routine, it is possible to define the coupling
-! fields only between LMDZ and ORCHIDEE.
-! The coupling_fields.def file enables to define the name of the exchanged
-! fields at the coupling interface.
-! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE
-! (LMDZ to ORCHIDEE)
-! field_out_names : the set of names of the exchanged fields in output of
-! ORCHIDEE (ORCHIDEE to LMDZ)
-! n : the number of exchanged fields at th coupling interface
-! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE)
-! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ)
-!
-! The syntax for coupling_fields.def is as follows:
-! IMPORTANT: each column entry must be separated from the previous one by 3
-! spaces and only that
-! field name         coupling          model 1         model 2         long_name
-!                    direction
-!   10char  -3spaces-  3char  -3spaces- 4char -3spaces- 4char -3spaces-  30char 
-!
-! n
-! FIELD1 IN LMDZ ORC
-! ....
-! FIELD(j) IN LMDZ ORC
-! FIELD(j+1) OUT LMDZ ORC
-! ...
-! FIELDn OUT LMDZ ORC   
-! 
-!=======================================================================
-!   ... 22/12/2017 ....
-!-----------------------------------------------------------------------
-! Declarations
-
-  INCLUDE "clesphys.h"
-  INCLUDE "dimensions.h"
-  INCLUDE "iniprint.h"
-
-! Local variables
-
-  INTEGER :: iq,  ierr, stat, error
-
-  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), SAVE  :: cfname_root
-  CHARACTER(LEN=120), ALLOCATABLE, DIMENSION(:), SAVE :: cftext_root
-  CHARACTER(LEN=15), ALLOCATABLE, DIMENSION(:), SAVE  :: cfunits_root
-
-  CHARACTER(len=3), ALLOCATABLE, DIMENSION(:) :: cfintent_root
-  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod1_root
-  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod2_root
-
-  LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_in_root
-  LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_out_root
-
-  CHARACTER(len=*),parameter :: modname="infocfields"
-
-  CHARACTER(len=10),SAVE :: planet_type="earth"
-
-!-----------------------------------------------------------------------
-
-nbcf=0
-nbcf_in=0
-nbcf_out=0
-
-IF (planet_type=='earth') THEN
-
-    IF (is_mpi_root .AND. is_omp_root) THEN
-
-       IF (level_coupling_esm.GT.0) THEN
-
-          OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr)
-
-          IF (ierr.EQ.0) THEN
-
-             WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'
-             READ(200,*) nbcf
-             WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf
-             ALLOCATE(cfname_root(nbcf))
-             ALLOCATE(cfintent_root(nbcf))
-             ALLOCATE(cfmod1_root(nbcf))
-             ALLOCATE(cfmod2_root(nbcf))
-             ALLOCATE(cftext_root(nbcf))
-             ALLOCATE(cfunits_root(nbcf))
-             ALLOCATE(mask_in_root(nbcf))
-             ALLOCATE(mask_out_root(nbcf))
-
-             nbcf_in=0
-             nbcf_out=0
-
-             DO iq=1,nbcf
-                WRITE(lunout,*) 'infofields : field=',iq
-                READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &
-                   cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)
-                cfname_root(iq)=TRIM(cfname_root(iq))
-                cfintent_root(iq)=TRIM(cfintent_root(iq))
-                cfmod1_root(iq)=TRIM(cfmod1_root(iq))
-                cfmod2_root(iq)=TRIM(cfmod2_root(iq))
-                cftext_root(iq)=TRIM(cftext_root(iq))
-                cfunits_root(iq)=TRIM(cfunits_root(iq))
-                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &  
-                               ', number: ',iq,', INTENT: ',cfintent_root(iq)
-                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), & 
-                               ', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)
-                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), & 
-                               ', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)
-                IF (nbcf_in+nbcf_out.LT.nbcf) THEN
-                  IF (cfintent_root(iq).NE.'OUT') THEN
-                    nbcf_in=nbcf_in+1
-                    mask_in_root(iq)=.TRUE.
-                    mask_out_root(iq)=.FALSE.
-                  ELSE IF (cfintent_root(iq).EQ.'OUT') THEN
-                    nbcf_out=nbcf_out+1
-                    mask_in_root(iq)=.FALSE.
-                    mask_out_root(iq)=.TRUE.
-                  ENDIF
-                ELSE
-                  WRITE(lunout,*) 'abort_gcm --- nbcf    : ',nbcf
-                  WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
-                  WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
-                  CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
-               ENDIF
-             ENDDO !DO iq=1,nbcf
-          ELSE
-             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'
-             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'
-          ENDIF ! ierr
-          CLOSE(200)
-
-       ENDIF ! level_coupling_esm
-
-    ENDIF !   (is_mpi_root .AND. is_omp_root)
-!$OMP BARRIER
-
-    CALL bcast(nbcf)
-    CALL bcast(nbcf_in)
-    CALL bcast(nbcf_out)
-
-    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf    =',nbcf
-    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in
-    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out
-
-    ALLOCATE(cfname(nbcf))
-    ALLOCATE(cfname_in(nbcf_in))
-    ALLOCATE(cftext_in(nbcf_in))
-    ALLOCATE(cfname_out(nbcf_out))
-    ALLOCATE(cftext_out(nbcf_out))
-    ALLOCATE(cfmod1(nbcf))
-    ALLOCATE(cfmod2(nbcf))
-    ALLOCATE(cfunits_in(nbcf_in))
-    ALLOCATE(cfunits_out(nbcf_out))
-       
-    IF (is_mpi_root .AND. is_omp_root) THEN
-
-        IF (nbcf.GT.0)     cfname=cfname_root
-        IF (nbcf_in.GT.0)  cfname_in=PACK(cfname_root,mask_in_root)
-        IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root)
-        IF (nbcf_in.GT.0)  cftext_in=PACK(cftext_root,mask_in_root)
-        IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root)
-        IF (nbcf.GT.0)     cfmod1=cfmod1_root
-        IF (nbcf.GT.0)     cfmod2=cfmod2_root
-        IF (nbcf_in.GT.0)  cfunits_in=PACK(cfunits_root,mask_in_root)
-        IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root)
-
-        nbcf_in_orc=0
-        nbcf_in_nemo=0
-        nbcf_in_inca=0
-        nbcf_in_ant=0
-
-        DO iq=1,nbcf
-            IF (cfmod1(iq) == "ORC")  nbcf_in_orc  = nbcf_in_orc  + 1  
-            IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1  
-            IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1
-            IF (cfmod1(iq) == "ALL")  nbcf_in_orc  = nbcf_in_orc  + 1  ! ALL = ORC/NEMO/INCA
-            IF (cfmod1(iq) == "ALL")  nbcf_in_nemo = nbcf_in_nemo + 1  ! ALL = ORC/NEMO/INCA 
-            IF (cfmod1(iq) == "ALL")  nbcf_in_inca = nbcf_in_inca + 1  ! ALL = ORC/NEMO/INCA 
-            IF (cfmod1(iq) == "ANT")  nbcf_in_ant  = nbcf_in_ant  + 1  
-        ENDDO
-
-    ENDIF !   (is_mpi_root .AND. is_omp_root)
-!$OMP BARRIER
-
-    CALL bcast(nbcf_in_orc)
-    CALL bcast(nbcf_in_nemo)
-    CALL bcast(nbcf_in_inca)
-    CALL bcast(nbcf_in_ant)
-
-    WRITE(lunout,*) 'nbcf_in_orc  =',nbcf_in_orc
-    WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo
-    WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca
-    WRITE(lunout,*) 'nbcf_in_ant  =',nbcf_in_ant
-
-    IF (nbcf_in.GT.0) THEN 
-        DO iq=1,nbcf_in
-          CALL bcast(cfname_in(iq))
-          CALL bcast(cftext_in(iq))
-          CALL bcast(cfunits_in(iq))
-        ENDDO
-    ENDIF
-
-    IF (nbcf_out.GT.0) THEN
-        DO iq=1,nbcf_out
-          CALL bcast(cfname_out(iq))
-          CALL bcast(cftext_out(iq))
-          CALL bcast(cfunits_out(iq))
-        ENDDO
-    ENDIF
-
-    IF (nbcf.GT.0) THEN
-        DO iq=1,nbcf
-          CALL bcast(cfmod1(iq))
-          CALL bcast(cfmod2(iq))
-        ENDDO
-    ENDIF
-
-    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in
-    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out
-
-    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in
-    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out
-
-    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1 
-    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2 
-
-    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in
-    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out
-
-    IF (nbcf_in.GT.0)  WRITE(*,*)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in
-    IF (nbcf_out.GT.0) WRITE(*,*)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out
-
- ELSE
- ! Default values for other planets
-    nbcf=0 
-    nbcf_in=0
-    nbcf_out=0
- ENDIF ! planet_type
-
- ALLOCATE(fields_in(klon,nbcf_in),stat=error)
- IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_in',1)
- ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
- IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_in',1)
- ALLOCATE(fields_out(klon,nbcf_out),stat=error)
- IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_out',1)
- ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
- IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_out',1)
-
-END SUBROUTINE infocfields_init
-
-END MODULE carbon_cycle_mod
+link ../phylmd/carbon_cycle_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/cdrag_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cdrag_mod.F90	(revision 3940)
+++ LMDZ6/trunk/libf/phylmdiso/cdrag_mod.F90	(revision 3940)
@@ -0,0 +1,1 @@
+link ../phylmd/cdrag_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/cfmip_point_locations.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cfmip_point_locations.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cfmip_point_locations.F90	(revision 3940)
@@ -1,120 +1,1 @@
-MODULE cfmip_point_locations
-  IMPLICIT NONE
-
-CONTAINS
-
- SUBROUTINE read_CFMIP_point_locations(npCFMIP, tab, lonCFMIP, latCFMIP)
-  IMPLICIT none
-  INTEGER :: npCFMIP
-  REAL, DIMENSION(npCFMIP) :: lonCFMIP, latCFMIP
-  INTEGER :: tab(npCFMIP), np
-
-  WRITE(*,*) 'npCFMIP=',npCFMIP
-! OPEN(20, file="pointlocations.txt",status='old')
-  OPEN(20, file="pointlocations.txt",status='old',err=999)
-  OPEN(21, file="pointlocations_lon180.txt")
-  np=1
-10 READ(20,*) tab(np), lonCFMIP(np), latCFMIP(np)
-!!! passage de 0-360 a -180/180
-   IF (lonCFMIP(np).GT.180.) THEN
-    lonCFMIP(np)=lonCFMIP(np)-360.
-   ENDIF 
-   WRITE(21,*) np, lonCFMIP(np), latCFMIP(np)
-   np=np+1
-   IF(np.LE.npCFMIP) THEN 
-    GOTO 10
-   ENDIF
-   CLOSE(20)
-   CLOSE(21)
-999 RETURN
- END SUBROUTINE read_CFMIP_point_locations
-
- SUBROUTINE LMDZ_CFMIP_point_locations(npCFMIP, lonCFMIP, latCFMIP, &
-  tabijGCM, lonGCM, latGCM, ipt, jpt)
-  USE dimphy
-  USE iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
-
-  IMPLICIT none 
-  INTEGER :: npCFMIP
-  REAL, DIMENSION(npCFMIP) :: lonCFMIP, latCFMIP
-  INTEGER :: i, j, np, ip
-  INTEGER, DIMENSION(npCFMIP) :: ipt, jpt 
-  REAL :: dlon1, dlon2
-  REAL :: dlat1, dlat2
-  REAL, DIMENSION(nbp_lon+1) :: lon
-  INTEGER, DIMENSION(npCFMIP) :: tabijGCM
-  REAL, DIMENSION(npCFMIP) :: lonGCM, latGCM
-
-  lon(1:nbp_lon)=io_lon(:)
-  lon(nbp_lon+1)=-1*lon(1)
-  OPEN(22, file="LMDZ_pointsCFMIP.txt")
-  DO np=1, npCFMIP
-  DO i=1, nbp_lon
-!
-! PRINT*,'IM np i lonCF lonGCM lonGCM+1',np,i,lonCFMIP(np),lon(i), &
-!  lon(i+1)
-!
-   IF(lonCFMIP(np).GE.lon(i).AND.lonCFMIP(np).LT.lon(i+1)) THEN
-    dlon1 = abs (lonCFMIP(np) - lon(i))
-    dlon2 = abs (lonCFMIP(np) - lon(i+1))
-    IF (dlon1.LE.dlon2) THEN
-     ipt(np)=i
-    ELSE
-     ipt(np)=i+1
-    ENDIF
-   ENDIF
-  END DO
-  END DO
-!
-   np=1
-30 j=1
-40 IF(latCFMIP(np).LE.io_lat(j).AND.latCFMIP(np).GE.io_lat(j+1)) THEN
-    dlat1 = abs (latCFMIP(np) - io_lat(j))
-    dlat2 = abs (latCFMIP(np) - io_lat(j+1))
-    IF (dlat1.LE.dlat2) THEN
-     jpt(np)=j
-    ELSE
-     jpt(np)=j+1
-    ENDIF
-    np=np+1
-    IF(np.LE.npCFMIP) THEN
-     GOTO 30
-    ENDIF 
-   ELSE
-    j=j+1
-    IF(j.LE.nbp_lat-1) THEN 
-     GOTO 40
-    ENDIF
-   ENDIF
-
-  DO np=1, npCFMIP
-   WRITE(22,*) lon(ipt(np)), io_lat(jpt(np))
-  ENDDO
-  CLOSE(22)
-
-  OPEN(23, file="pointsCFMIPvsLMDZ.txt")
-    DO ip=1, npCFMIP
-     lonGCM(ip)=lon(ipt(ip))
-     latGCM(ip)=io_lat(jpt(ip))
-     if(jpt(ip).GE.2.AND.jpt(ip).LE.nbp_lat-1) THEN     
-      tabijGCM(ip)=1+(jpt(ip)-2)*nbp_lon+ipt(ip)
-     else if(jpt(ip).EQ.1) THEN
-      tabijGCM(ip)=1
-     else if(jpt(ip).EQ.nbp_lat) THEN
-      tabijGCM(ip)=klon_glo
-     else 
-      print*,'ip jpt tabijGCM',ip,jpt(ip),tabijGCM(ip)
-     endif
-!    PRINT*,'CFMIP ip lon lat tabijGCM',ip,lonGCM(ip),latGCM(ip),tabijGCM(ip)
-    ENDDO
-    DO ip=1, npCFMIP
-     if(lonGCM(ip).EQ.io_lon(1)) lonGCM(ip)=360.+lonGCM(ip)
-    ENDDO
-   DO i=1, npCFMIP
-    WRITE(23,*) i, lonCFMIP(i), latCFMIP(i), lonGCM(i), latGCM(i), tabijGCM(i)
-   ENDDO
-   CLOSE(23)
- END SUBROUTINE LMDZ_CFMIP_point_locations 
-
-END MODULE CFMIP_point_locations
+link ../phylmd/cfmip_point_locations.F90
Index: LMDZ6/trunk/libf/phylmdiso/chem.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/chem.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/chem.h	(revision 3940)
@@ -1,14 +1,1 @@
-!
-! $Header$
-!
-      INTEGER idms, iso2, iso4, ih2s, idmso, imsa, ih2o2
-      PARAMETER (idms=1, iso2=2, iso4=3)
-      PARAMETER (ih2s=4, idmso=5, imsa=6, ih2o2=7)
-
-      REAL n_avogadro, masse_s, masse_so4, rho_water, rho_ice
-      PARAMETER (n_avogadro=6.02E23)                  !--molec mol-1
-      PARAMETER (masse_s=32.0)                        !--g mol-1
-      PARAMETER (masse_so4=96.0)                      !--g mol-1
-      PARAMETER (rho_water=1000.0)                    !--kg m-3
-      PARAMETER (rho_ice=500.0)                       !--kg m-3
-
+link ../phylmd/chem.h
Index: LMDZ6/trunk/libf/phylmdiso/clcdrag.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/clcdrag.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/clcdrag.F90	(revision 3940)
@@ -1,149 +1,1 @@
-!
-!$Id: clcdrag.F90 2311 2015-06-25 07:45:24Z emillour $
-!
-SUBROUTINE clcdrag(knon, nsrf, paprs, pplay,&
-     u1, v1, t1, q1, &
-     tsurf, qsurf, rugos, &
-     pcfm, pcfh)
-
-  USE dimphy
-  USE indice_sol_mod
-
-  IMPLICIT NONE
-! ================================================================= c
-!
-! Objet : calcul des cdrags pour le moment (pcfm) et 
-!         les flux de chaleur sensible et latente (pcfh).   
-!
-! ================================================================= c
-!
-! 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
-! 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 de l'air au 1er niveau du modele
-! tsurf------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite de l'air a la surface
-! rugos---input-R- rugosite
-!
-! pcfm---output-R- cdrag pour le moment 
-! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
-!
-  INTEGER, INTENT(IN)                      :: knon, nsrf
-  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
-  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
-  REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, t1, q1
-  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf, qsurf
-  REAL, DIMENSION(klon), INTENT(IN)        :: rugos
-  REAL, DIMENSION(klon), INTENT(OUT)       :: pcfm, pcfh
-!
-! ================================================================= c
-!
-  INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
-  INCLUDE "clesphys.h"
-!
-! Quelques constantes et options:
-!!$PB      REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
-  REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
-!
-! Variables locales :
-  INTEGER               :: i
-  REAL                  :: zdu2, ztsolv
-  REAL                  :: ztvd, zscf
-  REAL                  :: zucf, zcr
-  REAL                  :: friv, frih
-  REAL, DIMENSION(klon) :: zcfm1, zcfm2
-  REAL, DIMENSION(klon) :: zcfh1, zcfh2
-  REAL, DIMENSION(klon) :: zcdn
-  REAL, DIMENSION(klon) :: zri
-  REAL, DIMENSION(klon) :: zgeop1       ! geopotentiel au 1er niveau du modele
-  LOGICAL, PARAMETER    :: zxli=.FALSE. ! calcul des cdrags selon Laurent Li
-
-  CHARACTER (LEN=80) :: abort_message
-  CHARACTER (LEN=20) :: modname = 'clcdrag'
-
-
-!
-! 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)
-
-  abort_message='obsolete, remplace par cdrag, use at you own risk'
-  CALL abort_physic(modname,abort_message,1)
-
-
-
-! ================================================================= c
-!
-! Calculer le geopotentiel du premier couche de modele
-!
-  DO i = 1, knon
-     zgeop1(i) = RD * t1(i) / (0.5*(paprs(i,1)+pplay(i,1))) &
-          * (paprs(i,1)-pplay(i,1))
-  END DO
-! ================================================================= c
-!
-! Calculer le frottement au sol (Cdrag)
-!
-  DO i = 1, knon
-     zdu2 = MAX(cepdu2,u1(i)**2+v1(i)**2)
-     ztsolv = tsurf(i) * (1.0+RETV*qsurf(i))
-     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) &
-          *(1.+RETV*q1(i))
-     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
-     zcdn(i) = (ckap/LOG(1.+zgeop1(i)/(RG*rugos(i))))**2
-
-!!$        IF (zri(i) .ge. 0.) THEN      ! situation stable
-     IF (zri(i) .GT. 0.) THEN      ! situation stable
-        zri(i) = MIN(20.,zri(i))
-        IF (.NOT.zxli) THEN
-           zscf = SQRT(1.+cd*ABS(zri(i)))
-           FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), f_ri_cd_min)
-           zcfm1(i) = zcdn(i) * FRIV
-           FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), f_ri_cd_min )
-!!$  PB          zcfh1(i) = zcdn(i) * FRIH
-!!$ PB           zcfh1(i) = f_cdrag_stable * zcdn(i) * FRIH
-           zcfh1(i) = f_cdrag_ter * zcdn(i) * FRIH
-           IF(nsrf.EQ.is_oce) zcfh1(i) = f_cdrag_oce * zcdn(i) * FRIH
-!!$ PB
-           pcfm(i) = zcfm1(i)
-           pcfh(i) = zcfh1(i)
-        ELSE
-           pcfm(i) = zcdn(i)* fsta(zri(i))
-           pcfh(i) = zcdn(i)* fsta(zri(i))
-        ENDIF
-     ELSE                          ! situation instable
-        IF (.NOT.zxli) THEN
-           zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
-                *(1.0+zgeop1(i)/(RG*rugos(i)))))
-           zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),f_ri_cd_min)
-!!$PB            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),f_ri_cd_min)
-           zcfh2(i) = f_cdrag_ter*zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),f_ri_cd_min)
-           pcfm(i) = zcfm2(i)
-           pcfh(i) = zcfh2(i)
-        ELSE
-           pcfm(i) = zcdn(i)* fins(zri(i))
-           pcfh(i) = zcdn(i)* fins(zri(i))
-        ENDIF
-        IF(iflag_gusts==0) THEN
-! cdrah sur l'ocean cf. Miller et al. (1992) - only active when gustiness parameterization is not active
-           zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
-           IF(nsrf.EQ.is_oce) pcfh(i) =f_cdrag_oce* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
-        ENDIF
-     ENDIF
-  END DO
-
-! ================================================================= c
-     
-  ! IM cf JLD : on seuille cdrag_m et cdrag_h
-  IF (nsrf == is_oce) THEN
-     DO i=1,knon
-        pcfm(i)=MIN(pcfm(i),cdmmax)
-        pcfh(i)=MIN(pcfh(i),cdhmax)
-     END DO
-  END IF
-
-END SUBROUTINE clcdrag
+link ../phylmd/clcdrag.F90
Index: LMDZ6/trunk/libf/phylmdiso/clesphys.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/clesphys.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/clesphys.h	(revision 3940)
@@ -1,146 +1,1 @@
-! $Id: clesphys.h 3435 2019-01-22 15:21:59Z fairhead $
-!
-!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
-!                 veillez \`a n'utiliser que des ! pour les commentaires
-!                 et \`a bien positionner les & des lignes de continuation 
-!                 (les placer en colonne 6 et en colonne 73)
-!
-!..include cles_phys.h
-!
-       INTEGER iflag_cycle_diurne
-       LOGICAL soil_model,new_oliq,ok_orodr,ok_orolf 
-       LOGICAL ok_limitvrai
-       LOGICAL ok_all_xml
-       LOGICAL ok_lwoff
-       INTEGER nbapp_rad, iflag_con, nbapp_cv, nbapp_wk, iflag_ener_conserv
-       REAL co2_ppm, co2_ppm0, solaire
-!FC
-       REAL Cd_frein
-       LOGICAL ok_suntime_rrtm
-       REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12  
-       REAL(kind=8) RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act  
-       REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
-!IM ajout CFMIP2/CMIP5
-       REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per
-       REAL(kind=8) CH4_ppb_per,N2O_ppb_per,CFC11_ppt_per,CFC12_ppt_per
-
-!OM ---> correction du bilan d'eau global
-!OM Correction sur precip KE
-       REAL cvl_corr
-!OM Fonte calotte dans bilan eau
-       LOGICAL ok_lic_melt
-!OB Depot de vapeur d eau sur la calotte pour le bilan eau
-       LOGICAL ok_lic_cond
-
-!IM simulateur ISCCP 
-       INTEGER top_height, overlap
-!IM seuils cdrm, cdrh
-       REAL cdmmax, cdhmax
-!IM param. stabilite s/ terres et en dehors
-       REAL ksta, ksta_ter, f_ri_cd_min
-!IM ok_kzmin : clef calcul Kzmin dans la CL de surface cf FH
-       LOGICAL ok_kzmin
-!IM, MAFo fmagic, pmagic : parametres - additionnel et multiplicatif - 
-!                          pour regler l albedo sur ocean
-       REAL pbl_lmixmin_alpha
-       REAL fmagic, pmagic
-! Hauteur (imposee) du contenu en eau du sol
-           REAL qsol0,albsno0,evap0
-! Frottement au sol (Cdrag)
-       Real f_cdrag_ter,f_cdrag_oce
-       REAL min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce
-       REAL z0m_seaice,z0h_seaice
-       INTEGER iflag_gusts,iflag_z0_oce
-
-! Rugoro
-       Real f_rugoro,z0min
-
-! tau_gl : constante de rappel de la temperature a la surface de la glace
-       REAL tau_gl
-
-!IM lev_histhf  : niveau sorties 6h
-!IM lev_histday : niveau sorties journalieres
-!IM lev_histmth : niveau sorties mensuelles
-!IM lev_histdayNMC : on peut sortir soit sur 8 (comme AR5) ou bien 
-!                    sur 17 niveaux de pression
-       INTEGER lev_histhf, lev_histday, lev_histmth
-       INTEGER lev_histdayNMC
-       Integer lev_histins, lev_histLES  
-!IM ok_histNMC  : sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
-!IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
-!IM freq_calNMC : frequences de calcul fis. hist*NMC.nc
-       LOGICAL ok_histNMC(3)
-       INTEGER levout_histNMC(3)
-       REAL freq_outNMC(3) , freq_calNMC(3)
-       CHARACTER(len=4) type_run
-! aer_type: pour utiliser un fichier constant dans readaerosol 
-       CHARACTER(len=8) :: aer_type 
-       LOGICAL ok_regdyn
-       REAL lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
-       REAL ecrit_ins, ecrit_hf, ecrit_day
-       REAL ecrit_mth, ecrit_tra, ecrit_reg 
-       REAL ecrit_LES
-       REAL freq_ISCCP, ecrit_ISCCP
-       REAL freq_COSP, freq_AIRS
-       LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
-       LOGICAL :: ok_airs
-       INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo
-       LOGICAL :: ok_chlorophyll
-       LOGICAL :: ok_strato
-       LOGICAL :: ok_hines, ok_gwd_rando
-       LOGICAL :: ok_qch4
-       LOGICAL :: ok_conserv_q
-       LOGICAL :: adjust_tropopause
-       LOGICAL :: ok_daily_climoz
-! flag to bypass or not the phytrac module
-       INTEGER :: iflag_phytrac
-
-       COMMON/clesphys/                                                 &
-! REAL FIRST
-     &       co2_ppm, solaire                                           &
-     &     , RCO2, RCH4, RN2O, RCFC11, RCFC12                           &
-     &     , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act       &
-     &     , RCO2_per, RCH4_per, RN2O_per, RCFC11_per, RCFC12_per       &
-     &     , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt                     &
-     &     , CH4_ppb_per, N2O_ppb_per, CFC11_ppt_per, CFC12_ppt_per     &
-     &     , cdmmax,cdhmax,ksta,ksta_ter,f_ri_cd_min,pbl_lmixmin_alpha  &
-     &     , fmagic, pmagic                                             &
-     &     , f_cdrag_ter,f_cdrag_oce,f_rugoro,z0min,tau_gl              &
-     &     , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce   &
-     &     , z0m_seaice,z0h_seaice                                      &
-     &     , freq_outNMC, freq_calNMC                                   &
-     &     , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins             &
-     &     , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS              &
-     &     , cvl_corr                                                   &
-     &     , qsol0,albsno0,evap0                                        &
-     &     , co2_ppm0                                                   &
-!FC
-     &     , Cd_frein                                                   &
-     &     , ecrit_LES                                                  &
-     &     , ecrit_ins, ecrit_hf, ecrit_day                             &
-     &     , ecrit_mth, ecrit_tra, ecrit_reg                            &
-! THEN INTEGER AND LOGICALS
-     &     , top_height                                                 &
-     &     , iflag_cycle_diurne, soil_model, new_oliq                         &
-     &     , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad                &
-     &     , iflag_con, nbapp_cv, nbapp_wk                              &
-     &     , iflag_ener_conserv                                         &
-     &     , ok_suntime_rrtm                                            & 
-     &     , overlap                                                    &
-     &     , ok_kzmin                                                   &
-     &     , lev_histhf, lev_histday, lev_histmth                       &
-     &     , lev_histins, lev_histLES, lev_histdayNMC, levout_histNMC   &
-     &     , ok_histNMC                                                 &
-     &     , type_run, ok_regdyn, ok_cosp, ok_airs                      &
-     &     , ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP                     &
-     &     , ip_ebil_phy                                                &
-     &     , iflag_gusts ,iflag_z0_oce                                  &
-     &     , ok_lic_melt, ok_lic_cond, aer_type                         &
-     &     , iflag_rrtm, ok_strato,ok_hines, ok_qch4                    &
-     &     , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo          &
-     &     , ok_chlorophyll,ok_conserv_q, adjust_tropopause             &
-     &     , ok_daily_climoz, ok_all_xml, ok_lwoff                      &
-     &     , iflag_phytrac
-     
-       save /clesphys/
-!$OMP THREADPRIVATE(/clesphys/)
+link ../phylmd/clesphys.h
Index: LMDZ6/trunk/libf/phylmdiso/climb_wind_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/climb_wind_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/climb_wind_mod.F90	(revision 3940)
@@ -1,389 +1,1 @@
-!
-MODULE climb_wind_mod
-!
-! Module to solve the verctical diffusion of the wind components "u" and "v".
-!
-  USE dimphy
-
-  IMPLICIT NONE
-
-  SAVE
-  PRIVATE
-  
-  REAL, DIMENSION(:),   ALLOCATABLE  :: alf1, alf2
-  !$OMP THREADPRIVATE(alf1,alf2)
-  REAL, DIMENSION(:,:), ALLOCATABLE  :: Kcoefm
-  !$OMP THREADPRIVATE(Kcoefm)
-  REAL, DIMENSION(:,:), ALLOCATABLE  :: Ccoef_U, Dcoef_U
-  !$OMP THREADPRIVATE(Ccoef_U, Dcoef_U)
-  REAL, DIMENSION(:,:), ALLOCATABLE  :: Ccoef_V, Dcoef_V
-  !$OMP THREADPRIVATE(Ccoef_V, Dcoef_V)
-  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_U, Bcoef_U
-  !$OMP THREADPRIVATE(Acoef_U, Bcoef_U)
-  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_V, Bcoef_V
-  !$OMP THREADPRIVATE(Acoef_V, Bcoef_V)
-  LOGICAL                            :: firstcall=.TRUE.
-  !$OMP THREADPRIVATE(firstcall)
-
-  
-  PUBLIC :: climb_wind_down, climb_wind_up
-
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE climb_wind_init
-
-    INTEGER             :: ierr
-    CHARACTER(len = 20) :: modname = 'climb_wind_init'    
-
-!****************************************************************************************
-! Allocation of global module variables
-!
-!****************************************************************************************
-
-    ALLOCATE(alf1(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate alf1',1)
-
-    ALLOCATE(alf2(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate alf2',1)
-
-    ALLOCATE(Kcoefm(klon,klev), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate Kcoefm',1)
-
-    ALLOCATE(Ccoef_U(klon,klev), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate Ccoef_U',1)
-
-    ALLOCATE(Dcoef_U(klon,klev), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Dcoef_U',1)
-
-    ALLOCATE(Ccoef_V(klon,klev), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Ccoef_V',1)
-
-    ALLOCATE(Dcoef_V(klon,klev), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Dcoef_V',1)
-
-    ALLOCATE(Acoef_U(klon), Bcoef_U(klon), Acoef_V(klon), Bcoef_V(klon), STAT=ierr)
-    IF ( ierr /= 0 )  PRINT*,' pb in allloc Acoef_U and Bcoef_U, ierr=', ierr
-
-    firstcall=.FALSE.
-
-  END SUBROUTINE climb_wind_init
-!
-!****************************************************************************************
-!
-  SUBROUTINE climb_wind_down(knon, dtime, coef_in, pplay, paprs, temp, delp, u_old, v_old, &
-!!! nrlmd le 02/05/2011
-       Ccoef_U_out, Ccoef_V_out, Dcoef_U_out, Dcoef_V_out, &
-       Kcoef_m_out, alf_1_out, alf_2_out, &
-!!!
-       Acoef_U_out, Acoef_V_out, Bcoef_U_out, Bcoef_V_out)
-!
-! This routine calculates for the wind components u and v,
-! recursivly the coefficients C and D in equation 
-! X(k) = C(k) + D(k)*X(k-1), X=[u,v], k=[1,klev] is the vertical layer.
-!
-!
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                      :: knon
-    REAL, INTENT(IN)                         :: dtime
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: coef_in
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay ! pres au milieu de couche (Pa)
-    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression a inter-couche (Pa)
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: temp  ! temperature
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: delp
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: u_old
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: v_old
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_U_out
-    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_V_out
-    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_U_out
-    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_V_out
-
-!!! nrlmd le 02/05/2011
-    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_U_out
-    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_V_out
-    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_U_out
-    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_V_out
-    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Kcoef_m_out
-    REAL, DIMENSION(klon), INTENT(OUT)       :: alf_1_out
-    REAL, DIMENSION(klon), INTENT(OUT)       :: alf_2_out
-!!!
-
-! Local variables
-!****************************************************************************************
-    REAL, DIMENSION(klon)                    :: u1lay, v1lay
-    INTEGER                                  :: k, i
-
-! Include
-!****************************************************************************************
-    INCLUDE "YOMCST.h"
-    INCLUDE "compbl.h"    
-
-!****************************************************************************************
-! Initialize module
-    IF (firstcall) CALL climb_wind_init
-
-!****************************************************************************************
-! Calculate the coefficients C and D in : u(k) = C(k) + D(k)*u(k-1)
-!
-!****************************************************************************************
-! - Define alpha (alf1 and alf2) 
-    alf1(:) = 1.0
-    alf2(:) = 1.0 - alf1(:)
-
-! - Calculate the coefficients K
-    Kcoefm(:,:) = 0.0
-    DO k = 2, klev
-       DO i=1,knon
-          Kcoefm(i,k) = coef_in(i,k)*RG*RG*dtime/(pplay(i,k-1)-pplay(i,k)) &
-               *(paprs(i,k)*2/(temp(i,k)+temp(i,k-1))/RD)**2
-       END DO
-    END DO
-
-! - Calculate the coefficients C and D, component "u"
-    CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
-         u_old(:,:), alf1(:), alf2(:),  &
-         Ccoef_U(:,:), Dcoef_U(:,:), Acoef_U(:), Bcoef_U(:))
-
-! - Calculate the coefficients C and D, component "v"
-    CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
-         v_old(:,:), alf1(:), alf2(:),  &
-         Ccoef_V(:,:), Dcoef_V(:,:), Acoef_V(:), Bcoef_V(:))
-
-!****************************************************************************************
-! 6)
-! Return the first layer in output variables
-!
-!****************************************************************************************
-    Acoef_U_out = Acoef_U
-    Bcoef_U_out = Bcoef_U
-    Acoef_V_out = Acoef_V
-    Bcoef_V_out = Bcoef_V
-
-!****************************************************************************************
-! 7)
-! If Pbl is split, return also the other layers in output variables
-!
-!****************************************************************************************
-!!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
-       IF (mod(iflag_pbl_split,10) .ge.1) THEN
-!!! nrlmd le 02/05/2011
-    DO k= 1, klev
-      DO i= 1, klon
-        Ccoef_U_out(i,k) = Ccoef_U(i,k)
-        Ccoef_V_out(i,k) = Ccoef_V(i,k)
-        Dcoef_U_out(i,k) = Dcoef_U(i,k)
-        Dcoef_V_out(i,k) = Dcoef_V(i,k)
-        Kcoef_m_out(i,k) = Kcoefm(i,k)
-      ENDDO
-    ENDDO
-    DO i= 1, klon
-      alf_1_out(i)   = alf1(i)
-      alf_2_out(i)   = alf2(i)
-    ENDDO
-!!!      
-       ENDIF  ! (mod(iflag_pbl_split,2) .ge.1)
-!!!
-
-  END SUBROUTINE climb_wind_down
-!
-!****************************************************************************************
-!
-  SUBROUTINE calc_coef(knon, Kcoef, delp, X, alfa1, alfa2, Ccoef, Dcoef, Acoef, Bcoef)
-!
-! Find the coefficients C and D in fonction of alfa, K and delp
-!
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                      :: knon
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, delp
-    REAL, DIMENSION(klon,klev), INTENT(IN)   :: X
-    REAL, DIMENSION(klon), INTENT(IN)        :: alfa1, alfa2
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef, Bcoef
-    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef, Dcoef
-  
-! local variables
-!****************************************************************************************
-    INTEGER                                  :: k, i
-    REAL                                     :: buf
-
-    INCLUDE "YOMCST.h"
-!****************************************************************************************
-! 
-
-! Calculate coefficients C and D at top level, k=klev
-!
-    Ccoef(:,:) = 0.0
-    Dcoef(:,:) = 0.0
-
-    DO i = 1, knon
-       buf = delp(i,klev) + Kcoef(i,klev)
-
-       Ccoef(i,klev) = X(i,klev)*delp(i,klev)/buf 
-       Dcoef(i,klev) = Kcoef(i,klev)/buf
-    END DO
-    
-! 
-! Calculate coefficients C and D at top level (klev-1) <= k <= 2
-!
-    DO k=(klev-1),2,-1
-       DO i = 1, knon
-          buf = delp(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
-          
-          Ccoef(i,k) = (X(i,k)*delp(i,k) + Kcoef(i,k+1)*Ccoef(i,k+1))/buf
-          Dcoef(i,k) = Kcoef(i,k)/buf
-       END DO
-    END DO
-
-!
-! Calculate coeffiecent A and B at surface
-!
-    DO i = 1, knon
-       buf = delp(i,1) + Kcoef(i,2)*(1-Dcoef(i,2))
-       Acoef(i) = (X(i,1)*delp(i,1) + Kcoef(i,2)*Ccoef(i,2))/buf
-       Bcoef(i) = -RG/buf
-    END DO
-
-  END SUBROUTINE calc_coef
-!
-!****************************************************************************************
-!
-
-  SUBROUTINE climb_wind_up(knon, dtime, u_old, v_old, flx_u1, flx_v1,  &
-!!! nrlmd le 02/05/2011
-       Acoef_U_in, Acoef_V_in, Bcoef_U_in, Bcoef_V_in, &
-       Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in, &
-       Kcoef_m_in, &
-!!!
-       flx_u_new, flx_v_new, d_u_new, d_v_new)
-!
-! Diffuse the wind components from the surface layer and up to the top layer. 
-! Coefficents A, B, C and D are known from before. Start values for the diffusion are the
-! momentum fluxes at surface.
-!
-! u(k=1) = A + B*flx*dtime
-! u(k)   = C(k) + D(k)*u(k-1)  [2 <= k <= klev]
-!
-!****************************************************************************************
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    REAL, INTENT(IN)                        :: dtime
-    REAL, DIMENSION(klon,klev), INTENT(IN)  :: u_old
-    REAL, DIMENSION(klon,klev), INTENT(IN)  :: v_old
-    REAL, DIMENSION(klon), INTENT(IN)       :: flx_u1, flx_v1 ! momentum flux
-
-!!! nrlmd le 02/05/2011
-    REAL, DIMENSION(klon), INTENT(IN)       :: Acoef_U_in,Acoef_V_in, Bcoef_U_in, Bcoef_V_in
-    REAL, DIMENSION(klon,klev), INTENT(IN)  :: Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in
-    REAL, DIMENSION(klon,klev), INTENT(IN)  :: Kcoef_m_in
-!!!
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon,klev), INTENT(OUT) :: flx_u_new, flx_v_new
-    REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_u_new, d_v_new
-
-! Local variables
-!****************************************************************************************
-    REAL, DIMENSION(klon,klev)              :: u_new, v_new
-    INTEGER                                 :: k, i
-
-! Include
-!****************************************************************************************
-    INCLUDE "YOMCST.h"
-    INCLUDE "compbl.h"    
-    
-!
-!****************************************************************************************
-
-!!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
-       IF (mod(iflag_pbl_split,10) .ge.1) THEN
-!!! nrlmd le 02/05/2011
-    DO i = 1, knon
-      Acoef_U(i)=Acoef_U_in(i)
-      Acoef_V(i)=Acoef_V_in(i)
-      Bcoef_U(i)=Bcoef_U_in(i)
-      Bcoef_V(i)=Bcoef_V_in(i)
-    ENDDO
-    DO k = 1, klev
-      DO i = 1, knon
-        Ccoef_U(i,k)=Ccoef_U_in(i,k)
-        Ccoef_V(i,k)=Ccoef_V_in(i,k)
-        Dcoef_U(i,k)=Dcoef_U_in(i,k)
-        Dcoef_V(i,k)=Dcoef_V_in(i,k)
-        Kcoefm(i,k)=Kcoef_m_in(i,k)
-      ENDDO
-    ENDDO
-!!!
-       ENDIF  ! (mod(iflag_pbl_split,2) .ge.1)
-!!!
-
-! Niveau 1
-    DO i = 1, knon
-       u_new(i,1) = Acoef_U(i) + Bcoef_U(i)*flx_u1(i)*dtime
-       v_new(i,1) = Acoef_V(i) + Bcoef_V(i)*flx_v1(i)*dtime
-    END DO
-
-! Niveau 2 jusqu'au sommet klev
-    DO k = 2, klev
-       DO i=1, knon
-          u_new(i,k) = Ccoef_U(i,k) + Dcoef_U(i,k) * u_new(i,k-1)
-          v_new(i,k) = Ccoef_V(i,k) + Dcoef_V(i,k) * v_new(i,k-1)
-       END DO
-    END DO
-
-!****************************************************************************************
-! Calcul flux
-!
-!== flux_u/v est le flux de moment angulaire (positif vers bas)
-!== dont l'unite est: (kg m/s)/(m**2 s) 
-!
-!****************************************************************************************
-!
-    flx_u_new(:,:) = 0.0
-    flx_v_new(:,:) = 0.0
-
-    flx_u_new(1:knon,1)=flx_u1(1:knon)
-    flx_v_new(1:knon,1)=flx_v1(1:knon)
-
-! Niveau 2->klev
-    DO k = 2, klev
-       DO i = 1, knon
-          flx_u_new(i,k) = Kcoefm(i,k)/RG/dtime * &
-               (u_new(i,k)-u_new(i,k-1))
-          
-          flx_v_new(i,k) = Kcoefm(i,k)/RG/dtime * &
-               (v_new(i,k)-v_new(i,k-1))
-       END DO
-    END DO
-
-!****************************************************************************************
-! Calcul tendances
-!
-!****************************************************************************************
-    d_u_new(:,:) = 0.0
-    d_v_new(:,:) = 0.0
-    DO k = 1, klev
-       DO i = 1, knon
-          d_u_new(i,k) = u_new(i,k) - u_old(i,k)
-          d_v_new(i,k) = v_new(i,k) - v_old(i,k)
-       END DO
-    END DO
-
-  END SUBROUTINE climb_wind_up
-!
-!****************************************************************************************
-!
-END MODULE climb_wind_mod
+link ../phylmd/climb_wind_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/clouds_bigauss.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/clouds_bigauss.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/clouds_bigauss.F90	(revision 3940)
@@ -1,119 +1,1 @@
-
-! $Header$
-
-
-! ================================================================================
-
-SUBROUTINE clouds_bigauss(klon, nd, r, rs, qtc, sigt, ptconv, ratqsc, cldf)
-  IMPLICIT NONE
-
-  ! --------------------------------------------------------------------------------
-
-  ! Inputs:
-
-  ! ND----------: Number of vertical levels
-  ! R--------ND-: Domain-averaged mixing ratio of total water
-  ! RS-------ND-: Mean saturation humidity mixing ratio within the gridbox
-  ! QSUB-----ND-: Mixing ratio of condensed water within clouds associated
-  ! with SUBGRID-SCALE condensation processes (here, it is
-  ! predicted by the convection scheme)
-  ! Outputs:
-
-  ! PTCONV-----ND-: Point convectif = TRUE
-  ! RATQSC-----ND-: Largeur normalisee de la distribution
-  ! CLDF-----ND-: Fraction nuageuse
-
-  ! --------------------------------------------------------------------------------
-
-
-  INTEGER klon, nd
-  REAL r(klon, nd), rs(klon, nd), qtc(klon, nd), sigt(klon, nd)
-  LOGICAL ptconv(klon, nd)
-  REAL ratqsc(klon, nd)
-  REAL cldf(klon, nd)
-
-  ! -- parameters controlling the iteration:
-  ! --    nmax    : maximum nb of iterations (hopefully never reached)
-  ! --    epsilon : accuracy of the numerical resolution
-  ! --    vmax    : v-value above which we use an asymptotic expression for
-  ! ERF(v)
-
-  INTEGER nmax
-  PARAMETER (nmax=10)
-  REAL epsilon, vmax0, vmax(klon)
-  PARAMETER (epsilon=0.02, vmax0=2.0)
-
-  REAL min_mu, min_q
-  PARAMETER (min_mu=1.E-12, min_q=1.E-12)
-
-  INTEGER i, k, n, m
-  REAL mu, qsat, delta
-  REAL sigma1, sigma2, alpha, qconv
-  REAL xconv, xenv
-  REAL cconv, cenv
-  REAL pi, u, v
-  REAL erf
-  REAL sqrtpi, sqrt2
-  ! lconv = true si le calcul a converge (entre autre si qsub < min_q)
-  LOGICAL lconv(klon)
-
-
-  cldf(1:klon, 1:nd) = 0.0 ! cym
-  ratqsc(1:klon, 1:nd) = 0.0
-  ptconv(1:klon, 1:nd) = .FALSE.
-  ! cdir end arraycomb
-
-  pi = acos(-1.)
-  sqrtpi = sqrt(pi)
-  sqrt2 = sqrt(2.)
-
-
-  DO k = 1, nd
-
-  DO i = 1, klon ! vector
-
-      mu = r(i, k)
-      mu = max(mu, min_mu)
-      qsat = rs(i, k)
-      qsat = max(qsat, min_mu)
-      delta = log(mu/qsat)
-      qconv=qtc(i,k)
-      alpha=sigt(i,k)
-
-     IF (qconv<min_q) THEN
-        ptconv(i, k) = .FALSE.
-        ratqsc(i, k) = 0.
-
-        ! Rien on a deja initialise
-
-      ELSE
-    
-      sigma1=0.1*((qconv-mu)**2)**0.5+0.002*mu
-      sigma2=0.1*((qconv-mu)**2)**0.5+0.002*qconv 
-
-!      sigma2=0.09*((qconv-mu)**2)**0.5/(alpha+0.01)**0.5+0.002*qconv 
-!-----------------------------------------------------------------------------------------------------------------
-! Calcul de la couverture nuageuse et de ratqs
-!-----------------------------------------------------------------------------------------------------------------
-
-      xconv=(qsat-qconv)/(sqrt(2.)*sigma2)
-      xenv=(qsat-mu)/(sqrt(2.)*sigma1)
-
-      cconv=0.5*(1.-1.*erf(xconv))
-      cenv=0.5*(1.-1.*erf(xenv)) 
-      cldf(i,k)=alpha*cconv+(1.-1.*alpha)*cenv
-      ratqsc(i,k)= alpha*sigma1+(1.-1.*alpha)*sigma2
-      ptconv(i,k)= .TRUE.
-
-     END IF
-
-  END DO ! vector
-
-
-  END DO  ! K
-
-  RETURN
-  END SUBROUTINE clouds_bigauss
-
-
-
+link ../phylmd/clouds_bigauss.F90
Index: LMDZ6/trunk/libf/phylmdiso/clouds_gno.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/clouds_gno.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/clouds_gno.F90	(revision 3940)
@@ -1,261 +1,1 @@
-
-! $Header$
-
-
-! ================================================================================
-
-SUBROUTINE clouds_gno(klon, nd, r, rs, qsub, ptconv, ratqsc, cldf)
-  IMPLICIT NONE
-
-  ! --------------------------------------------------------------------------------
-
-  ! Inputs:
-
-  ! ND----------: Number of vertical levels
-  ! R--------ND-: Domain-averaged mixing ratio of total water
-  ! RS-------ND-: Mean saturation humidity mixing ratio within the gridbox
-  ! QSUB-----ND-: Mixing ratio of condensed water within clouds associated
-  ! with SUBGRID-SCALE condensation processes (here, it is
-  ! predicted by the convection scheme)
-  ! Outputs:
-
-  ! PTCONV-----ND-: Point convectif = TRUE
-  ! RATQSC-----ND-: Largeur normalisee de la distribution
-  ! CLDF-----ND-: Fraction nuageuse
-
-  ! --------------------------------------------------------------------------------
-
-
-  INTEGER klon, nd
-  REAL r(klon, nd), rs(klon, nd), qsub(klon, nd)
-  LOGICAL ptconv(klon, nd)
-  REAL ratqsc(klon, nd)
-  REAL cldf(klon, nd)
-
-  ! -- parameters controlling the iteration:
-  ! --    nmax    : maximum nb of iterations (hopefully never reached)
-  ! --    epsilon : accuracy of the numerical resolution
-  ! --    vmax    : v-value above which we use an asymptotic expression for
-  ! ERF(v)
-
-  INTEGER nmax
-  PARAMETER (nmax=10)
-  REAL epsilon, vmax0, vmax(klon)
-  PARAMETER (epsilon=0.02, vmax0=2.0)
-
-  REAL min_mu, min_q
-  PARAMETER (min_mu=1.E-12, min_q=1.E-12)
-
-  INTEGER i, k, n, m
-  REAL mu(klon), qsat, delta(klon), beta(klon)
-  REAL zu2, zv2
-  REAL xx(klon), aux(klon), coeff, block
-  REAL dist, fprime, det
-  REAL pi, u, v, erfcu, erfcv
-  REAL xx1, xx2
-  REAL erf, hsqrtlog_2, v2
-  REAL sqrtpi, sqrt2, zx1, zx2, exdel
-  ! lconv = true si le calcul a converge (entre autre si qsub < min_q)
-  LOGICAL lconv(klon)
-
-  ! cdir arraycomb
-  cldf(1:klon, 1:nd) = 0.0 ! cym
-  ratqsc(1:klon, 1:nd) = 0.0
-  ptconv(1:klon, 1:nd) = .FALSE.
-  ! cdir end arraycomb
-
-  pi = acos(-1.)
-  sqrtpi = sqrt(pi)
-  sqrt2 = sqrt(2.)
-  hsqrtlog_2 = 0.5*sqrt(log(2.))
-
-  DO k = 1, nd
-
-    DO i = 1, klon ! vector
-      mu(i) = r(i, k)
-      mu(i) = max(mu(i), min_mu)
-      qsat = rs(i, k)
-      qsat = max(qsat, min_mu)
-      delta(i) = log(mu(i)/qsat)
-      ! enddo ! vector
-
-
-      ! ***          There is no subgrid-scale condensation;        ***
-      ! ***   the scheme becomes equivalent to an "all-or-nothing"  ***
-      ! ***             large-scale condensation scheme.            ***
-
-
-
-      ! ***     Some condensation is produced at the subgrid-scale       ***
-      ! ***                                                              ***
-      ! ***       PDF = generalized log-normal distribution (GNO)        ***
-      ! ***   (k<0 because a lower bound is considered for the PDF)      ***
-      ! ***                                                              ***
-      ! ***  -> Determine x (the parameter k of the GNO PDF) such        ***
-      ! ***  that the contribution of subgrid-scale processes to         ***
-      ! ***  the in-cloud water content is equal to QSUB(K)              ***
-      ! ***  (equations (13), (14), (15) + Appendix B of the paper)      ***
-      ! ***                                                              ***
-      ! ***    Here, an iterative method is used for this purpose        ***
-      ! ***    (other numerical methods might be more efficient)         ***
-      ! ***                                                              ***
-      ! ***          NB: the "error function" is called ERF              ***
-      ! ***                 (ERF in double precision)                   ***
-
-
-      ! On commence par eliminer les cas pour lesquels on n'a pas
-      ! suffisamment d'eau nuageuse.
-
-      ! do i=1,klon ! vector
-
-      IF (qsub(i,k)<min_q) THEN
-        ptconv(i, k) = .FALSE.
-        ratqsc(i, k) = 0.
-        lconv(i) = .TRUE.
-
-        ! Rien on a deja initialise
-
-      ELSE
-
-        lconv(i) = .FALSE.
-        vmax(i) = vmax0
-
-        beta(i) = qsub(i, k)/mu(i) + exp(-min(0.0,delta(i)))
-
-        ! --  roots of equation v > vmax:
-
-        det = delta(i) + vmax(i)*vmax(i)
-        IF (det<=0.0) vmax(i) = vmax0 + 1.0
-        det = delta(i) + vmax(i)*vmax(i)
-
-        IF (det<=0.) THEN
-          xx(i) = -0.0001
-        ELSE
-          zx1 = -sqrt2*vmax(i)
-          zx2 = sqrt(1.0+delta(i)/(vmax(i)*vmax(i)))
-          xx1 = zx1*(1.0-zx2)
-          xx2 = zx1*(1.0+zx2)
-          xx(i) = 1.01*xx1
-          IF (xx1>=0.0) xx(i) = 0.5*xx2
-        END IF
-        IF (delta(i)<0.) xx(i) = -hsqrtlog_2
-
-      END IF
-
-    END DO ! vector
-
-    ! ----------------------------------------------------------------------
-    ! Debut des nmax iterations pour trouver la solution.
-    ! ----------------------------------------------------------------------
-
-    DO n = 1, nmax
-
-      DO i = 1, klon ! vector
-        IF (.NOT. lconv(i)) THEN
-
-          u = delta(i)/(xx(i)*sqrt2) + xx(i)/(2.*sqrt2)
-          v = delta(i)/(xx(i)*sqrt2) - xx(i)/(2.*sqrt2)
-          v2 = v*v
-
-          IF (v>vmax(i)) THEN
-
-            IF (abs(u)>vmax(i) .AND. delta(i)<0.) THEN
-
-              ! -- use asymptotic expression of erf for u and v large:
-              ! ( -> analytic solution for xx )
-              exdel = beta(i)*exp(delta(i))
-              aux(i) = 2.0*delta(i)*(1.-exdel)/(1.+exdel)
-              IF (aux(i)<0.) THEN
-                ! print*,'AUX(',i,',',k,')<0',aux(i),delta(i),beta(i)
-                aux(i) = 0.
-              END IF
-              xx(i) = -sqrt(aux(i))
-              block = exp(-v*v)/v/sqrtpi
-              dist = 0.0
-              fprime = 1.0
-
-            ELSE
-
-              ! -- erfv -> 1.0, use an asymptotic expression of erfv for v
-              ! large:
-
-              erfcu = 1.0 - erf(u)
-              ! !!! ATTENTION : rajout d'un seuil pour l'exponentiel
-              aux(i) = sqrtpi*erfcu*exp(min(v2,100.))
-              coeff = 1.0 - 0.5/(v2) + 0.75/(v2*v2)
-              block = coeff*exp(-v2)/v/sqrtpi
-              dist = v*aux(i)/coeff - beta(i)
-              fprime = 2.0/xx(i)*(v2)*(exp(-delta(i))-u*aux(i)/coeff)/coeff
-
-            END IF ! ABS(u)
-
-          ELSE
-
-            ! -- general case:
-
-            erfcu = 1.0 - erf(u)
-            erfcv = 1.0 - erf(v)
-            block = erfcv
-            dist = erfcu/erfcv - beta(i)
-            zu2 = u*u
-            zv2 = v2
-            IF (zu2>20. .OR. zv2>20.) THEN
-              ! print*,'ATTENTION !!! xx(',i,') =', xx(i)
-              ! print*,'ATTENTION !!! klon,ND,R,RS,QSUB,PTCONV,RATQSC,CLDF',
-              ! .klon,ND,R(i,k),RS(i,k),QSUB(i,k),PTCONV(i,k),RATQSC(i,k),
-              ! .CLDF(i,k)
-              ! print*,'ATTENTION !!! zu2 zv2 =',zu2(i),zv2(i)
-              zu2 = 20.
-              zv2 = 20.
-              fprime = 0.
-            ELSE
-              fprime = 2./sqrtpi/xx(i)/(erfcv*erfcv)* &
-                (erfcv*v*exp(-zu2)-erfcu*u*exp(-zv2))
-            END IF
-          END IF ! x
-
-          ! -- test numerical convergence:
-
-          ! if (beta(i).lt.1.e-10) then
-          ! print*,'avant test ',i,k,lconv(i),u(i),v(i),beta(i)
-          ! stop
-          ! endif
-          IF (abs(fprime)<1.E-11) THEN
-            ! print*,'avant test fprime<.e-11 '
-            ! s        ,i,k,lconv(i),u(i),v(i),beta(i),fprime(i)
-            ! print*,'klon,ND,R,RS,QSUB',
-            ! s        klon,ND,R(i,k),rs(i,k),qsub(i,k)
-            fprime = sign(1.E-11, fprime)
-          END IF
-
-
-          IF (abs(dist/beta(i))<epsilon) THEN
-            ! print*,'v-u **2',(v(i)-u(i))**2
-            ! print*,'exp v-u **2',exp((v(i)-u(i))**2)
-            ptconv(i, k) = .TRUE.
-            lconv(i) = .TRUE.
-            ! borne pour l'exponentielle
-            ratqsc(i, k) = min(2.*(v-u)*(v-u), 20.)
-            ratqsc(i, k) = sqrt(exp(ratqsc(i,k))-1.)
-            cldf(i, k) = 0.5*block
-          ELSE
-            xx(i) = xx(i) - dist/fprime
-          END IF
-          ! print*,'apres test ',i,k,lconv(i)
-
-        END IF ! lconv
-      END DO ! vector
-
-      ! ----------------------------------------------------------------------
-      ! Fin des nmax iterations pour trouver la solution.
-    END DO ! n
-    ! ----------------------------------------------------------------------
-
-
-  END DO
-  ! K
-  RETURN
-END SUBROUTINE clouds_gno
-
-
-
+link ../phylmd/clouds_gno.F90
Index: LMDZ6/trunk/libf/phylmdiso/cloudth_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cloudth_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cloudth_mod.F90	(revision 3940)
@@ -1,1540 +1,1 @@
-MODULE cloudth_mod
-
-  IMPLICIT NONE
-
-CONTAINS
-
-       SUBROUTINE cloudth(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-
-      IMPLICIT NONE
-
-
-!===========================================================================
-! Auteur : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-#include "nuage.h"
-
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      
-      REAL sigma1(ngrid,klev)
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)  
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL rneb(ngrid,klev)
-      REAL t(ngrid,klev)
-      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
-      REAL rdd,cppd,Lv
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,xth,xenv
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
-      
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Gestion de deux versions de cloudth
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      IF (iflag_cloudth_vert.GE.1) THEN
-      CALL cloudth_vert(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-      RETURN
-      ENDIF
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!-------------------------------------------------------------------------------
-! Initialisation des variables r?elles
-!-------------------------------------------------------------------------------
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-
-
-
-!-------------------------------------------------------------------------------
-! Calcul de la fraction du thermique et des ?cart-types des distributions
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
-
-
-!      zqenv(ind1)=po(ind1)
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-
-
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
-      ath=1./(1.+(alth*Lv/cppd))
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2)) 
-      
-      
-
-!------------------------------------------------------------------------------
-! Calcul des ?cart-types pour s
-!------------------------------------------------------------------------------
-
-!      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.002*zqta(ind1,ind2) 
-!       if (paprs(ind1,ind2).gt.90000) then
-!       ratqs(ind1,ind2)=0.002
-!       else 
-!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
-!       endif
-       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-!       sigma1s=ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
- 
-!------------------------------------------------------------------------------
-! Calcul de l'eau condens?e et de la couverture nuageuse
-!------------------------------------------------------------------------------
-      sqrt2pi=sqrt(2.*pi)
-      xth=sth/(sqrt(2.)*sigma2s)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      if (ctot(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else   
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-
-      endif                           
-      
-          
-!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
-
-
-      else  ! gaussienne environnement seule
-      
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-      
-
-!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-      
-
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-
-      sqrt2pi=sqrt(2.*pi)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
-      
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else   
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-
-      endif    
- 
- 
- 
- 
- 
- 
-      endif   
-      enddo
-     
-      return
-!     end
-END SUBROUTINE cloudth
-
-
-
-!===========================================================================
-     SUBROUTINE cloudth_vert(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-!===========================================================================
-! Auteur : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-#include "nuage.h"
-      
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      
-      REAL sigma1(ngrid,klev)                                                         
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)  
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL rneb(ngrid,klev)
-      REAL t(ngrid,klev)                                                                  
-      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
-      REAL rdd,cppd,Lv,sqrt2,sqrtpi
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,xth,xenv
-      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
-      REAL IntJ,IntI1,IntI2,IntI3,coeffqlenv,coeffqlth
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
-      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
-      ! (J Jouhaud, JL Dufresne, JB Madeleine)
-      REAL,SAVE :: vert_alpha
-      !$OMP THREADPRIVATE(vert_alpha)
-      LOGICAL, SAVE :: firstcall = .TRUE.
-      !$OMP THREADPRIVATE(firstcall)
-      
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-!------------------------------------------------------------------------------
-! Initialisation des variables r?elles
-!------------------------------------------------------------------------------
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-      sqrt2=sqrt(2.)
-      sqrtpi=sqrt(pi)
-
-      IF (firstcall) THEN
-        vert_alpha=0.5
-        CALL getin_p('cloudth_vert_alpha',vert_alpha)
-        WRITE(*,*) 'cloudth_vert_alpha = ', vert_alpha
-        firstcall=.FALSE.
-      ENDIF
-
-!-------------------------------------------------------------------------------
-! Calcul de la fraction du thermique et des ?cart-types des distributions
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
-
-
-!      zqenv(ind1)=po(ind1)
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-
-
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
-      ath=1./(1.+(alth*Lv/cppd))
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2)) 
-      
-      
-
-!------------------------------------------------------------------------------
-! Calcul des ?cart-types pour s
-!------------------------------------------------------------------------------
-
-      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
-!       if (paprs(ind1,ind2).gt.90000) then
-!       ratqs(ind1,ind2)=0.002
-!       else 
-!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
-!       endif
-!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-!       sigma1s=ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
- 
-!------------------------------------------------------------------------------
-! Calcul de l'eau condens?e et de la couverture nuageuse
-!------------------------------------------------------------------------------
-      sqrt2pi=sqrt(2.*pi)
-      xth=sth/(sqrt(2.)*sigma2s)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-     
-       IF (iflag_cloudth_vert == 1) THEN
-!-------------------------------------------------------------------------------
-!  Version 2: Modification selon J.-Louis. On condense ?? partir de qsat-ratqs
-!-------------------------------------------------------------------------------
-!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
-!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
-      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-!      deltasenv=aenv*0.01*po(ind1)
-!     deltasth=ath*0.01*zqta(ind1,ind2)    
-      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
-      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
-      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
-      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
-      
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
-      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
-      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
-
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlenv(ind1,ind2)=IntJ 
-!      print*, qlenv(ind1,ind2),'VERIF EAU'
-
-
-      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
-!      IntI1=coeffqlth*((0.5*xth1-xth2)*exp(-1.*xth1**2)+0.5*xth2*exp(-1.*xth2**2))
-!      IntI2=coeffqlth*0.5*sqrtpi*(0.5+xth2**2)*(erf(xth2)-erf(xth1))
-      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
-      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
-      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlth(ind1,ind2)=IntJ
-!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      ELSE IF (iflag_cloudth_vert == 2) THEN
-
-!-------------------------------------------------------------------------------
-!  Version 3: Modification Jean Jouhaud. On condense a partir de -delta s
-!-------------------------------------------------------------------------------
-!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
-!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
-!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-      deltasenv=aenv*vert_alpha*sigma1s
-      deltasth=ath*vert_alpha*sigma2s
-      
-      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
-      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
-!     coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
-!     coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
-      
-      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
-      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
-
-      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp(-1.*xenv2**2)
-      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
-      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp(-1.*xenv1**2)-exp(-1.*xenv2**2))
-
-!      IntI1=0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-!      IntI2=xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
-!      IntI3=0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
-
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlenv(ind1,ind2)=IntJ 
-!      print*, qlenv(ind1,ind2),'VERIF EAU'
-
-      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp(-1.*xth2**2)
-      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
-      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
-      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp(-1.*xth1**2)-exp(-1.*xth2**2))
-      
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlth(ind1,ind2)=IntJ
-!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-      
-
-
-
-      ENDIF ! of if (iflag_cloudth_vert==1 or 2)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else 
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
-!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1) 
-
-      endif  
-                       
-      
-          
-!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
-
-
-      else  ! gaussienne environnement seule
-      
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-      
-
-!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-      
-
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-
-      sqrt2pi=sqrt(2.*pi)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
-      
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else   
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-
-      endif    
- 
- 
- 
- 
- 
- 
-      endif   
-      enddo
-     
-      return
-!     end
-END SUBROUTINE cloudth_vert
-
-
-
-
-       SUBROUTINE cloudth_v3(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-
-      IMPLICIT NONE
-
-
-!===========================================================================
-! Author : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-#include "nuage.h"
-
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      REAL sigma1(ngrid,klev)                                                         
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL cth_vol(ngrid,klev)
-      REAL cenv_vol(ngrid,klev)
-      REAL ctot_vol(ngrid,klev)
-      REAL rneb(ngrid,klev)      
-      REAL t(ngrid,klev)
-      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,sqrt2,sqrtpi,pi
-      REAL rdd,cppd,Lv
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,xth,xenv, exp_xenv1, exp_xenv2,exp_xth1,exp_xth2
-      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! Determine the width of the vapour distribution
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-
-
-      IF (iflag_cloudth_vert.GE.1) THEN
-      CALL cloudth_vert_v3(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-      RETURN
-      ENDIF
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!-------------------------------------------------------------------------------
-! Initialisation des variables r?elles
-!-------------------------------------------------------------------------------
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      cth_vol(:,:)=0.
-      cenv_vol(:,:)=0.
-      ctot_vol(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-      sqrt2=sqrt(2.)
-      sqrtpi=sqrt(pi)
-
-
-!-------------------------------------------------------------------------------
-! Cloud fraction in the thermals and standard deviation of the PDFs
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
-
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
-
-!po = qt de l'environnement ET des thermique
-!zqenv = qt environnement
-!zqsatenv = qsat environnement
-!zthl = Tl environnement
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
-      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
-      
-!zqta = qt thermals
-!zqsatth = qsat thermals
-!ztla = Tl thermals
-
-!------------------------------------------------------------------------------
-! s standard deviations
-!------------------------------------------------------------------------------
-
-!     tests
-!     sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-!     sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+ratqs(ind1,ind2)*po(ind1)
-!     sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+0.002*zqta(ind1,ind2)
-!     final option
-      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
- 
-!------------------------------------------------------------------------------
-! Condensed water and cloud cover
-!------------------------------------------------------------------------------
-      xth=sth/(sqrt2*sigma2s)
-      xenv=senv/(sqrt2*sigma1s)
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))       !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv))     !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
-      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      if (ctot(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-      else
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-      endif
-
-      else  ! Environnement only, follow the if l.110
-      
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-!     qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
-      
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-
-      xenv=senv/(sqrt2*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
-
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-      else   
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-      endif
-
-
-      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.110 et l.183
-      enddo       ! from the loop on ngrid l.108
-      return
-!     end
-END SUBROUTINE cloudth_v3
-
-
-
-!===========================================================================
-     SUBROUTINE cloudth_vert_v3(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-!===========================================================================
-! Auteur : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-      USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv, &
-     &                                cloudth_sigmath,cloudth_sigmaenv
-
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-#include "nuage.h"
-      
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      REAL sigma1(ngrid,klev)                                                         
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL cth_vol(ngrid,klev)
-      REAL cenv_vol(ngrid,klev)
-      REAL ctot_vol(ngrid,klev)
-      REAL rneb(ngrid,klev)
-      REAL t(ngrid,klev)                                                                  
-      REAL qsatmmussig1,qsatmmussig2,sqrtpi,sqrt2,sqrt2pi,pi
-      REAL rdd,cppd,Lv
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
-      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
-      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
-      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
-      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
-      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
-      ! (J Jouhaud, JL Dufresne, JB Madeleine)
-      REAL,SAVE :: vert_alpha, vert_alpha_th
-      !$OMP THREADPRIVATE(vert_alpha, vert_alpha_th)
-      REAL,SAVE :: sigma1s_factor=1.1
-      REAL,SAVE :: sigma1s_power=0.6
-      REAL,SAVE :: sigma2s_factor=0.09
-      REAL,SAVE :: sigma2s_power=0.5
-      REAL,SAVE :: cloudth_ratqsmin=-1.
-      !$OMP THREADPRIVATE(sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin)
-      INTEGER, SAVE :: iflag_cloudth_vert_noratqs=0
-      !$OMP THREADPRIVATE(iflag_cloudth_vert_noratqs)
-
-      LOGICAL, SAVE :: firstcall = .TRUE.
-      !$OMP THREADPRIVATE(firstcall)
-
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-      REAL rhodz(ngrid,klev)
-      REAL zrho(ngrid,klev)
-      REAL dz(ngrid,klev)
-
-      DO ind1 = 1, ngrid
-        !Layer calculation
-        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg !kg/m2
-        zrho(ind1,ind2) = pplay(ind1,ind2)/t(ind1,ind2)/rd !kg/m3
-        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2) !m : epaisseur de la couche en metre
-      END DO
-
-
-!------------------------------------------------------------------------------
-! Initialize
-!------------------------------------------------------------------------------
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      cth_vol(:,:)=0.
-      cenv_vol(:,:)=0.
-      ctot_vol(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-      sqrt2=sqrt(2.)
-      sqrtpi=sqrt(pi)
-
-      IF (firstcall) THEN
-        vert_alpha=0.5
-        CALL getin_p('cloudth_vert_alpha',vert_alpha)
-        WRITE(*,*) 'cloudth_vert_alpha = ', vert_alpha
-        ! The factor used for the thermal is equal to that of the environment
-        !   if nothing is explicitly specified in the def file
-        vert_alpha_th=vert_alpha
-        CALL getin_p('cloudth_vert_alpha_th',vert_alpha_th)
-        WRITE(*,*) 'cloudth_vert_alpha_th = ', vert_alpha_th
-        ! Factor used in the calculation of sigma1s
-        CALL getin_p('cloudth_sigma1s_factor',sigma1s_factor)
-        WRITE(*,*) 'cloudth_sigma1s_factor = ', sigma1s_factor
-        ! Power used in the calculation of sigma1s
-        CALL getin_p('cloudth_sigma1s_power',sigma1s_power)
-        WRITE(*,*) 'cloudth_sigma1s_power = ', sigma1s_power
-        ! Factor used in the calculation of sigma2s
-        CALL getin_p('cloudth_sigma2s_factor',sigma2s_factor)
-        WRITE(*,*) 'cloudth_sigma2s_factor = ', sigma2s_factor
-        ! Power used in the calculation of sigma2s
-        CALL getin_p('cloudth_sigma2s_power',sigma2s_power)
-        WRITE(*,*) 'cloudth_sigma2s_power = ', sigma2s_power
-        ! Minimum value for the environmental air subgrid water distrib
-        CALL getin_p('cloudth_ratqsmin',cloudth_ratqsmin)
-        WRITE(*,*) 'cloudth_ratqsmin = ', cloudth_ratqsmin
-        ! Remove the dependency to ratqs from the variance of the vertical PDF
-        CALL getin_p('iflag_cloudth_vert_noratqs',iflag_cloudth_vert_noratqs)
-        WRITE(*,*) 'iflag_cloudth_vert_noratqs = ', iflag_cloudth_vert_noratqs
-
-        firstcall=.FALSE.
-      ENDIF
-
-!-------------------------------------------------------------------------------
-! Calcul de la fraction du thermique et des ecart-types des distributions
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then !Thermal and environnement
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2)) !qt = a*qtth + (1-a)*qtenv
-
-
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
-
-!zqenv = qt environnement
-!zqsatenv = qsat environnement
-!zthl = Tl environnement
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
-      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
-      
-      
-!zqta = qt thermals
-!zqsatth = qsat thermals
-!ztla = Tl thermals
-
-!------------------------------------------------------------------------------
-! s standard deviation
-!------------------------------------------------------------------------------
-
-      sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
-     &                (1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
-!     sigma1s_fraca = (1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
-      IF (cloudth_ratqsmin>0.) THEN
-         sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
-      ELSE
-         sigma1s_ratqs = ratqs(ind1,ind2)*po(ind1)
-      ENDIF
-      sigma1s = sigma1s_fraca + sigma1s_ratqs
-      sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
-!      tests
-!      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-!      sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+0.002*zqenv(ind1)
-!      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
-!      sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+ratqs(ind1,ind2)*zqta(ind1,ind2)
-!       if (paprs(ind1,ind2).gt.90000) then
-!       ratqs(ind1,ind2)=0.002
-!       else 
-!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
-!       endif
-!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-!       sigma1s=ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
- 
-       IF (iflag_cloudth_vert == 1) THEN
-!-------------------------------------------------------------------------------
-!  Version 2: Modification from Arnaud Jam according to JL Dufrense. Condensate from qsat-ratqs
-!-------------------------------------------------------------------------------
-
-      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-
-      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
-      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
-      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
-      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
-      
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      ! Environment
-      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
-      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
-      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
-
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-
-      ! Thermal
-      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
-      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
-      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
-      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      ELSE IF (iflag_cloudth_vert >= 3) THEN
-      IF (iflag_cloudth_vert < 5) THEN
-!-------------------------------------------------------------------------------
-!  Version 3: Changes by J. Jouhaud; condensation for q > -delta s
-!-------------------------------------------------------------------------------
-!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
-!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
-!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-      IF (iflag_cloudth_vert == 3) THEN
-        deltasenv=aenv*vert_alpha*sigma1s
-        deltasth=ath*vert_alpha_th*sigma2s
-      ELSE IF (iflag_cloudth_vert == 4) THEN
-        IF (iflag_cloudth_vert_noratqs == 1) THEN
-          deltasenv=vert_alpha*max(sigma1s_fraca,1e-10)
-          deltasth=vert_alpha_th*sigma2s
-        ELSE
-          deltasenv=vert_alpha*sigma1s
-          deltasth=vert_alpha_th*sigma2s
-        ENDIF
-      ENDIF
-      
-      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      exp_xenv1 = exp(-1.*xenv1**2)
-      exp_xenv2 = exp(-1.*xenv2**2)
-      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
-      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
-      exp_xth1 = exp(-1.*xth1**2)
-      exp_xth2 = exp(-1.*xth2**2)
-      
-      !CF_surfacique
-      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
-      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2) 
-
-
-      !CF_volumique & eau condense
-      !environnement
-      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
-      IntJ_CF=0.5*(1.-1.*erf(xenv2))
-      if (deltasenv .lt. 1.e-10) then 
-      qlenv(ind1,ind2)=IntJ
-      cenv_vol(ind1,ind2)=IntJ_CF
-      else
-      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
-      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
-      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
-      IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
-      IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-      cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-      endif
-
-      !thermique
-      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
-      IntJ_CF=0.5*(1.-1.*erf(xth2))
-      if (deltasth .lt. 1.e-10) then
-      qlth(ind1,ind2)=IntJ
-      cth_vol(ind1,ind2)=IntJ_CF
-      else
-      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
-      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
-      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
-      IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
-      IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-      cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-      endif
-
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-
-      ELSE IF (iflag_cloudth_vert == 5) THEN
-      sigma1s=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5)+ratqs(ind1,ind2)*po(ind1) !Environment
-      sigma2s=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.02)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)                   !Thermals
-      !sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-      !sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-      xth=sth/(sqrt(2.)*sigma2s)
-      xenv=senv/(sqrt(2.)*sigma1s)
-
-      !Volumique
-      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-      !print *,'jeanjean_CV=',ctot_vol(ind1,ind2)
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth_vol(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv_vol(ind1,ind2))  
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      !Surfacique
-      !Neggers
-      !beta=0.0044
-      !inverse_rho=1.+beta*dz(ind1,ind2)
-      !print *,'jeanjean : beta=',beta
-      !cth(ind1,ind2)=cth_vol(ind1,ind2)*inverse_rho
-      !cenv(ind1,ind2)=cenv_vol(ind1,ind2)*inverse_rho
-      !ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
-
-      !Brooks
-      a_Brooks=0.6694
-      b_Brooks=0.1882
-      A_Maj_Brooks=0.1635 !-- sans shear
-      !A_Maj_Brooks=0.17   !-- ARM LES
-      !A_Maj_Brooks=0.18   !-- RICO LES
-      !A_Maj_Brooks=0.19   !-- BOMEX LES
-      Dx_Brooks=200000.
-      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
-      !print *,'jeanjean_f=',f_Brooks
-
-      cth(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cth_vol(ind1,ind2),1.)))- 1.))
-      cenv(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cenv_vol(ind1,ind2),1.)))- 1.))
-      ctot(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
-      !print *,'JJ_ctot_1',ctot(ind1,ind2)
-
-
-
-
-
-      ENDIF ! of if (iflag_cloudth_vert<5)
-      ENDIF ! of if (iflag_cloudth_vert==1 or 3 or 4)
-
-!      if (ctot(ind1,ind2).lt.1.e-10) then
-      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      ctot_vol(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-
-      else
-                
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
-!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1) 
-
-      endif  
-
-      else  ! gaussienne environnement seule
-      
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-      
-
-!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
-      sth=0.
-      
-
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-      sigma2s=0.
-
-      sqrt2pi=sqrt(2.*pi)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
-      
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-
-      else   
-                
-!      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-
-      endif  
- 
-
-
-
-      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.335 et l.492
-      ! Outputs used to check the PDFs
-      cloudth_senv(ind1,ind2) = senv
-      cloudth_sth(ind1,ind2) = sth
-      cloudth_sigmaenv(ind1,ind2) = sigma1s
-      cloudth_sigmath(ind1,ind2) = sigma2s
-
-      enddo       ! from the loop on ngrid l.333
-      return
-!     end
-END SUBROUTINE cloudth_vert_v3
-!
-
-
-
-
-
-
-
-
-
-
-
-       SUBROUTINE cloudth_v6(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot_surf,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,T)
-
-
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-      USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv, &
-     &                                cloudth_sigmath,cloudth_sigmaenv
-
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-#include "nuage.h"
-
-
-        !Domain variables
-      INTEGER ngrid !indice Max lat-lon
-      INTEGER klev  !indice Max alt
-      INTEGER ind1  !indice in [1:ngrid]
-      INTEGER ind2  !indice in [1:klev]
-        !thermal plume fraction
-      REAL fraca(ngrid,klev+1)   !thermal plumes fraction in the gridbox
-        !temperatures
-      REAL T(ngrid,klev)       !temperature
-      REAL zpspsk(ngrid,klev)  !factor (p/p0)**kappa (used for potential variables)
-      REAL ztv(ngrid,klev)     !potential temperature (voir thermcell_env.F90)
-      REAL ztla(ngrid,klev)    !liquid temperature in the thermals (Tl_th)
-      REAL zthl(ngrid,klev)    !liquid temperature in the environment (Tl_env)
-        !pressure
-      REAL paprs(ngrid,klev+1)   !pressure at the interface of levels
-      REAL pplay(ngrid,klev)     !pressure at the middle of the level
-        !humidity
-      REAL ratqs(ngrid,klev)   !width of the total water subgrid-scale distribution
-      REAL po(ngrid)           !total water (qt)
-      REAL zqenv(ngrid)        !total water in the environment (qt_env)
-      REAL zqta(ngrid,klev)    !total water in the thermals (qt_th)
-      REAL zqsatth(ngrid,klev)   !water saturation level in the thermals (q_sat_th)
-      REAL zqsatenv(ngrid,klev)  !water saturation level in the environment (q_sat_env)
-      REAL qlth(ngrid,klev)    !condensed water in the thermals
-      REAL qlenv(ngrid,klev)   !condensed water in the environment
-      REAL qltot(ngrid,klev)   !condensed water in the gridbox
-        !cloud fractions
-      REAL cth_vol(ngrid,klev)   !cloud fraction by volume in the thermals
-      REAL cenv_vol(ngrid,klev)  !cloud fraction by volume in the environment
-      REAL ctot_vol(ngrid,klev)  !cloud fraction by volume in the gridbox
-      REAL cth_surf(ngrid,klev)  !cloud fraction by surface in the thermals
-      REAL cenv_surf(ngrid,klev) !cloud fraction by surface in the environment  
-      REAL ctot_surf(ngrid,klev) !cloud fraction by surface in the gridbox
-        !PDF of saturation deficit variables
-      REAL rdd,cppd,Lv
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv              !saturation deficits in the thermals and environment
-      REAL sigma_env,sigma_th    !standard deviations of the biGaussian PDF
-        !cloud fraction variables
-      REAL xth,xenv
-      REAL inverse_rho,beta                                  !Neggers et al. (2011) method
-      REAL a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks !Brooks et al. (2005) method
-        !Incloud total water variables
-      REAL zqs(ngrid)    !q_sat
-      REAL qcloud(ngrid) !eau totale dans le nuage
-        !Some arithmetic variables
-      REAL erf,pi,sqrt2,sqrt2pi
-        !Depth of the layer
-      REAL dz(ngrid,klev)    !epaisseur de la couche en metre
-      REAL rhodz(ngrid,klev)
-      REAL zrho(ngrid,klev)
-      DO ind1 = 1, ngrid
-        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg ![kg/m2]
-        zrho(ind1,ind2) = pplay(ind1,ind2)/T(ind1,ind2)/rd          ![kg/m3]
-        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2)            ![m]
-      END DO
-
-!------------------------------------------------------------------------------
-! Initialization
-!------------------------------------------------------------------------------
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      cth_vol(:,:)=0.
-      cenv_vol(:,:)=0.
-      ctot_vol(:,:)=0.
-      cth_surf(:,:)=0.
-      cenv_surf(:,:)=0.
-      ctot_surf(:,:)=0.
-      qcloud(:)=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2=sqrt(2.)
-      sqrt2pi=sqrt(2.*pi)
-
-
-      DO ind1=1,ngrid
-!-------------------------------------------------------------------------------
-!Both thermal and environment in the gridbox
-!-------------------------------------------------------------------------------
-      IF ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) THEN
-        !--------------------------------------------
-        !calcul de qsat_env
-        !--------------------------------------------
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-        !--------------------------------------------
-        !calcul de s_env
-        !--------------------------------------------
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam
-        !--------------------------------------------
-        !calcul de qsat_th
-        !--------------------------------------------
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-        !--------------------------------------------
-        !calcul de s_th  
-        !--------------------------------------------
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84 these Arnaud Jam
-      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84 these Arnaud Jam
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84 these Arnaud Jam
-        !--------------------------------------------
-        !calcul standard deviations bi-Gaussian PDF
-        !--------------------------------------------
-      sigma_th=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.01)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)
-      sigma_env=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5)+ratqs(ind1,ind2)*po(ind1)
-      xth=sth/(sqrt2*sigma_th)
-      xenv=senv/(sqrt2*sigma_env)
-        !--------------------------------------------
-        !Cloud fraction by volume CF_vol
-        !--------------------------------------------
-      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-        !-------------------------------------------- 
-        !Condensed water qc
-        !--------------------------------------------
-      qlth(ind1,ind2)=sigma_th*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth_vol(ind1,ind2))
-      qlenv(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv_vol(ind1,ind2))  
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-        !--------------------------------------------
-        !Cloud fraction by surface CF_surf
-        !--------------------------------------------
-        !Method Neggers et al. (2011) : ok for cumulus clouds only
-      !beta=0.0044 (Jouhaud et al.2018)
-      !inverse_rho=1.+beta*dz(ind1,ind2)
-      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
-        !Method Brooks et al. (2005) : ok for all types of clouds
-      a_Brooks=0.6694
-      b_Brooks=0.1882
-      A_Maj_Brooks=0.1635 !-- sans dependence au cisaillement de vent
-      Dx_Brooks=200000.   !-- si l'on considere des mailles de 200km de cote
-      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
-      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
-        !--------------------------------------------
-        !Incloud Condensed water qcloud
-        !--------------------------------------------
-      if (ctot_surf(ind1,ind2) .lt. 1.e-10) then
-      ctot_vol(ind1,ind2)=0.
-      ctot_surf(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-      else
-      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqs(ind1)
-      endif
-
-
-
-!-------------------------------------------------------------------------------
-!Environment only in the gridbox
-!-------------------------------------------------------------------------------
-      ELSE
-        !--------------------------------------------
-        !calcul de qsat_env
-        !--------------------------------------------
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-        !--------------------------------------------
-        !calcul de s_env
-        !--------------------------------------------
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam 
-        !--------------------------------------------
-        !calcul standard deviations Gaussian PDF
-        !--------------------------------------------
-      zqenv(ind1)=po(ind1)
-      sigma_env=ratqs(ind1,ind2)*zqenv(ind1)
-      xenv=senv/(sqrt2*sigma_env)
-        !--------------------------------------------
-        !Cloud fraction by volume CF_vol
-        !--------------------------------------------
-      ctot_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-        !--------------------------------------------
-        !Condensed water qc
-        !--------------------------------------------
-      qltot(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*ctot_vol(ind1,ind2))
-        !--------------------------------------------
-        !Cloud fraction by surface CF_surf
-        !--------------------------------------------
-        !Method Neggers et al. (2011) : ok for cumulus clouds only
-      !beta=0.0044 (Jouhaud et al.2018)
-      !inverse_rho=1.+beta*dz(ind1,ind2)
-      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
-        !Method Brooks et al. (2005) : ok for all types of clouds
-      a_Brooks=0.6694
-      b_Brooks=0.1882
-      A_Maj_Brooks=0.1635 !-- sans dependence au shear
-      Dx_Brooks=200000.
-      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
-      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
-        !--------------------------------------------
-        !Incloud Condensed water qcloud
-        !--------------------------------------------
-      if (ctot_surf(ind1,ind2) .lt. 1.e-8) then
-      ctot_vol(ind1,ind2)=0.
-      ctot_surf(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-      else
-      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqsatenv(ind1,ind2)
-      endif
-
-
-      END IF  ! From the separation (thermal/envrionnement) et (environnement only)
-
-      ! Outputs used to check the PDFs
-      cloudth_senv(ind1,ind2) = senv
-      cloudth_sth(ind1,ind2) = sth
-      cloudth_sigmaenv(ind1,ind2) = sigma_env
-      cloudth_sigmath(ind1,ind2) = sigma_th
-
-      END DO  ! From the loop on ngrid
-      return
-
-END SUBROUTINE cloudth_v6
-END MODULE cloudth_mod
-
-
-
-
+link ../phylmd/cloudth_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/cltrac.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cltrac.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cltrac.F90	(revision 3940)
@@ -1,149 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE cltrac(dtime,coef,t,tr,flux,paprs,pplay,delp, &
-                  d_tr,d_tr_dry,flux_tr_dry)                    !jyg
-
-  USE dimphy
-  IMPLICIT NONE
-!======================================================================
-! Auteur(s): O. Boucher (LOA/LMD) date: 19961127
-!            inspire de clvent
-! Objet: diffusion verticale de traceurs avec flux fixe a la surface
-!        ou/et flux du type c-drag
-!
-! Arguments:
-!-----------
-! dtime.......input-R- intervalle du temps (en secondes)
-! coef........input-R- le coefficient d'echange (m**2/s) l>1
-! t...........input-R- temperature (K)
-! tr..........input-R- la q. de traceurs
-! flux........input-R- le flux de traceurs a la surface
-! paprs.......input-R- pression a inter-couche (Pa)
-! pplay.......input-R- pression au milieu de couche (Pa)
-! delp........input-R- epaisseur de couche (Pa)
-! cdrag.......input-R- cdrag pour le flux de surface (non active)
-! tr0.........input-R- traceurs a la surface ou dans l'ocean (non active)
-! d_tr........output-R- le changement de tr
-! d_tr_dry....output-R- le changement de tr du au depot sec (1st layer)
-! flux_tr_dry.output-R- depot sec
-!!! flux_tr..output-R- flux de tr
-!======================================================================
-  include "YOMCST.h"
-!
-! Entree
-! 
-  REAL,INTENT(IN)                        :: dtime
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: coef
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: t, tr
-  REAL,DIMENSION(klon),INTENT(IN)        :: flux !(at/s/m2)
-  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs 
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay, delp
-!
-! Sorties
-!
-  REAL ,DIMENSION(klon,klev),INTENT(OUT) :: d_tr
-  REAL ,DIMENSION(klon),INTENT(OUT)       :: d_tr_dry          !jyg
-  REAL ,DIMENSION(klon),INTENT(OUT)       :: flux_tr_dry       !jyg
-!  REAL ,DIMENSION(klon,klev),INTENT(OUT) :: flux_tr
-!
-! Local
-! 
-  INTEGER                   :: i, k
-  REAL,DIMENSION(klon)      :: cdrag, tr0
-  REAL,DIMENSION(klon,klev) :: zx_ctr
-  REAL,DIMENSION(klon,klev) :: zx_dtr
-  REAL,DIMENSION(klon)      :: zx_buf
-  REAL,DIMENSION(klon,klev) :: zx_coef
-  REAL,DIMENSION(klon,klev) :: local_tr
-  REAL,DIMENSION(klon)      :: zx_alf1,zx_alf2,zx_flux
-
-!======================================================================
-
-  DO k = 1, klev
-     DO i = 1, klon
-        local_tr(i,k) = tr(i,k)
-     ENDDO
-  ENDDO
-
-!======================================================================
-
-  DO i = 1, klon
-     zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
-     zx_alf2(i) = 1.0 - zx_alf1(i)
-     flux_tr_dry(i) = -flux(i)*dtime                              !jyg
-     zx_flux(i) =  flux_tr_dry(i)*RG                              !jyg
-!!     zx_flux(i) =  -flux(i)*dtime*RG                            !jyg
-! Pour le moment le flux est prescrit cdrag et zx_coef(1) vaut 0
-     cdrag(i) = 0.0 
-     tr0(i) = 0.0
-     zx_coef(i,1) = cdrag(i)*dtime*RG 
-     zx_ctr(i,1)=0.
-     zx_dtr(i,1)=0.
-  ENDDO
-
-!======================================================================
-
-  DO k = 2, klev
-     DO i = 1, klon
-        zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))   &
-             *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
-        zx_coef(i,k) = zx_coef(i,k)*dtime*RG  
-     ENDDO
-  ENDDO
-
-!======================================================================
-
-  DO i = 1, klon
-     zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i) + zx_coef(i,2)
-     !
-     zx_ctr(i,2) = (local_tr(i,1)*delp(i,1)+                  &
-          zx_coef(i,1)*tr0(i)-zx_flux(i))/zx_buf(i)
-     !
-     zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) /   & 
-          zx_buf(i)
-     d_tr_dry(i) = -zx_flux(i)/zx_buf(i)                          !jyg
-  ENDDO
-
-  DO k = 3, klev
-     DO i = 1, klon
-        zx_buf(i) = delp(i,k-1) + zx_coef(i,k)      &
-             + zx_coef(i,k-1)*(1.-zx_dtr(i,k-1))
-        zx_ctr(i,k) = (local_tr(i,k-1)*delp(i,k-1)  & 
-             +zx_coef(i,k-1)*zx_ctr(i,k-1) )/zx_buf(i)
-        zx_dtr(i,k) = zx_coef(i,k)/zx_buf(i)
-     ENDDO
-  ENDDO
-
-  DO i = 1, klon
-     local_tr(i,klev) = ( local_tr(i,klev)*delp(i,klev) &
-          +zx_coef(i,klev)*zx_ctr(i,klev) )             &
-          / ( delp(i,klev) + zx_coef(i,klev)            &
-          -zx_coef(i,klev)*zx_dtr(i,klev) )
-  ENDDO
-
-  DO k = klev-1, 1, -1
-     DO i = 1, klon
-        local_tr(i,k) = zx_ctr(i,k+1) + zx_dtr(i,k+1)*local_tr(i,k+1)
-     ENDDO
-  ENDDO
-
-!======================================================================
-!== flux_tr est le flux de traceur (positif vers bas)
-!      DO i = 1, klon
-!         flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)
-!      ENDDO
-!      DO k = 2, klev
-!      DO i = 1, klon
-!         flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)
-!     .               * (local_tr(i,k)-local_tr(i,k-1))
-!      ENDDO
-!      ENDDO
-!======================================================================
-  DO k = 1, klev
-     DO i = 1, klon
-        d_tr(i,k) = local_tr(i,k) - tr(i,k)
-     ENDDO
-  ENDDO
-  
-END SUBROUTINE cltrac
+link ../phylmd/cltrac.F90
Index: LMDZ6/trunk/libf/phylmdiso/cltracrn.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cltracrn.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cltracrn.F90	(revision 3940)
@@ -1,288 +1,1 @@
-!$Id $
-
-SUBROUTINE cltracrn( itr, dtime,u1lay, v1lay, &
-     cdrag,coef,t,ftsol,pctsrf,               &
-     tr,trs,paprs,pplay,delp,                 &
-     masktr,fshtr,hsoltr,tautr,vdeptr,        &
-     lat,d_tr,d_trs )
-  
-  USE dimphy
-  USE traclmdz_mod, ONLY : id_rn, id_pb
-  USE indice_sol_mod
-
-  IMPLICIT NONE
-!======================================================================
-! Auteur(s): Alex/LMD) date:  fev 99
-!            inspire de clqh + clvent
-! Objet: diffusion verticale de traceurs avec quantite de traceur ds 
-!        le sol ( reservoir de sol de radon ) 
-!        
-! note : pour l'instant le traceur dans le sol et le flux sont
-!        calcules mais ils ne servent que de diagnostiques
-!        seule la tendance sur le traceur est sortie (d_tr)
-!---------------------------------------------------------------------
-! Arguments:
-! itr......input-R-  le type de traceur : id_rn(radon), id_pb(plomb)
-! dtime....input-R-  intervalle du temps (en secondes) ~ pdtphys
-! u1lay....input-R-  vent u de la premiere couche (m/s)
-! v1lay....input-R-  vent v de la premiere couche (m/s)
-! cdrag....input-R-  cdrag
-! coef.....input-R-  le coefficient d'echange (m**2/s) l>1, valable uniquement pour k entre 2 et klev
-! t........input-R-  temperature (K)
-! paprs....input-R-  pression a inter-couche (Pa)
-! pplay....input-R-  pression au milieu de couche (Pa)
-! delp.....input-R-  epaisseur de couche (Pa)
-! ftsol....input-R-  temperature du sol (en Kelvin)
-! tr.......input-R-  traceurs
-! trs......input-R-  traceurs dans le sol
-! masktr...input-R-  Masque reservoir de sol traceur (1 = reservoir)
-! fshtr....input-R-  Flux surfacique de production dans le sol
-! tautr....input-R-  Constante de decroissance du traceur
-! vdeptr...input-R-  Vitesse de depot sec dans la couche brownienne
-! hsoltr...input-R-  Epaisseur equivalente du reservoir de sol
-! lat......input-R-  latitude en degree
-! d_tr.....output-R- le changement de "tr"
-! d_trs....output-R- le changement de "trs"
-!======================================================================
-  include "YOMCST.h"
-!
-!Entrees
-  INTEGER,INTENT(IN)                     :: itr
-  REAL,INTENT(IN)                        :: dtime
-  REAL,DIMENSION(klon),INTENT(IN)        :: u1lay, v1lay
-  REAL,DIMENSION(klon),INTENT(IN)        :: cdrag
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: coef, t
-  REAL,DIMENSION(klon,nbsrf),INTENT(IN)  :: ftsol, pctsrf 
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: tr 
-  REAL,DIMENSION(klon),INTENT(IN)        :: trs
-  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs 
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay, delp
-  REAL,DIMENSION(klon),INTENT(IN)        :: masktr 
-  REAL,DIMENSION(klon),INTENT(IN)        :: fshtr 
-  REAL,INTENT(IN)                        :: hsoltr
-  REAL,INTENT(IN)                        :: tautr
-  REAL,INTENT(IN)                        :: vdeptr
-  REAL,DIMENSION(klon),INTENT(IN)        :: lat   
-
-!Sorties
-  REAL,DIMENSION(klon,klev),INTENT(OUT) :: d_tr
-  REAL,DIMENSION(klon),INTENT(OUT) :: d_trs  ! (diagnostic) traceur ds le sol
-
-!Locales
-  REAL,DIMENSION(klon,klev) :: flux_tr  ! (diagnostic) flux de traceur
-  INTEGER                   :: i, k, n, l
-  REAL,DIMENSION(klon)      :: rotrhi
-  REAL,DIMENSION(klon,klev) :: zx_coef
-  REAL,DIMENSION(klon)      :: zx_buf
-  REAL,DIMENSION(klon,klev) :: zx_ctr
-  REAL,DIMENSION(klon,klev) :: zx_dtr
-  REAL,DIMENSION(klon)      :: zx_trs
-  REAL                      :: zx_a, zx_b
-  
-  REAL,DIMENSION(klon,klev) :: local_tr
-  REAL,DIMENSION(klon)      :: local_trs
-  REAL,DIMENSION(klon)      :: zts      ! champ de temperature du sol
-  REAL,DIMENSION(klon)      :: zx_alpha1, zx_alpha2
-!======================================================================
-!AA Pour l'instant les 4 types de surface ne sont pas pris en compte
-!AA On fabrique avec zts un champ de temperature de sol  
-!AA que le pondere par la fraction de nature de sol.
- 
-  DO i = 1,klon
-     zts(i) = 0. 
-  ENDDO
-
-  DO n=1,nbsrf
-     DO i = 1,klon
-        zts(i) = zts(i) + ftsol(i,n)*pctsrf(i,n)
-     ENDDO
-  ENDDO
-
-  DO i = 1,klon
-     rotrhi(i) = RD * zts(i) / hsoltr 
-  ENDDO
-
-  DO k = 1, klev
-     DO i = 1, klon
-        local_tr(i,k) = tr(i,k)
-     ENDDO
-  ENDDO
-
-  DO i = 1, klon
-     local_trs(i) = trs(i)
-  ENDDO
-!======================================================================
-!AA   Attention si dans clmain zx_alf1(i) = 1.0 
-!AA   Il doit y avoir coherence (dc la meme chose ici)
-
-  DO i = 1, klon
-!AA         zx_alpha1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
-     zx_alpha1(i) = 1.0
-     zx_alpha2(i) = 1.0 - zx_alpha1(i)
-  ENDDO
-!======================================================================
-  DO i = 1, klon
-     zx_coef(i,1) = cdrag(i)*(1.0+SQRT(u1lay(i)**2+v1lay(i)**2)) &
-          *pplay(i,1)/(RD*t(i,1))
-     zx_coef(i,1) = zx_coef(i,1) * dtime*RG
-  ENDDO
-
-  DO k = 2, klev
-     DO i = 1, klon
-        zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k)) &
-             *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
-        zx_coef(i,k) = zx_coef(i,k) * dtime*RG
-     ENDDO
-  ENDDO
-!======================================================================
-  DO i = 1, klon
-     zx_buf(i)      = delp(i,klev) + zx_coef(i,klev)
-     zx_ctr(i,klev) = local_tr(i,klev)*delp(i,klev)/zx_buf(i)
-     zx_dtr(i,klev) = zx_coef(i,klev) / zx_buf(i)
-  ENDDO
-
-  DO l = klev-1, 2 , -1
-     DO i = 1, klon
-        zx_buf(i) = delp(i,l)+zx_coef(i,l)      &
-             +zx_coef(i,l+1)*(1.-zx_dtr(i,l+1))
- 
-        zx_ctr(i,l) = ( local_tr(i,l)*delp(i,l) &
-             + zx_coef(i,l+1)*zx_ctr(i,l+1) )/zx_buf(i)
-        zx_dtr(i,l) = zx_coef(i,l) / zx_buf(i)
-     ENDDO
-  ENDDO
-
-  DO i = 1, klon
-     zx_buf(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dtr(i,2))  &
-          + masktr(i) * zx_coef(i,1)                        &
-          *( zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2) )
-
-     zx_ctr(i,1) = ( local_tr(i,1)*delp(i,1)                &
-          + zx_ctr(i,2)                                     &
-          *(zx_coef(i,2)                                    &
-          - masktr(i) * zx_coef(i,1)                        &
-          *zx_alpha2(i) ) ) / zx_buf(i)
-     zx_dtr(i,1) = masktr(i) * zx_coef(i,1) / zx_buf(i)
-  ENDDO
-!======================================================================
-! Calculer d'abord local_trs nouvelle quantite dans le reservoir
-! de sol
-!=====================================================================
-
-  DO i = 1, klon
-!-------------------------
-! Au dessus des continents
-!--
-! Le pb peut se deposer partout : vdeptr = 10-3 m/s
-! Le Rn est traiter commme une couche Brownienne puisque vdeptr = 0.
-!-------------------------------------------------------------------
-     IF ( NINT(masktr(i)) .EQ. 1 ) THEN
-        zx_trs(i) = local_trs(i)
-        zx_a = zx_trs(i)                                           &
-             +fshtr(i)*dtime*rotrhi(i)                             &
-             +rotrhi(i)*masktr(i)*zx_coef(i,1)/RG                  &
-             *(zx_ctr(i,1)*(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2)) &
-             +zx_alpha2(i)*zx_ctr(i,2))
-! Pour l'instant, pour aller vite, le depot sec est traite comme une decroissance
-        zx_b = 1. + rotrhi(i)*masktr(i)*zx_coef(i,1)/RG            &
-             * (1.-zx_dtr(i,1)                                     &
-             *(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2)))             &
-             + dtime / tautr                                       & 
-             + dtime * vdeptr / hsoltr 
-        zx_trs(i) = zx_a / zx_b
-        local_trs(i) = zx_trs(i)
-     ENDIF
-!--------------------------------------------------------
-! Si on est entre 60N et 70N on divise par 2 l'emanation
-!--------------------------------------------------------
-
-     IF ( (itr.eq.id_rn.AND.NINT(masktr(i)).EQ.1.AND.lat(i).GE.60..AND.lat(i).LE.70.).OR.      &
-          (itr.eq.id_pb.AND.NINT(masktr(i)).EQ.1.AND.lat(i).GE.60..AND.lat(i).LE.70.) ) THEN
-        zx_trs(i) = local_trs(i)
-        zx_a = zx_trs(i)                                           &
-             +(fshtr(i)/2.)*dtime*rotrhi(i)                        & 
-             +rotrhi(i)*masktr(i)*zx_coef(i,1)/RG                  &
-             *(zx_ctr(i,1)*(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2)) &
-             +zx_alpha2(i)*zx_ctr(i,2))
-        !
-        zx_b = 1. + rotrhi(i)*masktr(i)*zx_coef(i,1)/RG  &
-             * (1.-zx_dtr(i,1)                           &
-             *(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2)))   &
-             + dtime / tautr                             &
-             + dtime * vdeptr / hsoltr
-        ! 
-        zx_trs(i) = zx_a / zx_b
-        local_trs(i) = zx_trs(i)
-     ENDIF
-
-!----------------------------------------------
-! Au dessus des oceans et aux hautes latitudes
-!--
-! au dessous de -60S  pas d'emission de radon au dessus 
-! des oceans et des continents
-!---------------------------------------------------------------
-
-     IF ( (itr.EQ.id_rn.AND.NINT(masktr(i)).EQ.0).OR.       &
-          (itr.EQ.id_rn.AND.NINT(masktr(i)).EQ.1.AND.lat(i).LT.-60.)) THEN
-        zx_trs(i) = 0.
-        local_trs(i) = 0.
-     END IF
-!--
-! au dessus de 70 N pas d'emission de radon au dessus 
-! des oceans et des continents
-!--------------------------------------------------------------
-     IF ( (itr.EQ.id_rn.AND.NINT(masktr(i)).EQ.0).OR.    &
-          (itr.EQ.id_rn.AND.NINT(masktr(i)).EQ.1.AND.lat(i).GT.70.)) THEN
-        zx_trs(i) = 0.
-        local_trs(i) = 0.
-     END IF
-!---------------------------------------------
-! Au dessus des oceans la source est nulle
-!--------------------------------------------
-
-     IF (itr.eq.id_rn.AND.NINT(masktr(i)).EQ.0) THEN
-        zx_trs(i) = 0.
-        local_trs(i) = 0.
-     END IF
-
-  ENDDO    ! sur le i=1,klon
-!
-!======================================================================
-! Une fois on a zx_trs, on peut faire l'iteration 
-!====================================================================== 
-
-  DO i = 1, klon
-     local_tr(i,1) = zx_ctr(i,1)+zx_dtr(i,1)*zx_trs(i)
-  ENDDO
-  DO l = 2, klev
-     DO i = 1, klon
-        local_tr(i,l) = zx_ctr(i,l) + zx_dtr(i,l)*local_tr(i,l-1)
-     ENDDO
-  ENDDO
-!======================================================================
-! Calcul du flux de traceur (flux_tr): UA/(m**2 s)
-!======================================================================
-  DO i = 1, klon
-     flux_tr(i,1) = masktr(i)*zx_coef(i,1)/RG                      &
-          * (zx_alpha1(i)*local_tr(i,1)+zx_alpha2(i)*local_tr(i,2) &
-          -zx_trs(i)) / dtime
-  ENDDO
-  DO l = 2, klev
-     DO i = 1, klon
-        flux_tr(i,l) = zx_coef(i,l)/RG                    &
-             * (local_tr(i,l)-local_tr(i,l-1)) / dtime
-     ENDDO
-  ENDDO
-!======================================================================
-! Calcul des tendances du traceur ds le sol et dans l'atmosphere
-!======================================================================
-  DO l = 1, klev
-     DO i = 1, klon
-        d_tr(i,l) = local_tr(i,l) - tr(i,l)
-     ENDDO
-  ENDDO
-  DO i = 1, klon
-     d_trs(i) = local_trs(i) - trs(i)
-  ENDDO
-
-END SUBROUTINE cltracrn
+link ../phylmd/cltracrn.F90
Index: LMDZ6/trunk/libf/phylmdiso/cmp_seri_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cmp_seri_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cmp_seri_mod.F90	(revision 3940)
@@ -1,156 +1,1 @@
-!
-! $Id:  ??? $
-!
-MODULE cmp_seri_mod
-  !======================================================================
-  ! to check if the x_seri vaariables have changed
-  !
-  !======================================================================
-
-  REAL,SAVE,ALLOCATABLE ::  u_prev(:,:), v_prev(:,:), ql_prev(:,:), &
-       qs_prev(:,:), q_prev(:,:), t_prev(:,:)
-  !$OMP THREADPRIVATE(u_prev, v_prev, ql_prev, qs_prev, q_prev, t_prev)
-
-CONTAINS
-
-  SUBROUTINE init_cmp_seri
-    !======================================================================
-    !
-    !======================================================================
-
-    !======================================================================
-    ! Declarations
-    !======================================================================
-    USE dimphy, ONLY: klon, klev
-    USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q_seri, &
-         t_seri
-    !
-    IMPLICIT none
-    ! Local :
-    !--------
-    logical, save :: first=.true.
-    !$OMP THREADPRIVATE(first)
-
-    !
-    !======================================================================
-    !
-    if (first) then
-       ALLOCATE(u_prev(klon,klev))
-       ALLOCATE(v_prev(klon,klev))
-       ALLOCATE(ql_prev(klon,klev))
-       ALLOCATE(qs_prev(klon,klev))
-       ALLOCATE(q_prev(klon,klev))
-       ALLOCATE(t_prev(klon,klev))
-       first=.false.
-    endif
-    ! store current values of x_seri variables
-    u_prev(:,:) =u_seri(:,:)
-    v_prev(:,:) =v_seri(:,:)
-    ql_prev(:,:)=ql_seri(:,:)
-    qs_prev(:,:)=qs_seri(:,:)
-    t_prev(:,:) =t_seri(:,:)
-    q_prev(:,:) =q_seri(:,:)
-
-  END SUBROUTINE init_cmp_seri
-
-  !======================================================================
-  !
-  !======================================================================
-  SUBROUTINE cmp_seri(iflag,text)
-    !
-    USE dimphy, ONLY: klon, klev
-    USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q_seri, &
-         t_seri
-    USE print_control_mod, ONLY: prt_level
-    IMPLICIT none
-    ! Arguments :
-    !------------
-    integer iflag
-    CHARACTER*(*) text
-    ! Local :
-    !--------
-    integer i, k
-    real du_seri(klon,klev), dv_seri(klon,klev), dql_seri(klon,klev), &
-         dqs_seri(klon,klev), dq_seri(klon,klev), dt_seri(klon,klev)
-    logical t_differ, u_differ, v_differ, ql_differ, qs_differ, q_differ
-    logical any_differ
-    !
-    any_differ = .false.
-    !
-    dt_seri(:,:)=t_seri(:,:)-t_prev(:,:)
-    IF (any(t_seri/=t_prev)) then
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
-       write (*,*) '*** t_seri has changed',minval(dt_seri),maxval(dt_seri)
-       t_differ=.true.
-       any_differ = .true.
-    ELSE
-       t_differ=.false.
-    END IF
-    !
-    dq_seri(:,:)=q_seri(:,:)-q_prev(:,:)
-    IF (any(q_seri/=q_prev)) then
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
-       write (*,*) '*** q_seri has changed',minval(dq_seri),maxval(dq_seri)
-       q_differ=.true.
-       any_differ = .true.
-    ELSE
-       q_differ=.false.
-    END IF
-    !
-    dql_seri(:,:)=ql_seri(:,:)-ql_prev(:,:)
-    IF (any(ql_seri/=ql_prev)) then
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
-       write (*,*) '*** ql_seri has changed',minval(dql_seri),maxval(dql_seri)
-       ql_differ=.true.
-       any_differ = .true.
-    ELSE
-       ql_differ=.false.
-    END IF
-    !
-    dqs_seri(:,:)=qs_seri(:,:)-qs_prev(:,:)
-    IF (any(qs_seri/=qs_prev)) then
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
-       write (*,*) '*** qs_seri has changed',minval(dqs_seri),maxval(dqs_seri)
-       qs_differ=.true.
-       any_differ = .true.
-    ELSE
-       qs_differ=.false.
-    END IF
-    !
-    du_seri(:,:)=u_seri(:,:)-u_prev(:,:)
-    IF (any(u_seri/=u_prev)) then
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
-       write (*,*) '*** u_seri has changed',minval(du_seri),maxval(du_seri)
-       u_differ=.true.
-       any_differ = .true.
-    ELSE
-       u_differ=.false.
-    END IF
-    !
-    dv_seri(:,:)=v_seri(:,:)-v_prev(:,:)
-    IF (any(v_seri/=v_prev)) then
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
-       write (*,*) '*** v_seri has changed',minval(dv_seri),maxval(dv_seri)
-       v_differ=.true.
-       any_differ = .true.
-    ELSE
-       v_differ=.false.
-    END IF
-    !
-    if (any_differ) then
-       IF (iflag >= 2 .and. prt_level >= 5) then
-          i=1
-          DO k = 1, klev
-             write(*,'(i3,6e14.6)')k, t_seri(i,k)-t_prev(i,k), u_seri(i,k)-u_prev(i,k), &
-                  v_seri(i,k)-v_prev(i,k), ql_seri(i,k)-ql_prev(i,k),&
-                  qs_seri(i,k)-qs_prev(i,k), q_seri(i,k)-q_prev(i,k)
-          ENDDO
-       END IF
-    else
-       write (*,*) 'No change for any xxx_seri after ',text
-    end if
-
-  END SUBROUTINE cmp_seri
-
-END MODULE cmp_seri_mod
-
+link ../phylmd/cmp_seri_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/coef_diff_turb_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/coef_diff_turb_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/coef_diff_turb_mod.F90	(revision 3940)
@@ -1,596 +1,1 @@
-!
-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)
-!
-  IMPLICIT NONE
-  
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE coef_diff_turb(dtime, nsrf, knon, ni, &
-       ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
-       ycoefm, ycoefh ,yq2, ydrgpro)
- 
-    USE dimphy
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: prt_level, lunout
-!
-! 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), 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 "clesphys.h"
-    INCLUDE "compbl.h"
-    INCLUDE "YOETHF.h"
-    INCLUDE "YOMCST.h"
-
-
-    ykmm = 0 !ym missing init
-    ykmn = 0 !ym missing init
-    ykmq = 0 !ym missing init
-    
-    
-!****************************************************************************************    
-! 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) 
-!
-!****************************************************************************************
-
-    IF (iflag_pbl.EQ.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
-    ENDIF
-
-  
-!****************************************************************************************  
-! 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
-       
-    ENDIF
-
-  
-!****************************************************************************************
-! MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
-! 
-!****************************************************************************************
-
-    IF (iflag_pbl.GE.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)
-!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-       CALL ustarhb(knon,yu,yv,ycdragm, yustar)
-     
-       IF (prt_level > 9) THEN
-          WRITE(lunout,*) 'USTAR = ',yustar
-       ENDIF
-         
-!   iflag_pbl peut etre utilise comme longuer de melange
-       IF (iflag_pbl.GE.31) THEN
-          CALL vdif_kcay(knon,dtime,RG,RD,ypaprs,yt, &
-               yzlev,yzlay,yu,yv,yteta, &
-               ycdragm,yq2,q2diag,ykmm,ykmn,yustar, &
-               iflag_pbl)
-       ELSE IF (iflag_pbl<20) THEN
-          CALL yamada4(ni,nsrf,knon,dtime,RG,RD,ypaprs,yt, &
-               yzlev,yzlay,yu,yv,yteta, &
-               ycdragm,yq2,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.
-    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)
-    
-    USE dimphy
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: prt_level, lunout
-  
-!======================================================================
-! 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"
-    INCLUDE "YOMCST.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "compbl.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
-    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)
-    ! fin GKtest
-    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:
-    INTEGER i, k !IM 120704
-    REAL zgeop(klon,klev)
-    REAL zmgeom(klon)
-    REAL zri(klon)
-    REAL zl2(klon)
-    REAL zdphi, zdu2, ztvd, ztvu, zcdn
-    REAL zscf
-    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 gamt(2:klev)
-
-    LOGICAL, SAVE :: appel1er=.TRUE.
-    !$OMP THREADPRIVATE(appel1er)
-!
-! 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
-      
-    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
-    ENDIF
-!
-! Initialiser les sorties
-!
-    DO k = 1, klev
-       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
-!
-    IF (iflag_pbl.EQ.1) THEN
-       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
-    ENDIF
-!IM cf JLD/ GKtest
-    IF ( nsrf .NE. is_oce ) THEN
-!IM 261103     kstable = kstable_ter
-       kstable = ksta_ter
-    ELSE
-!IM 261103     kstable = kstable_sinon
-       kstable = ksta
-    ENDIF
-!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))
-    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
-       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)
-          ELSE
-             IF (zt .LT. 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
-          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).LT.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:
-!
-    DO i = 1, knon
-       IF (itop(i)+1 .LE. 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)
-
-    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:
-!
-    INTEGER i, k, invb(knon)
-    REAL zl2(knon)
-    REAL zdthmin(knon), zdthdp
-
-    INCLUDE "YOMCST.h"
-!
-! 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
-       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).GT.0.8*paprs(i,1) .AND. &
-               zdthdp.LT.zdthmin(i) ) THEN
-             zdthmin(i) = zdthdp
-             invb(i) = k
-          ENDIF
-       ENDDO
-    ENDDO
-
-!
-! Introduire une diffusion:
-!
-    IF ( nsrf.EQ.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).EQ.klev) .OR. (zdthmin(i).GT.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
-    ENDIF
-
-  END SUBROUTINE coefkz2
-!
-!****************************************************************************************
-!
-END MODULE coef_diff_turb_mod
+link ../phylmd/coef_diff_turb_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/coefcdrag.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/coefcdrag.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/coefcdrag.F90	(revision 3940)
@@ -1,167 +1,1 @@
-!
-!
-!
-      SUBROUTINE coefcdrag (klon, knon, nsrf, zxli, &
-                            speed, t, q, zgeop, psol, &
-                            ts, qsurf, rugos, okri, ri1, &
-                            cdram, cdrah, cdran, zri1, pref)
-
-      USE indice_sol_mod
-
-      IMPLICIT none
-!-------------------------------------------------------------------------
-! Objet : calcul des cdrags pour le moment (cdram) et les flux de chaleur 
-!         sensible et latente (cdrah), du cdrag neutre (cdran), 
-!         du nombre de Richardson entre la surface et le niveau de reference 
-!         (zri1) et de la pression au niveau de reference (pref).    
-!
-! I. Musat, 01.07.2002
-!-------------------------------------------------------------------------
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
-! speed---input-R- module du vent au 1er niveau du modele
-! t-------input-R- temperature de l'air au 1er niveau du modele
-! q-------input-R- humidite de l'air au 1er niveau du modele
-! zgeop---input-R- geopotentiel au 1er niveau du modele
-! psol----input-R- pression au sol 
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite de l'air a la surface
-! rugos---input-R- rugosite
-! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce 
-!                  et zref par rapport au Ri entre la sfce et la 1ere couche
-! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche
-!
-! cdram--output-R- cdrag pour le moment
-! cdrah--output-R- cdrag pour les flux de chaleur latente et sensible
-! cdran--output-R- cdrag neutre
-! zri1---output-R- nb. Richardson entre la surface et la couche zgeop/RG
-! pref---output-R- pression au niveau zgeop/RG
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli 
-      REAL, dimension(klon), intent(in) :: speed, t, q, zgeop, psol
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, ri1 
-      LOGICAL, intent(in) :: okri    
-!
-      REAL, dimension(klon), intent(out) :: cdram, cdrah, cdran, zri1, pref
-!-------------------------------------------------------------------------
-!
-      include "YOMCST.h"
-      include "YOETHF.h"
-      INCLUDE "clesphys.h"
-! Quelques constantes :
-      REAL, parameter :: RKAR=0.40, CB=5.0, CC=5.0, CD=5.0, cepdu2=(0.1)**2
-!
-! Variables locales :
-      INTEGER :: i
-      REAL, dimension(klon) :: zdu2, zdphi, ztsolv, ztvd
-      REAL, dimension(klon) :: zscf, friv, frih, zucf, zcr
-      REAL, dimension(klon) :: zcfm1, zcfh1
-      REAL, dimension(klon) :: zcfm2, zcfh2
-      REAL, dimension(klon) :: trm0, trm1
-
-  CHARACTER (LEN=80) :: abort_message
-  CHARACTER (LEN=20) :: modname = 'coefcdra'
-
-
-!
-
-
-!-------------------------------------------------------------------------
-      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)
-!-------------------------------------------------------------------------
-
-  abort_message='obsolete, remplace par cdrag, use at you own risk'
-  CALL abort_physic(modname,abort_message,1)
-
-!
-      DO i = 1, knon
-!
-       zdphi(i) = zgeop(i)
-       zdu2(i) = max(cepdu2,speed(i)**2)
-       pref(i) = exp(log(psol(i)) - zdphi(i)/(RD*t(i)* &
-                 (1.+ RETV * max(q(i),0.0))))
-       ztsolv(i) = ts(i)
-!       ztvd(i) = t(i) * (psol(i)/pref(i))**RKAPPA
-!       ztvd(i) = (t(i)+zdphi(i)/RCPD/(1.+RVTMP2*q(i))) &
-!          *(1.+RETV*q(i))
-       ztvd(i) = (t(i)+zdphi(i)/RCPD/(1.+RVTMP2*q(i)))
-       trm0(i) = 1. + RETV * max(qsurf(i),0.0)
-       trm1(i) = 1. + RETV * max(q(i),0.0)
-       ztsolv(i) = ztsolv(i) * trm0(i)
-       ztvd(i) = ztvd(i) * trm1(i)
-       zri1(i) = zdphi(i)*(ztvd(i)-ztsolv(i))/(zdu2(i)*ztvd(i))
-!
-! on teste zri1 par rapport au Richardson de la 1ere couche ri1 
-!
-!IM +++
-       IF(1.EQ.0) THEN
-       IF (okri) THEN
-         IF (ri1(i).GE.0.0.AND.zri1(i).LT.0.0) THEN
-           zri1(i) = ri1(i)
-         ELSE IF(ri1(i).LT.0.0.AND.zri1(i).GE.0.0) THEN
-           zri1(i) = ri1(i)
-         ENDIF 
-       ENDIF
-       ENDIF
-!IM ---
-! 
-       cdran(i) = (RKAR/log(1.+zdphi(i)/(RG*rugos(i))))**2
-
-       IF (zri1(i) .ge. 0.) THEN 
-!
-! situation stable : pour eviter les inconsistances dans les cas 
-! tres stables on limite zri1 a 20. cf Hess et al. (1995)
-!
-         zri1(i) = min(20.,zri1(i))
-!
-         IF (.NOT.zxli) THEN
-           zscf(i) = SQRT(1.+CD*ABS(zri1(i)))
-           friv(i) = max(1. / (1.+2.*CB*zri1(i)/ zscf(i)), f_ri_cd_min)
-           zcfm1(i) = cdran(i) * friv(i)
-           frih(i) = max(1./ (1.+3.*CB*zri1(i)*zscf(i)), f_ri_cd_min )
-!           zcfh1(i) = cdran(i) * frih(i)
-           zcfh1(i) = f_cdrag_ter*cdran(i) * frih(i)
-           IF(nsrf.EQ.is_oce) zcfh1(i)=f_cdrag_oce*cdran(i)*frih(i)
-           cdram(i) = zcfm1(i)
-           cdrah(i) = zcfh1(i)
-         ELSE
-           cdram(i) = cdran(i)* fsta(zri1(i))
-           cdrah(i) = cdran(i)* fsta(zri1(i))
-         ENDIF
-!
-       ELSE
-! 
-! situation instable
-!
-         IF (.NOT.zxli) THEN
-           zucf(i) = 1./(1.+3.0*CB*CC*cdran(i)*SQRT(ABS(zri1(i)) &
-                 *(1.0+zdphi(i)/(RG*rugos(i)))))
-           zcfm2(i) = cdran(i)*max((1.-2.0*CB*zri1(i)*zucf(i)),f_ri_cd_min)
-!           zcfh2(i) = cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),f_ri_cd_min)
-           zcfh2(i) = f_cdrag_ter*cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),f_ri_cd_min)
-           cdram(i) = zcfm2(i)
-           cdrah(i) = zcfh2(i)
-         ELSE
-           cdram(i) = cdran(i)* fins(zri1(i))
-           cdrah(i) = cdran(i)* fins(zri1(i))
-         ENDIF
-!
-! cdrah sur l'ocean cf. Miller et al. (1992)
-!
-         zcr(i) = (0.0016/(cdran(i)*SQRT(zdu2(i))))*ABS(ztvd(i)-ztsolv(i)) &
-               **(1./3.)
-!         IF (nsrf.EQ.is_oce) cdrah(i) = cdran(i)*(1.0+zcr(i)**1.25) &
-!                  **(1./1.25)
-         IF (nsrf.EQ.is_oce) cdrah(i)=f_cdrag_oce*cdran(i)*(1.0+zcr(i)**1.25) &
-                  **(1./1.25)
-       ENDIF
-!
-      END DO
-      RETURN 
-      END SUBROUTINE coefcdrag
+link ../phylmd/coefcdrag.F90
Index: LMDZ6/trunk/libf/phylmdiso/coefkzmin.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/coefkzmin.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/coefkzmin.F90	(revision 3940)
@@ -1,132 +1,1 @@
-
-SUBROUTINE coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycdragm, km, kn)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-
-  ! .......................................................................
-  ! Entrees modifies en attendant une version ou les zlev, et zlay soient
-  ! disponibles.
-
-  REAL ycdragm(klon)
-
-  REAL yu(klon, klev), yv(klon, klev)
-  REAL yt(klon, klev), yq(klon, klev)
-  REAL ypaprs(klon, klev+1), ypplay(klon, klev)
-  REAL yustar(klon)
-  REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
-
-  INTEGER i
-
-  ! .......................................................................
-
-  ! En entree :
-  ! -----------
-
-  ! zlev : altitude a chaque niveau (interface inferieure de la couche
-  ! de meme indice)
-  ! ustar : u*
-
-  ! teta : temperature potentielle au centre de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-
-  ! en sortier :
-  ! ------------
-
-  ! km : diffusivite turbulente de quantite de mouvement (au bas de chaque
-  ! couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-  ! kn : diffusivite turbulente des scalaires (au bas de chaque couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-
-  ! .......................................................................
-
-  REAL ustar(klon)
-  REAL kmin, qmin, pblhmin(klon), coriol(klon)
-  REAL zlev(klon, klev+1)
-  REAL teta(klon, klev)
-
-  REAL km(klon, klev)
-  REAL kn(klon, klev)
-  INTEGER knon
-
-
-  INTEGER nlay, nlev
-  INTEGER ig, k
-
-  REAL, PARAMETER :: kap = 0.4
-
-  nlay = klev
-  nlev = klev + 1
-  ! .......................................................................
-  ! en attendant une version ou les zlev, et zlay soient
-  ! disponibles.
-  ! Debut de la partie qui doit etre unclue a terme dans clmain.
-
-  DO i = 1, knon
-    yzlay(i, 1) = rd*yt(i, 1)/(0.5*(ypaprs(i,1)+ypplay(i, &
-      1)))*(ypaprs(i,1)-ypplay(i,1))/rg
-  END DO
-  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
-      ! ATTENTION:on passe la temperature potentielle virt. pour le calcul de
-      ! K
-      yteta(i, k) = yt(i, k)*(ypaprs(i,1)/ypplay(i,k))**rkappa* &
-        (1.+0.61*yq(i,k))
-    END DO
-  END DO
-  DO i = 1, knon
-    yzlev(i, 1) = 0.
-    yzlev(i, klev+1) = 2.*yzlay(i, klev) - yzlay(i, klev-1)
-  END DO
-  DO k = 2, klev
-    DO i = 1, knon
-      yzlev(i, k) = 0.5*(yzlay(i,k)+yzlay(i,k-1))
-    END DO
-  END DO
-
-  yustar(1:knon) = sqrt(ycdragm(1:knon)*(yu(1:knon,1)*yu(1:knon,1)+yv(1:knon, &
-    1)*yv(1:knon,1)))
-
-  ! Fin de la partie qui doit etre unclue a terme dans clmain.
-
-  ! ette routine est ecrite pour avoir en entree ustar, teta et zlev
-  ! Ici, on a inclut le calcul de ces trois variables dans la routine
-  ! coefkzmin en attendant une nouvelle version de la couche limite
-  ! ou ces variables seront disponibles.
-
-  ! Debut de la routine coefkzmin proprement dite.
-
-  ustar = yustar
-  teta = yteta
-  zlev = yzlev
-
-  DO ig = 1, knon
-    coriol(ig) = 1.E-4
-    pblhmin(ig) = 0.07*ustar(ig)/max(abs(coriol(ig)), 2.546E-5)
-  END DO
-
-  DO k = 2, klev
-    DO ig = 1, knon
-      IF (teta(ig,2)>teta(ig,1)) THEN
-        qmin = ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
-        kmin = kap*zlev(ig, k)*qmin
-      ELSE
-        kmin = 0. ! kmin n'est utilise que pour les SL stables.
-      END IF
-      kn(ig, k) = kmin
-      km(ig, k) = kmin
-    END DO
-  END DO
-
-
-  RETURN
-END SUBROUTINE coefkzmin
+link ../phylmd/coefkzmin.F90
Index: LMDZ6/trunk/libf/phylmdiso/compbl.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/compbl.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/compbl.h	(revision 3940)
@@ -1,12 +1,1 @@
-      !
-      ! $Header$
-      !
-!jyg+al1<
-!!      integer iflag_pbl,iflag_pbl_split
-!!      common/compbl/iflag_pbl,iflag_pbl_split
-!!FC      integer iflag_pbl, iflag_pbl_split, iflag_order2_sollw
-!FC      common/compbl/iflag_pbl, iflag_pbl_split, iflag_order2_sollw
-      integer iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
-      common/compbl/iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
-!>jyg+al1
-!$OMP THREADPRIVATE(/compbl/)
+link ../phylmd/compbl.h
Index: LMDZ6/trunk/libf/phylmdiso/comsoil.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/comsoil.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/comsoil.h	(revision 3940)
@@ -1,9 +1,1 @@
-!
-! $Header$
-!
-
-      common /comsoil/inertie_sol,inertie_sno,inertie_sic,inertie_lic,  &
-     &                iflag_sic
-      real inertie_sol,inertie_sno,inertie_sic,inertie_lic
-      integer iflag_sic
-!$OMP THREADPRIVATE(/comsoil/)
+link ../phylmd/comsoil.h
Index: LMDZ6/trunk/libf/phylmdiso/conccm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/conccm.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/conccm.F90	(revision 3940)
@@ -1,818 +1,1 @@
-
-! $Header$
-
-SUBROUTINE conccm(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, rain, snow, &
-    kbascm, ktopcm)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: le 14 mars 1996
-  ! Objet: Schema simple (avec flux de masse) pour la convection
-  ! (schema standard du modele NCAR CCM2)
-  ! ======================================================================
-  include "YOMCST.h"
-  include "YOETHF.h"
-
-  ! Entree:
-  REAL dtime ! pas d'integration
-  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)
-  REAL q(klon, klev) ! humidite specifique (g/g)
-  REAL conv_q(klon, klev) ! taux de convergence humidite (g/g/s)
-  ! Sortie:
-  REAL d_t(klon, klev) ! incrementation temperature
-  REAL d_q(klon, klev) ! incrementation vapeur
-  REAL rain(klon) ! pluie (mm/s)
-  REAL snow(klon) ! neige (mm/s)
-  INTEGER kbascm(klon) ! niveau du bas de convection
-  INTEGER ktopcm(klon) ! niveau du haut de convection
-
-  REAL pt(klon, klev)
-  REAL pq(klon, klev)
-  REAL pres(klon, klev)
-  REAL dp(klon, klev)
-  REAL zgeom(klon, klev)
-  REAL cmfprs(klon)
-  REAL cmfprt(klon)
-  INTEGER ntop(klon)
-  INTEGER nbas(klon)
-  INTEGER i, k
-  REAL zlvdcp, zlsdcp, zdelta, zz, za, zb
-
-  LOGICAL usekuo ! utiliser convection profonde (schema Kuo)
-  PARAMETER (usekuo=.TRUE.)
-
-  REAL d_t_bis(klon, klev)
-  REAL d_q_bis(klon, klev)
-  REAL rain_bis(klon)
-  REAL snow_bis(klon)
-  INTEGER ibas_bis(klon)
-  INTEGER itop_bis(klon)
-  REAL d_ql_bis(klon, klev)
-  REAL rneb_bis(klon, klev)
-
-  ! initialiser les variables de sortie (pour securite)
-  DO i = 1, klon
-    rain(i) = 0.0
-    snow(i) = 0.0
-    kbascm(i) = 0
-    ktopcm(i) = 0
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_q(i, k) = 0.0
-    END DO
-  END DO
-
-  ! preparer les variables d'entree (attention: l'ordre des niveaux
-  ! verticaux augmente du haut vers le bas)
-  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)
-    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))
-  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))
-    END DO
-  END DO
-
-  CALL cmfmca(dtime, pres, dp, zgeom, pt, pq, cmfprt, cmfprs, ntop, nbas)
-
-  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)
-    END DO
-  END DO
-
-  DO i = 1, klon
-    rain(i) = cmfprt(i)*rhoh2o
-    snow(i) = cmfprs(i)*rhoh2o
-    kbascm(i) = klev + 1 - nbas(i)
-    ktopcm(i) = klev + 1 - ntop(i)
-  END DO
-
-  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)
-    DO k = 1, klev
-      DO i = 1, klon
-        d_t(i, k) = d_t(i, k) + d_t_bis(i, k)
-        d_q(i, k) = d_q(i, k) + d_q_bis(i, k)
-      END DO
-    END DO
-    DO i = 1, klon
-      rain(i) = rain(i) + rain_bis(i)
-      snow(i) = snow(i) + snow_bis(i)
-      kbascm(i) = min(kbascm(i), ibas_bis(i))
-      ktopcm(i) = max(ktopcm(i), itop_bis(i))
-    END DO
-    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)))
-        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)
-        d_t(i, k) = d_t(i, k) + za
-        d_q(i, k) = d_q(i, k) + zb
-      END DO
-    END DO
-  END IF
-
-  RETURN
-END SUBROUTINE conccm
-SUBROUTINE cmfmca(deltat, p, dp, gz, tb, shb, cmfprt, cmfprs, cnt, cnb)
-  USE dimphy
-  IMPLICIT NONE
-  ! -----------------------------------------------------------------------
-  ! Moist convective mass flux procedure:
-  ! If stratification is unstable to nonentraining parcel ascent,
-  ! complete an adjustment making use of a simple cloud model
-
-  ! Code generalized to allow specification of parcel ("updraft")
-  ! properties, as well as convective transport of an arbitrary
-  ! number of passive constituents (see cmrb array).
-  ! ----------------------------Code History-------------------------------
-  ! Original version:  J. J. Hack, March 22, 1990
-  ! Standardized:      J. Rosinski, June 1992
-  ! Reviewed:          J. Hack, G. Taylor, August 1992
-  ! Adaptation au LMD: Z.X. Li, mars 1996 (reference: Hack 1994,
-  ! J. Geophys. Res. vol 99, D3, 5551-5568). J'ai
-  ! introduit les constantes et les fonctions thermo-
-  ! dynamiques du Centre Europeen. J'ai elimine le
-  ! re-indicage du code en esperant que cela pourra
-  ! simplifier la lecture et la comprehension.
-  ! -----------------------------------------------------------------------
-  INTEGER pcnst ! nombre de traceurs passifs
-  PARAMETER (pcnst=1)
-  ! ------------------------------Arguments--------------------------------
-  ! Input arguments
-
-  REAL deltat ! time step (seconds)
-  REAL p(klon, klev) ! pressure
-  REAL dp(klon, klev) ! delta-p
-  REAL gz(klon, klev) ! geopotential (a partir du sol)
-
-  REAL thtap(klon) ! PBL perturbation theta
-  REAL shp(klon) ! PBL perturbation specific humidity
-  REAL pblh(klon) ! PBL height (provided by PBL routine)
-  REAL cmrp(klon, pcnst) ! constituent perturbations in PBL
-
-  ! Updated arguments:
-
-  REAL tb(klon, klev) ! temperature (t bar)
-  REAL shb(klon, klev) ! specific humidity (sh bar)
-  REAL cmrb(klon, klev, pcnst) ! constituent mixing ratios (cmr bar)
-
-  ! Output arguments
-
-  REAL cmfdt(klon, klev) ! dT/dt due to moist convection
-  REAL cmfdq(klon, klev) ! dq/dt due to moist convection
-  REAL cmfmc(klon, klev) ! moist convection cloud mass flux
-  REAL cmfdqr(klon, klev) ! dq/dt due to convective rainout
-  REAL cmfsl(klon, klev) ! convective lw static energy flux
-  REAL cmflq(klon, klev) ! convective total water flux
-  REAL cmfprt(klon) ! convective precipitation rate
-  REAL cmfprs(klon) ! convective snowfall rate
-  REAL qc(klon, klev) ! dq/dt due to rainout terms
-  INTEGER cnt(klon) ! top level of convective activity
-  INTEGER cnb(klon) ! bottom level of convective activity
-  ! ------------------------------Parameters-------------------------------
-  REAL c0 ! rain water autoconversion coefficient
-  PARAMETER (c0=1.0E-4)
-  REAL dzmin ! minimum convective depth for precipitation
-  PARAMETER (dzmin=0.0)
-  REAL betamn ! minimum overshoot parameter
-  PARAMETER (betamn=0.10)
-  REAL cmftau ! characteristic adjustment time scale
-  PARAMETER (cmftau=3600.)
-  INTEGER limcnv ! top interface level limit for convection
-  PARAMETER (limcnv=1)
-  REAL tpmax ! maximum acceptable t perturbation (degrees C)
-  PARAMETER (tpmax=1.50)
-  REAL shpmax ! maximum acceptable q perturbation (g/g)
-  PARAMETER (shpmax=1.50E-3)
-  REAL tiny ! arbitrary small num used in transport estimates
-  PARAMETER (tiny=1.0E-36)
-  REAL eps ! convergence criteria (machine dependent)
-  PARAMETER (eps=1.0E-13)
-  REAL tmelt ! freezing point of water(req'd for rain vs snow)
-  PARAMETER (tmelt=273.15)
-  REAL ssfac ! supersaturation bound (detrained air)
-  PARAMETER (ssfac=1.001)
-
-  ! ---------------------------Local workspace-----------------------------
-  REAL gam(klon, klev) ! L/cp (d(qsat)/dT)
-  REAL sb(klon, klev) ! dry static energy (s bar)
-  REAL hb(klon, klev) ! moist static energy (h bar)
-  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 prec(klon) ! instantaneous total precipitation
-  REAL dzcld(klon) ! depth of convective layer (m)
-  REAL beta(klon) ! overshoot parameter (fraction)
-  REAL betamx ! local maximum on overshoot
-  REAL eta(klon) ! convective mass flux (kg/m^2 s)
-  REAL etagdt ! eta*grav*deltat
-  REAL cldwtr(klon) ! cloud water (mass)
-  REAL rnwtr(klon) ! rain water  (mass)
-  REAL sc(klon) ! dry static energy   ("in-cloud")
-  REAL shc(klon) ! specific humidity   ("in-cloud")
-  REAL hc(klon) ! moist static energy ("in-cloud")
-  REAL cmrc(klon) ! constituent mix rat ("in-cloud")
-  REAL dq1(klon) ! shb  convective change (lower lvl)
-  REAL dq2(klon) ! shb  convective change (mid level)
-  REAL dq3(klon) ! shb  convective change (upper lvl)
-  REAL ds1(klon) ! sb   convective change (lower lvl)
-  REAL ds2(klon) ! sb   convective change (mid level)
-  REAL ds3(klon) ! sb   convective change (upper lvl)
-  REAL dcmr1(klon) ! cmrb convective change (lower lvl)
-  REAL dcmr2(klon) ! cmrb convective change (mid level)
-  REAL dcmr3(klon) ! cmrb convective change (upper lvl)
-  REAL flotab(klon) ! hc - hbs (mesure d'instabilite)
-  LOGICAL ldcum(klon) ! .true. si la convection existe
-  LOGICAL etagt0 ! true if eta > 0.0
-  REAL dt ! current 2 delta-t (model time step)
-  REAL cats ! modified characteristic adj. time
-  REAL rdt ! 1./dt
-  REAL qprime ! modified specific humidity pert.
-  REAL tprime ! modified thermal perturbation
-  REAL pblhgt ! bounded pbl height (max[pblh,1m])
-  REAL fac1 ! intermediate scratch variable
-  REAL shprme ! intermediate specific humidity pert.
-  REAL qsattp ! saturation mixing ratio for
-  ! !  thermally perturbed PBL parcels
-  REAL dz ! local layer depth
-  REAL b1 ! bouyancy measure in detrainment lvl
-  REAL b2 ! bouyancy measure in condensation lvl
-  REAL g ! bounded vertical gradient of hb
-  REAL tmass ! total mass available for convective exchange
-  REAL denom ! intermediate scratch variable
-  REAL qtest1 ! used in negative q test (middle lvl)
-  REAL qtest2 ! used in negative q test (lower lvl)
-  REAL fslkp ! flux lw static energy (bot interface)
-  REAL fslkm ! flux lw static energy (top interface)
-  REAL fqlkp ! flux total water (bottom interface)
-  REAL fqlkm ! flux total water (top interface)
-  REAL botflx ! bottom constituent mixing ratio flux
-  REAL topflx ! top constituent mixing ratio flux
-  REAL efac1 ! ratio cmrb to convectively induced change (bot lvl)
-  REAL efac2 ! ratio cmrb to convectively induced change (mid lvl)
-  REAL efac3 ! ratio cmrb to convectively induced change (top lvl)
-
-  INTEGER i, k ! indices horizontal et vertical
-  INTEGER km1 ! k-1 (index offset)
-  INTEGER kp1 ! k+1 (index offset)
-  INTEGER m ! constituent index
-  INTEGER ktp ! temporary index used to track top
-  INTEGER is ! nombre de points a ajuster
-
-  REAL tmp1, tmp2, tmp3, tmp4
-  REAL zx_t, zx_p, zx_q, zx_qs, zx_gam
-  REAL zcor, zdelta, zcvm5
-
-  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))
-
-  ! -----------------------------------------------------------------------
-  ! pas de traceur pour l'instant
-  DO m = 1, pcnst
-    DO k = 1, klev
-      DO i = 1, klon
-        cmrb(i, k, m) = 0.0
-      END DO
-    END DO
-  END DO
-
-  ! Les perturbations de la couche limite sont zero pour l'instant
-
-  DO m = 1, pcnst
-    DO i = 1, klon
-      cmrp(i, m) = 0.0
-    END DO
-  END DO
-  DO i = 1, klon
-    thtap(i) = 0.0
-    shp(i) = 0.0
-    pblh(i) = 1.0
-  END DO
-
-  ! Ensure that characteristic adjustment time scale (cmftau) assumed
-  ! in estimate of eta isn't smaller than model time scale (deltat)
-
-  dt = deltat
-  cats = max(dt, cmftau)
-  rdt = 1.0/dt
-
-  ! Compute sb,hb,shbs,hbs
-
-  DO k = 1, klev
-    DO i = 1, klon
-      zx_t = tb(i, k)
-      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
-      zx_qs = min(0.5, zx_qs)
-      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
-      gam(i, k) = zx_gam
-    END DO
-  END DO
-
-  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)
-    END DO
-  END DO
-
-  ! Compute sbh, shbh
-
-  DO k = limcnv + 1, klev
-    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)
-    END DO
-  END DO
-
-  ! Specify properties at top of model (not used, but filling anyway)
-
-  DO i = 1, klon
-    sbh(i, limcnv) = sb(i, limcnv)
-    shbh(i, limcnv) = shb(i, limcnv)
-    hbh(i, limcnv) = hb(i, limcnv)
-  END DO
-
-  ! Zero vertically independent control, tendency & diagnostic arrays
-
-  DO i = 1, klon
-    prec(i) = 0.0
-    dzcld(i) = 0.0
-    cnb(i) = 0
-    cnt(i) = klev + 1
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      cmfdt(i, k) = 0.
-      cmfdq(i, k) = 0.
-      cmfdqr(i, k) = 0.
-      cmfmc(i, k) = 0.
-      cmfsl(i, k) = 0.
-      cmflq(i, k) = 0.
-    END DO
-  END DO
-
-  ! Begin moist convective mass flux adjustment procedure.
-  ! Formalism ensures that negative cloud liquid water can never occur
-
-  DO k = klev - 1, limcnv + 1, -1
-    km1 = k - 1
-    kp1 = k + 1
-    DO i = 1, klon
-      eta(i) = 0.0
-      beta(i) = 0.0
-      ds1(i) = 0.0
-      ds2(i) = 0.0
-      ds3(i) = 0.0
-      dq1(i) = 0.0
-      dq2(i) = 0.0
-      dq3(i) = 0.0
-
-      ! Specification of "cloud base" conditions
-
-      qprime = 0.0
-      tprime = 0.0
-
-      ! Assign tprime within the PBL to be proportional to the quantity
-      ! thtap (which will be bounded by tpmax), passed to this routine by
-      ! the PBL routine.  Don't allow perturbation to produce a dry
-      ! adiabatically unstable parcel.  Assign qprime within the PBL to be
-      ! an appropriately modified value of the quantity shp (which will be
-      ! bounded by shpmax) passed to this routine by the PBL routine.  The
-      ! quantity qprime should be less than the local saturation value
-      ! (qsattp=qsat[t+tprime,p]).  In both cases, thtap and shp are
-      ! linearly reduced toward zero as the PBL top is approached.
-
-      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))
-        qprime = max(qprime, shprme)
-      ELSE
-        tprime = 0.0
-        qprime = 0.0
-      END IF
-
-      ! Specify "updraft" (in-cloud) thermodynamic properties
-
-      sc(i) = sb(i, kp1) + rcpd*tprime
-      shc(i) = shb(i, kp1) + qprime
-      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)
-      IF (flotab(i)>0.0) THEN
-        dzcld(i) = dzcld(i) + dz
-      ELSE
-        dzcld(i) = 0.0
-      END IF
-    END DO
-
-    ! Check on moist convective instability
-
-    is = 0
-    DO i = 1, klon
-      IF (flotab(i)>0.0) THEN
-        ldcum(i) = .TRUE.
-        is = is + 1
-      ELSE
-        ldcum(i) = .FALSE.
-      END IF
-    END DO
-
-    IF (is==0) THEN
-      DO i = 1, klon
-        dzcld(i) = 0.0
-      END DO
-      GO TO 70
-    END IF
-
-    ! Current level just below top level => no overshoot
-
-    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) = max(0.0, cldwtr(i))
-          beta(i) = 0.0
-        END IF
-      END DO
-      GO TO 20
-    END IF
-
-    ! First guess at overshoot parameter using crude buoyancy closure
-    ! 10% overshoot assumed as a minimum and 1-c0*dz maximum to start
-    ! If pre-existing supersaturation in detrainment layer, beta=0
-    ! cldwtr is temporarily equal to RLVTT*l (l=> liquid water)
-
-    DO i = 1, klon
-      IF (ldcum(i)) THEN
-        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
-      END IF
-    END DO
-
-    ! Bound maximum beta to ensure physically realistic solutions
-
-    ! First check constrains beta so that eta remains positive
-    ! (assuming that eta is already positive for beta equal zero)
-    ! La premiere contrainte de beta est que le flux eta doit etre positif.
-
-    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)))
-        END IF
-
-        ! Second check involves supersaturation of "detrainment layer"
-        ! small amount of supersaturation acceptable (by ssfac factor)
-        ! La 2e contrainte est que la convection ne doit pas sursaturer
-        ! la "detrainment layer", Neanmoins, une petite sursaturation
-        ! 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)))
-          END IF
-        ELSE
-          beta(i) = 0.0
-        END IF
-
-        ! Third check to avoid introducing 2 delta x thermodynamic
-        ! noise in the vertical ... constrain adjusted h (or theta e)
-        ! 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
-          betamx = 0.0
-          IF (tmp2/=0.0) betamx = tmp1/tmp2
-          beta(i) = max(0.0, min(betamx,beta(i)))
-        END IF
-      END IF
-    END DO
-
-    ! Calculate mass flux required for stabilization.
-
-    ! Ensure that the convective mass flux, eta, is positive by
-    ! setting negative values of eta to zero..
-    ! Ensure that estimated mass flux cannot move more than the
-    ! minimum of total mass contained in either layer k or layer k+1.
-    ! Also test for other pathological cases that result in non-
-    ! physical states and adjust eta accordingly.
-
-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
-
-        ! 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)))
-        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)
-        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
-        IF (qtest2<0.0) THEN
-          eta(i) = 0.99*shb(i, kp1)/(rg*dt*fac1)
-        END IF
-      END IF
-    END DO
-
-
-    ! Calculate cloud water, rain water, and thermodynamic changes
-
-    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)
-
-        ! 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))
-
-
-        ! 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
-        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
-
-        ! Update diagnostic information for final budget
-        ! Tracking temperature & specific humidity tendencies,
-        ! rainout term, convective mass flux, convective liquid
-        ! 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
-        cmfmc(i, kp1) = cmfmc(i, kp1) + 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
-      END IF
-    END DO
-
-    ! Next, convectively modify passive constituents
-
-    DO m = 1, pcnst
-      DO i = 1, klon
-        IF (ldcum(i)) THEN
-
-          ! If any of the reported values of the constituent is negative in
-          ! 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
-
-          ! 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))
-
-          ! 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
-          ELSE
-            cmrc(i) = cmrb(i, kp1, m)
-          END IF
-
-          ! Determine fluxes, flux divergence => changes due to convection
-          ! Logic must be included to avoid producing negative values. A bit
-          ! messy since there are no a priori assumptions about profiles.
-          ! 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)
-          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)
-          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)
-          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)
-          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)
-
-          cmrb(i, kp1, m) = cmrb(i, kp1, m) + dcmr1(i)
-          cmrb(i, k, m) = cmrb(i, k, m) + dcmr2(i)
-          cmrb(i, km1, m) = cmrb(i, km1, m) + dcmr3(i)
-        END IF
-40    END DO
-    END DO ! end of m=1,pcnst loop
-
-    IF (k==limcnv+1) GO TO 60 ! on ne pourra plus glisser
-
-    ! Dans la procedure de glissage ascendant, les variables thermo-
-    ! dynamiques des couches k et km1 servent au calcul des couches
-    ! superieures. Elles ont donc besoin d'une mise-a-jour.
-
-    DO i = 1, klon
-      IF (ldcum(i)) THEN
-        zx_t = tb(i, k)
-        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
-        zx_qs = min(0.5, zx_qs)
-        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
-        gam(i, k) = zx_gam
-
-        zx_t = tb(i, km1)
-        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
-        zx_qs = min(0.5, zx_qs)
-        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
-        gam(i, km1) = zx_gam
-
-        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)
-      END IF
-    END DO
-
-    ! Ensure that dzcld is reset if convective mass flux zero
-    ! specify the current vertical extent of the convective activity
-    ! top of convective layer determined by size of overshoot param.
-
-60  CONTINUE
-    DO i = 1, klon
-      etagt0 = eta(i) > 0.0
-      IF (.NOT. etagt0) dzcld(i) = 0.0
-      IF (etagt0 .AND. beta(i)>betamn) THEN
-        ktp = km1
-      ELSE
-        ktp = k
-      END IF
-      IF (etagt0) THEN
-        cnt(i) = min(cnt(i), ktp)
-        cnb(i) = max(cnb(i), k)
-      END IF
-    END DO
-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
-    ELSE
-      cmfprt(i) = prec(i)*rdt
-    END IF
-  END DO
-
-  RETURN ! we're all done ... return to calling procedure
-END SUBROUTINE cmfmca
+link ../phylmd/conccm.F90
Index: LMDZ6/trunk/libf/phylmdiso/condsurf.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/condsurf.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/condsurf.F90	(revision 3940)
@@ -1,136 +1,1 @@
-! $Header$
-
-SUBROUTINE condsurf(jour, jourvrai, lmt_bils)
-  USE dimphy
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-  USE indice_sol_mod
-  USE time_phylmdz_mod, ONLY: annee_ref
-  IMPLICIT NONE
-
-  ! I. Musat 05.2005
-
-  ! Lire chaque jour le bilan de chaleur au sol issu
-  ! d'un run atmospherique afin de l'utiliser dans
-  ! dans un run "slab" ocean
-  ! -----------------------------------------
-  ! jour     : input  , numero du jour a lire
-  ! jourvrai : input  , vrai jour de la simulation
-
-  ! lmt_bils: bilan chaleur au sol (a utiliser pour "slab-ocean")
-
-  include "netcdf.inc"
-  INTEGER nid, nvarid
-  INTEGER debut(2)
-  INTEGER epais(2)
-
-  include "clesphys.h"
-
-  INTEGER nannemax
-  PARAMETER (nannemax=60)
-
-  INTEGER jour, jourvrai
-  REAL lmt_bils(klon) !bilan chaleur au sol
-
-  ! Variables locales:
-  INTEGER ig, i, kt, ierr
-  LOGICAL ok
-  INTEGER anneelim, anneemax
-  CHARACTER *20 fich
-
-  REAL :: lmt_bils_glo(klon_glo)
-
-  ! c
-  ! c   .....................................................................
-  ! c
-  ! c    Pour lire le fichier limit correspondant vraiment  a l'annee de la
-  ! c     simulation en cours , il suffit de mettre  ok_limitvrai = .TRUE.
-  ! c
-  ! c
-  ! ......................................................................
-
-
-
-  IF (jour<0 .OR. jour>(360-1)) THEN
-    PRINT *, 'Le jour demande n est pas correct: ', jour
-    CALL abort_physic('condsurf', '', 1)
-  END IF
-
-  anneelim = annee_ref
-  anneemax = annee_ref + nannemax
-
-
-  IF (ok_limitvrai) THEN
-    DO kt = 1, nannemax
-      IF (jourvrai<=(kt-1)*360+359) THEN
-        WRITE (fich, '("limit",i4,".nc")') anneelim
-        ! PRINT *,' Fichier  Limite ',fich
-        GO TO 100
-      END IF
-      anneelim = anneelim + 1
-    END DO
-
-    PRINT *, ' PBS ! Le jour a lire sur le fichier limit ne se '
-    PRINT *, ' trouve pas sur les ', nannemax, ' annees a partir de '
-    PRINT *, ' l annee de debut', annee_ref
-    CALL abort_physic('condsurf', '', 1)
-
-100 CONTINUE
-
-  ELSE
-
-    WRITE (fich, '("limitNEW.nc")')
-    ! PRINT *,' Fichier  Limite ',fich
-  END IF
-
-  ! Ouvrir le fichier en format NetCDF:
-
-  !$OMP MASTER
-  IF (is_mpi_root) THEN
-    ierr = nf_open(fich, nf_nowrite, nid)
-    IF (ierr/=nf_noerr) THEN
-      WRITE (6, *) ' Pb d''ouverture du fichier ', fich
-      WRITE (6, *) ' Le fichier limit ', fich, ' (avec 4 chiffres , pour'
-      WRITE (6, *) '       l an 2000 )  ,  n existe  pas !  '
-      WRITE (6, *) ' ierr = ', ierr
-      CALL abort_physic('condsurf', '', 1)
-    END IF
-    ! DO k = 1, jour
-    ! La tranche de donnees a lire:
-
-    debut(1) = 1
-    debut(2) = jourvrai
-    epais(1) = klon_glo
-    epais(2) = 1
-    ! Bilan flux de chaleur au sol:
-
-    ierr = nf_inq_varid(nid, 'BILS', nvarid)
-    IF (ierr/=nf_noerr) THEN
-      CALL abort_physic('cond_surf', 'Le champ <BILS> est absent', 1)
-    END IF
-    PRINT *, 'debut,epais', debut, epais, 'jour,jourvrai', jour, jourvrai
-#ifdef NC_DOUBLE
-    ierr = nf_get_vara_double(nid, nvarid, debut, epais, lmt_bils_glo)
-#else
-    ierr = nf_get_vara_real(nid, nvarid, debut, epais, lmt_bils_glo)
-#endif
-    IF (ierr/=nf_noerr) THEN
-      CALL abort_physic('condsurf', 'Lecture echouee pour <BILS>', 1)
-    END IF
-    ! ENDDO !k = 1, jour
-
-    ! Fermer le fichier:
-
-    ierr = nf_close(nid)
-
-  END IF ! is_mpi_root==0
-
-  !$OMP END MASTER
-  CALL scatter(lmt_bils_glo, lmt_bils)
-
-
-
-  ! PRINT*, 'lmt_bils est lu pour jour: ', jour
-
-  RETURN
-END SUBROUTINE condsurf
+link ../phylmd/condsurf.F90
Index: LMDZ6/trunk/libf/phylmdiso/conema3.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/conema3.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/conema3.F90	(revision 3940)
@@ -1,412 +1,1 @@
-
-! $Id: conema3.F90 2346 2015-08-21 15:13:46Z emillour $
-
-SUBROUTINE conema3(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, &
-    bas, top, ma, cape, tvp, rflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, &
-    dplcldr, qcond_incld)
-
-  USE dimphy
-  USE infotrac_phy, ONLY: nbtr
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-  ! Objet: schema de convection de Emanuel (1991) interface
-  ! Mai 1998: Interface modifiee pour implementation dans LMDZ
-  ! ======================================================================
-  ! Arguments:
-  ! dtime---input-R-pas d'integration (s)
-  ! paprs---input-R-pression inter-couches (Pa)
-  ! pplay---input-R-pression au milieu des couches (Pa)
-  ! t-------input-R-temperature (K)
-  ! q-------input-R-humidite specifique (kg/kg)
-  ! u-------input-R-vitesse du vent zonal (m/s)
-  ! v-------input-R-vitesse duvent meridien (m/s)
-  ! tra-----input-R-tableau de rapport de melange des traceurs
-  ! work*: input et output: deux variables de travail,
-  ! on peut les mettre a 0 au debut
-
-  ! d_t-----output-R-increment de la temperature
-  ! d_q-----output-R-increment de la vapeur d'eau
-  ! d_u-----output-R-increment de la vitesse zonale
-  ! d_v-----output-R-increment de la vitesse meridienne
-  ! d_tra---output-R-increment du contenu en traceurs
-  ! rain----output-R-la pluie (mm/s)
-  ! snow----output-R-la neige (mm/s)
-  ! kbas----output-R-bas du nuage (integer)
-  ! ktop----output-R-haut du nuage (integer)
-  ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
-  ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
-  ! dnwdbis-output-R-unsaturated downdraft mass flux (kg/m**2/s)
-  ! bas-----output-R-bas du nuage (real)
-  ! top-----output-R-haut du nuage (real)
-  ! Ma------output-R-flux ascendant non dilue (kg/m**2/s)
-  ! cape----output-R-CAPE
-  ! tvp-----output-R-virtual temperature of the lifted parcel
-  ! rflag---output-R-flag sur le fonctionnement de convect
-  ! pbase---output-R-pression a la base du nuage (Pa)
-  ! bbase---output-R-buoyancy a la base du nuage (K)
-  ! dtvpdt1-output-R-derivative of parcel virtual temp wrt T1
-  ! dtvpdq1-output-R-derivative of parcel virtual temp wrt Q1
-  ! dplcldt-output-R-derivative of the PCP pressure wrt T1
-  ! dplcldr-output-R-derivative of the PCP pressure wrt Q1
-  ! ======================================================================
-
-  include "conema3.h"
-  INTEGER i, l, m, itra
-  INTEGER ntra ! if no tracer transport
-    ! is needed, set ntra = 1 (or 0)
-  REAL dtime
-
-  REAL d_t2(klon, klev), d_q2(klon, klev) ! sbl
-  REAL d_u2(klon, klev), d_v2(klon, klev) ! sbl
-  REAL em_d_t2(klev), em_d_q2(klev) ! sbl
-  REAL em_d_u2(klev), em_d_v2(klev) ! sbl
-
-  REAL paprs(klon, klev+1), pplay(klon, klev)
-  REAL t(klon, klev), q(klon, klev), d_t(klon, klev), d_q(klon, klev)
-  REAL u(klon, klev), v(klon, klev), tra(klon, klev, ntra)
-  REAL d_u(klon, klev), d_v(klon, klev), d_tra(klon, klev, ntra)
-  REAL work1(klon, klev), work2(klon, klev)
-  REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
-  REAL rain(klon)
-  REAL snow(klon)
-  REAL cape(klon), tvp(klon, klev), rflag(klon)
-  REAL pbase(klon), bbase(klon)
-  REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
-  REAL dplcldt(klon), dplcldr(klon)
-  INTEGER kbas(klon), ktop(klon)
-
-  REAL wd(klon)
-  REAL qcond_incld(klon, klev)
-
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-
-  ! ym      REAL em_t(klev)
-  REAL, ALLOCATABLE, SAVE :: em_t(:)
-  !$OMP THREADPRIVATE(em_t)
-  ! ym      REAL em_q(klev)
-  REAL, ALLOCATABLE, SAVE :: em_q(:)
-  !$OMP THREADPRIVATE(em_q)
-  ! ym      REAL em_qs(klev)
-  REAL, ALLOCATABLE, SAVE :: em_qs(:)
-  !$OMP THREADPRIVATE(em_qs)
-  ! ym      REAL em_u(klev), em_v(klev), em_tra(klev,nbtr)
-  REAL, ALLOCATABLE, SAVE :: em_u(:), em_v(:), em_tra(:, :)
-  !$OMP THREADPRIVATE(em_u,em_v,em_tra)
-  ! ym      REAL em_ph(klev+1), em_p(klev)
-  REAL, ALLOCATABLE, SAVE :: em_ph(:), em_p(:)
-  !$OMP THREADPRIVATE(em_ph,em_p)
-  ! ym      REAL em_work1(klev), em_work2(klev)
-  REAL, ALLOCATABLE, SAVE :: em_work1(:), em_work2(:)
-  !$OMP THREADPRIVATE(em_work1,em_work2)
-  ! ym      REAL em_precip, em_d_t(klev), em_d_q(klev)
-  REAL, SAVE :: em_precip
-  !$OMP THREADPRIVATE(em_precip)
-  REAL, ALLOCATABLE, SAVE :: em_d_t(:), em_d_q(:)
-  !$OMP THREADPRIVATE(em_d_t,em_d_q)
-  ! ym      REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,nbtr)
-  REAL, ALLOCATABLE, SAVE :: em_d_u(:), em_d_v(:), em_d_tra(:, :)
-  !$OMP THREADPRIVATE(em_d_u,em_d_v,em_d_tra)
-  ! ym      REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)
-  REAL, ALLOCATABLE, SAVE :: em_upwd(:), em_dnwd(:), em_dnwdbis(:)
-  !$OMP THREADPRIVATE(em_upwd,em_dnwd,em_dnwdbis)
-  REAL em_dtvpdt1(klev), em_dtvpdq1(klev)
-  REAL em_dplcldt, em_dplcldr
-  ! ym      SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2
-  ! ym      SAVE em_u,em_v, em_tra
-  ! ym      SAVE em_d_u,em_d_v, em_d_tra
-  ! ym      SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis
-
-  INTEGER em_bas, em_top
-  SAVE em_bas, em_top
-  !$OMP THREADPRIVATE(em_bas,em_top)
-  REAL em_wd
-  REAL em_qcond(klev)
-  REAL em_qcondc(klev)
-
-  REAL zx_t, zx_qs, zdelta, zcor
-  INTEGER iflag
-  REAL sigsum
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  ! VARIABLES A SORTIR
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccc
-
-  ! ym      REAL emmip(klev) !variation de flux ascnon dilue i et i+1
-  REAL, ALLOCATABLE, SAVE :: emmip(:)
-  !$OMP THREADPRIVATE(emmip)
-  ! ym      SAVE emmip
-  ! ym      real emMke(klev)
-  REAL, ALLOCATABLE, SAVE :: emmke(:)
-  !$OMP THREADPRIVATE(emMke)
-  ! ym      save emMke
-  REAL top
-  REAL bas
-  ! ym      real emMa(klev)
-  REAL, ALLOCATABLE, SAVE :: emma(:)
-  !$OMP THREADPRIVATE(emMa)
-  ! ym      save emMa
-  REAL ma(klon, klev)
-  REAL ment(klev, klev)
-  REAL qent(klev, klev)
-  REAL tps(klev), tls(klev)
-  REAL sij(klev, klev)
-  REAL em_cape, em_tvp(klev)
-  REAL em_pbase, em_bbase
-  INTEGER iw, j, k, ix, iy
-
-  ! -- sb: pour schema nuages:
-
-  INTEGER iflagcon
-  INTEGER em_ifc(klev)
-
-  REAL em_pradj
-  REAL em_cldf(klev), em_cldq(klev)
-  REAL em_ftadj(klev), em_fradj(klev)
-
-  INTEGER ifc(klon, klev)
-  REAL pradj(klon)
-  REAL cldf(klon, klev), cldq(klon, klev)
-  REAL ftadj(klon, klev), fqadj(klon, klev)
-
-  ! sb --
-
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  IF (first) THEN
-
-    ALLOCATE (em_t(klev))
-    ALLOCATE (em_q(klev))
-    ALLOCATE (em_qs(klev))
-    ALLOCATE (em_u(klev), em_v(klev), em_tra(klev,nbtr))
-    ALLOCATE (em_ph(klev+1), em_p(klev))
-    ALLOCATE (em_work1(klev), em_work2(klev))
-    ALLOCATE (em_d_t(klev), em_d_q(klev))
-    ALLOCATE (em_d_u(klev), em_d_v(klev), em_d_tra(klev,nbtr))
-    ALLOCATE (em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev))
-    ALLOCATE (emmip(klev))
-    ALLOCATE (emmke(klev))
-    ALLOCATE (emma(klev))
-
-    first = .FALSE.
-  END IF
-
-  qcond_incld(:, :) = 0.
-
-  ! @$$      print*,'debut conema'
-
-  DO i = 1, klon
-    DO l = 1, klev + 1
-      em_ph(l) = paprs(i, l)/100.0
-    END DO
-
-    DO l = 1, klev
-      em_p(l) = pplay(i, l)/100.0
-      em_t(l) = t(i, l)
-      em_q(l) = q(i, l)
-      em_u(l) = u(i, l)
-      em_v(l) = v(i, l)
-      DO itra = 1, ntra
-        em_tra(l, itra) = tra(i, l, itra)
-      END DO
-      ! @$$      print*,'em_t',em_t
-      ! @$$      print*,'em_q',em_q
-      ! @$$      print*,'em_qs',em_qs
-      ! @$$      print*,'em_u',em_u
-      ! @$$      print*,'em_v',em_v
-      ! @$$      print*,'em_tra',em_tra
-      ! @$$      print*,'em_p',em_p
-
-
-
-      zx_t = em_t(l)
-      zdelta = max(0., sign(1.,rtt-zx_t))
-      zx_qs = r2es*foeew(zx_t, zdelta)/em_p(l)/100.0
-      zx_qs = min(0.5, zx_qs)
-      ! @$$       print*,'zx_qs',zx_qs
-      zcor = 1./(1.-retv*zx_qs)
-      zx_qs = zx_qs*zcor
-      em_qs(l) = zx_qs
-      ! @$$      print*,'em_qs',em_qs
-
-      em_work1(l) = work1(i, l)
-      em_work2(l) = work2(i, l)
-      emmke(l) = 0
-      ! emMa(l)=0
-      ! Ma(i,l)=0
-
-      em_dtvpdt1(l) = 0.
-      em_dtvpdq1(l) = 0.
-      dtvpdt1(i, l) = 0.
-      dtvpdq1(i, l) = 0.
-    END DO
-
-    em_dplcldt = 0.
-    em_dplcldr = 0.
-    rain(i) = 0.0
-    snow(i) = 0.0
-    kbas(i) = 1
-    ktop(i) = 1
-    ! ajout SB:
-    bas = 1
-    top = 1
-
-
-    ! sb3d      write(*,1792) (em_work1(m),m=1,klev)
-1792 FORMAT ('sig avant convect ', /, 10(1X,E13.5))
-
-    ! sb d      write(*,1793) (em_work2(m),m=1,klev)
-1793 FORMAT ('w avant convect ', /, 10(1X,E13.5))
-
-    ! @$$      print*,'avant convect'
-    ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-    ! print*,'avant convect i=',i
-    CALL convect3(dtime, epmax, ok_adj_ema, em_t, em_q, em_qs, em_u, em_v, &
-      em_tra, em_p, em_ph, klev, klev+1, klev-1, ntra, dtime, iflag, em_d_t, &
-      em_d_q, em_d_u, em_d_v, em_d_tra, em_precip, em_bas, em_top, em_upwd, &
-      em_dnwd, em_dnwdbis, em_work1, em_work2, emmip, emmke, emma, ment, &
-      qent, tps, tls, sij, em_cape, em_tvp, em_pbase, em_bbase, em_dtvpdt1, &
-      em_dtvpdq1, em_dplcldt, em_dplcldr, & ! sbl
-      em_d_t2, em_d_q2, em_d_u2, em_d_v2, em_wd, em_qcond, em_qcondc) !sbl
-    ! print*,'apres convect '
-
-    ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-    ! -- sb: Appel schema statistique de nuages couple a la convection
-    ! (Bony et Emanuel 2001):
-
-    ! -- creer cvthermo.h qui contiendra les cstes thermo de LMDZ:
-
-    iflagcon = 3
-    ! CALL cv_thermo(iflagcon)
-
-    ! -- appel schema de nuages:
-
-    ! CALL CLOUDS_SUB_LS(klev,em_q,em_qs,em_t
-    ! i          ,em_p,em_ph,dtime,em_qcondc
-    ! o          ,em_cldf,em_cldq,em_pradj,em_ftadj,em_fradj,em_ifc)
-
-    DO k = 1, klev
-      cldf(i, k) = em_cldf(k) ! cloud fraction (0-1)
-      cldq(i, k) = em_cldq(k) ! in-cloud water content (kg/kg)
-      ftadj(i, k) = em_ftadj(k) ! (dT/dt)_{LS adj} (K/s)
-      fqadj(i, k) = em_fradj(k) ! (dq/dt)_{LS adj} (kg/kg/s)
-      ifc(i, k) = em_ifc(k) ! flag convergence clouds_gno (1 ou 2)
-    END DO
-    pradj(i) = em_pradj ! precip from LS supersat adj (mm/day)
-
-    ! sb --
-
-    ! SB:
-    IF (iflag/=1 .AND. iflag/=4) THEN
-      em_cape = 0.
-      DO l = 1, klev
-        em_upwd(l) = 0.
-        em_dnwd(l) = 0.
-        em_dnwdbis(l) = 0.
-        emma(l) = 0.
-        em_tvp(l) = 0.
-      END DO
-    END IF
-    ! fin SB
-
-    ! If sig has been set to zero, then set Ma to zero
-
-    sigsum = 0.
-    DO k = 1, klev
-      sigsum = sigsum + em_work1(k)
-    END DO
-    IF (sigsum==0.0) THEN
-      DO k = 1, klev
-        emma(k) = 0.
-      END DO
-    END IF
-
-    ! sb3d       print*,'i, iflag=',i,iflag
-
-    ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-    ! SORTIE DES ICB ET INB
-    ! en fait inb et icb correspondent au niveau ou se trouve
-    ! le nuage,le numero d'interface
-    ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-    ! modif SB:
-    IF (iflag==1 .OR. iflag==4) THEN
-      top = em_top
-      bas = em_bas
-      kbas(i) = em_bas
-      ktop(i) = em_top
-    END IF
-
-    pbase(i) = em_pbase
-    bbase(i) = em_bbase
-    rain(i) = em_precip/86400.0
-    snow(i) = 0.0
-    cape(i) = em_cape
-    wd(i) = em_wd
-    rflag(i) = real(iflag)
-    ! SB      kbas(i) = em_bas
-    ! SB      ktop(i) = em_top
-    dplcldt(i) = em_dplcldt
-    dplcldr(i) = em_dplcldr
-    DO l = 1, klev
-      d_t2(i, l) = dtime*em_d_t2(l)
-      d_q2(i, l) = dtime*em_d_q2(l)
-      d_u2(i, l) = dtime*em_d_u2(l)
-      d_v2(i, l) = dtime*em_d_v2(l)
-
-      d_t(i, l) = dtime*em_d_t(l)
-      d_q(i, l) = dtime*em_d_q(l)
-      d_u(i, l) = dtime*em_d_u(l)
-      d_v(i, l) = dtime*em_d_v(l)
-      DO itra = 1, ntra
-        d_tra(i, l, itra) = dtime*em_d_tra(l, itra)
-      END DO
-      upwd(i, l) = em_upwd(l)
-      dnwd(i, l) = em_dnwd(l)
-      dnwdbis(i, l) = em_dnwdbis(l)
-      work1(i, l) = em_work1(l)
-      work2(i, l) = em_work2(l)
-      ma(i, l) = emma(l)
-      tvp(i, l) = em_tvp(l)
-      dtvpdt1(i, l) = em_dtvpdt1(l)
-      dtvpdq1(i, l) = em_dtvpdq1(l)
-
-      IF (iflag_clw==0) THEN
-        qcond_incld(i, l) = em_qcondc(l)
-      ELSE IF (iflag_clw==1) THEN
-        qcond_incld(i, l) = em_qcond(l)
-      END IF
-    END DO
-  END DO
-
-  ! On calcule une eau liquide diagnostique en fonction de la
-  ! precip.
-  IF (iflag_clw==2) THEN
-    DO l = 1, klev
-      DO i = 1, klon
-        IF (ktop(i)-kbas(i)>0 .AND. l>=kbas(i) .AND. l<=ktop(i)) THEN
-          qcond_incld(i, l) = rain(i)*8.E4 & ! s         *(pplay(i,l
-                                             ! )-paprs(i,ktop(i)+1))
-            /(pplay(i,kbas(i))-pplay(i,ktop(i)))
-          ! s         **2
-        ELSE
-          qcond_incld(i, l) = 0.
-        END IF
-      END DO
-      PRINT *, 'l=', l, ',   qcond_incld=', qcond_incld(1, l)
-    END DO
-  END IF
-
-
-  RETURN
-END SUBROUTINE conema3
-
+link ../phylmd/conema3.F90
Index: LMDZ6/trunk/libf/phylmdiso/conema3.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/conema3.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/conema3.h	(revision 3940)
@@ -1,25 +1,1 @@
-!
-! $Header$
-!-- Modified by : Filiberti M-A 06/2005
-!
-      real epmax             ! 0.993
-      real coef_epmax_cape             ! 0.993
-!jyg<
-      REAL  cvl_comp_threshold     ! 0.
-!>jyg
-      logical ok_adj_ema      ! F
-      integer iflag_clw      ! 0
-      integer iflag_cvl_sigd
-      real cvl_sig2feed      ! 0.97
-
-!jyg<
-!!      common/comconema1/epmax,coef_epmax_cape,ok_adj_ema,iflag_clw,sig1feed,sig2feed
-!!      common/comconema2/iflag_cvl_sigd
-      common/comconema1/epmax,coef_epmax_cape, cvl_comp_threshold, cvl_sig2feed
-      common/comconema2/iflag_cvl_sigd, iflag_clw, ok_adj_ema
-!>jyg
-
-!      common/comconema/epmax,coef_epmax_cape,ok_adj_ema,iflag_clw
-!$OMP THREADPRIVATE(/comconema1/)
-!$OMP THREADPRIVATE(/comconema2/)
-
+link ../phylmd/conema3.h
Index: LMDZ6/trunk/libf/phylmdiso/conemav.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/conemav.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/conemav.F90	(revision 3940)
@@ -1,146 +1,1 @@
-
-! $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)
-
-
-  USE dimphy
-  USE infotrac_phy, ONLY: nbtr
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-  ! 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
-
-  ! 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)
-  ! Cape----output-R-CAPE (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
-  ! ======================================================================
-
-
-  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)
-  INTEGER ntra
-  REAL work1(klon, klev), work2(klon, klev)
-
-  REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev)
-  REAL d_tra(klon, klev, nbtr)
-  REAL rain(klon), snow(klon)
-
-  INTEGER kbas(klon), ktop(klon)
-  REAL em_ph(klon, klev+1), em_p(klon, klev)
-  REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
-  REAL ma(klon, klev), cape(klon), tvp(klon, klev)
-  INTEGER iflag(klon)
-  REAL rflag(klon)
-  REAL pbase(klon), bbase(klon)
-  REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
-  REAL dplcldt(klon), dplcldr(klon)
-
-  REAL zx_t, zdelta, zx_qs, zcor
-
-  INTEGER noff, minorig
-  INTEGER i, k, itra
-  REAL qs(klon, klev)
-  REAL, ALLOCATABLE, SAVE :: cbmf(:)
-  !$OMP THREADPRIVATE(cbmf)
-  INTEGER ifrst
-  SAVE ifrst
-  DATA ifrst/0/
-  !$OMP THREADPRIVATE(ifrst)
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-
-  IF (ifrst==0) THEN
-    ifrst = 1
-    ALLOCATE (cbmf(klon))
-    DO i = 1, klon
-      cbmf(i) = 0.
-    END DO
-  END IF
-
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      em_ph(i, k) = paprs(i, k)/100.0
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      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
-    END DO
-  END DO
-
-  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)
-
-  DO i = 1, klon
-    rain(i) = rain(i)/86400.
-    rflag(i) = iflag(i)
-  END DO
-  ! call dump2d(iim,jjm-1,rflag(2:klon-1),'FLAG CONVECTION   ')
-  ! if (klon.eq.1) then
-  ! print*,'IFLAG ',iflag
-  ! else
-  ! write(*,'(96i1)') (iflag(i),i=2,klon-1)
-  ! endif
-  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)
-    END DO
-    DO itra = 1, ntra
-      DO i = 1, klon
-        d_tra(i, k, itra) = 0.
-      END DO
-    END DO
-  END DO
-
-
-
-
-  RETURN
-END SUBROUTINE conemav
-
+link ../phylmd/conemav.F90
Index: LMDZ6/trunk/libf/phylmdiso/conf_phys_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/conf_phys_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/conf_phys_m.F90	(revision 3940)
@@ -1,2801 +1,1 @@
-!
-! $Id: conf_phys.F90 1668 2012-10-12 10:47:37Z idelkadi $
-!
-!
-!
-MODULE conf_phys_m
-
-  IMPLICIT NONE
-
-CONTAINS
-
-  SUBROUTINE conf_phys(ok_journe, ok_mensuel, ok_instan, ok_hf, &
-       ok_LES,&
-       callstats,&
-       solarlong0,seuil_inversion, &
-       fact_cldcon, facttemps,ok_newmicro,iflag_radia,&
-       iflag_cld_th, &
-       iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
-       ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, aerosol_couple, chemistry_couple, &
-       flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
-       flag_bc_internal_mixture, bl95_b0, bl95_b1,&
-       read_climoz, &
-       alp_offset)
-
-    USE IOIPSL
-    USE surface_data
-    USE phys_cal_mod
-    USE carbon_cycle_mod,  ONLY: carbon_cycle_tr, carbon_cycle_cpl, carbon_cycle_rad, level_coupling_esm
-    USE mod_grid_phy_lmdz, ONLY: klon_glo
-    USE print_control_mod, ONLY: lunout
-    USE phys_state_var_mod, ONLY: phys_tstep
-
-    INCLUDE "conema3.h"
-    INCLUDE "fisrtilp.h"
-    INCLUDE "nuage.h"
-    INCLUDE "YOMCST.h"
-    INCLUDE "YOMCST2.h"
-    INCLUDE "thermcell.h"
-
-    !IM : on inclut/initialise les taux de CH4, N2O, CFC11 et CFC12
-    INCLUDE "clesphys.h"
-    INCLUDE "compbl.h"
-    INCLUDE "comsoil.h"
-    INCLUDE "YOEGWD.h"
-    !
-    ! Configuration de la "physique" de LMDZ a l'aide de la fonction
-    ! GETIN de IOIPSL
-    !
-    ! LF 05/2001
-    !
-    ! type_ocean:      type d'ocean (force, slab, couple)
-    ! version_ocean:   version d'ocean (opa8/nemo pour type_ocean=couple ou 
-    !                                   sicOBS,sicINT,sicNO pour type_ocean=slab)
-    ! ok_veget:   type de modele de vegetation
-    ! ok_journe:  sorties journalieres
-    ! ok_hf:  sorties haute frequence
-    ! ok_mensuel: sorties mensuelles
-    ! ok_instan:  sorties instantanees
-    ! ok_ade, ok_aie: apply or not aerosol direct and indirect effects
-    ! ok_alw: activate aerosol LW effect
-    ! ok_cdnc, ok cloud droplet number concentration
-    ! flag_aerosol_strat : flag pour les aerosols stratos
-    ! flag_bc_internal_mixture : use BC internal mixture if true
-    ! bl95_b*: parameters in the formula to link CDNC to aerosol mass conc 
-    ! ok_volcan: activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
-    !
-
-    ! Sortie:
-    LOGICAL              :: ok_newmicro
-    INTEGER              :: iflag_radia
-    LOGICAL              :: ok_journe, ok_mensuel, ok_instan, ok_hf
-    LOGICAL              :: ok_LES
-    LOGICAL              :: callstats
-    LOGICAL              :: ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan
-    LOGICAL              :: aerosol_couple, chemistry_couple
-    INTEGER              :: flag_aerosol
-    INTEGER              :: flag_aerosol_strat
-    LOGICAL              :: flag_aer_feedback
-    LOGICAL              :: flag_bc_internal_mixture
-    REAL                 :: bl95_b0, bl95_b1
-    REAL                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut,tau_ratqs
-    INTEGER              :: iflag_cld_th
-    INTEGER              :: iflag_ratqs
-
-    CHARACTER (len = 6), SAVE  :: type_ocean_omp, version_ocean_omp, ocean_omp
-    CHARACTER (len = 10),SAVE  :: type_veget_omp
-    CHARACTER (len = 8), SAVE  :: aer_type_omp
-    LOGICAL, SAVE       :: ok_snow_omp
-    LOGICAL, SAVE       :: ok_newmicro_omp
-    LOGICAL, SAVE       :: ok_all_xml_omp
-    LOGICAL, SAVE       :: ok_lwoff_omp
-    LOGICAL, SAVE       :: ok_journe_omp, ok_mensuel_omp, ok_instan_omp, ok_hf_omp        
-    LOGICAL, SAVE       :: ok_LES_omp   
-    LOGICAL, SAVE       :: callstats_omp
-    LOGICAL, SAVE       :: ok_ade_omp, ok_aie_omp, ok_alw_omp, ok_cdnc_omp, ok_volcan_omp
-    LOGICAL, SAVE       :: aerosol_couple_omp, chemistry_couple_omp
-    INTEGER, SAVE       :: flag_aerosol_omp
-    INTEGER, SAVE       :: flag_aerosol_strat_omp
-    LOGICAL, SAVE       :: flag_aer_feedback_omp
-    LOGICAL, SAVE       :: flag_bc_internal_mixture_omp
-    REAL,SAVE           :: bl95_b0_omp, bl95_b1_omp
-    REAL,SAVE           :: freq_ISCCP_omp, ecrit_ISCCP_omp
-    REAL,SAVE           :: freq_COSP_omp, freq_AIRS_omp 
-    REAL,SAVE           :: fact_cldcon_omp, facttemps_omp,ratqsbas_omp
-    REAL,SAVE           :: tau_cld_cv_omp, coefw_cld_cv_omp
-    INTEGER, SAVE       :: iflag_cld_cv_omp
-
-    REAL, SAVE          :: ratqshaut_omp
-    REAL, SAVE          :: tau_ratqs_omp
-    REAL, SAVE          :: t_coupl_omp
-    INTEGER, SAVE       :: iflag_radia_omp
-    INTEGER, SAVE       :: iflag_rrtm_omp
-    INTEGER, SAVE       :: iflag_albedo_omp !albedo SB
-    LOGICAL, SAVE       :: ok_chlorophyll_omp ! albedo SB  
-    INTEGER, SAVE       :: NSW_omp
-    INTEGER, SAVE       :: iflag_cld_th_omp, ip_ebil_phy_omp
-    INTEGER, SAVE       :: iflag_ratqs_omp
-
-    REAL, SAVE          :: f_cdrag_ter_omp,f_cdrag_oce_omp
-    REAL, SAVE          :: f_rugoro_omp   , z0min_omp
-    REAL, SAVE          :: z0m_seaice_omp,z0h_seaice_omp
-    REAL, SAVE          :: min_wind_speed_omp,f_gust_wk_omp,f_gust_bl_omp,f_qsat_oce_omp, f_z0qh_oce_omp
-    INTEGER, SAVE       :: iflag_gusts_omp,iflag_z0_oce_omp
-
-    ! Local
-    REAL                 :: zzz
-
-    REAL :: seuil_inversion
-    REAL,SAVE :: seuil_inversion_omp
-
-    INTEGER,SAVE :: iflag_thermals_ed_omp,iflag_thermals_optflux_omp,iflag_thermals_closure_omp
-    REAL, SAVE :: fact_thermals_ed_dz_omp
-    INTEGER,SAVE :: iflag_thermals_omp,nsplit_thermals_omp
-    REAL,SAVE :: tau_thermals_omp,alp_bl_k_omp
-    ! nrlmd le 10/04/2012
-    INTEGER,SAVE :: iflag_trig_bl_omp,iflag_clos_bl_omp
-    INTEGER,SAVE :: tau_trig_shallow_omp,tau_trig_deep_omp
-    REAL,SAVE    :: s_trig_omp
-    ! fin nrlmd le 10/04/2012
-    REAL :: alp_offset
-    REAL, SAVE :: alp_offset_omp
-    INTEGER,SAVE :: iflag_coupl_omp,iflag_clos_omp,iflag_wake_omp
-    INTEGER,SAVE :: iflag_cvl_sigd_omp
-    REAL, SAVE :: coef_clos_ls_omp
-    REAL, SAVE :: supcrit1_omp, supcrit2_omp
-    INTEGER, SAVE :: iflag_mix_omp
-    INTEGER, SAVE :: iflag_mix_adiab_omp
-    REAL, SAVE :: scut_omp, qqa1_omp, qqa2_omp, gammas_omp, Fmax_omp, alphas_omp
-    REAL, SAVE :: tmax_fonte_cv_omp
-
-    REAL,SAVE :: R_ecc_omp,R_peri_omp,R_incl_omp,solaire_omp
-    REAL,SAVE      :: solaire_omp_init
-    LOGICAL,SAVE :: ok_suntime_rrtm_omp
-    REAL,SAVE :: co2_ppm_omp, RCO2_omp, co2_ppm_per_omp, RCO2_per_omp
-    REAL,SAVE :: CH4_ppb_omp, RCH4_omp, CH4_ppb_per_omp, RCH4_per_omp
-    REAL,SAVE :: N2O_ppb_omp, RN2O_omp, N2O_ppb_per_omp, RN2O_per_omp
-    REAL,SAVE :: CFC11_ppt_omp,RCFC11_omp,CFC11_ppt_per_omp,RCFC11_per_omp
-    REAL,SAVE :: CFC12_ppt_omp,RCFC12_omp,CFC12_ppt_per_omp,RCFC12_per_omp
-    REAL,SAVE :: epmax_omp
-    REAL,SAVE :: coef_epmax_cape_omp
-    LOGICAL,SAVE :: ok_adj_ema_omp
-    INTEGER,SAVE :: iflag_clw_omp
-    REAL,SAVE :: cld_lc_lsc_omp,cld_lc_con_omp,cld_tau_lsc_omp,cld_tau_con_omp
-    REAL,SAVE :: ffallv_lsc_omp, ffallv_con_omp,coef_eva_omp
-    LOGICAL,SAVE :: reevap_ice_omp
-    INTEGER,SAVE :: iflag_pdf_omp
-    INTEGER,SAVE :: iflag_ice_thermo_omp
-    INTEGER,SAVE :: iflag_t_glace_omp
-    INTEGER,SAVE :: iflag_cloudth_vert_omp
-    INTEGER,SAVE :: iflag_rain_incloud_vol_omp
-    REAL,SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp
-    REAL,SAVE :: t_glace_min_omp, t_glace_max_omp
-    REAL,SAVE :: exposant_glace_omp
-    REAL,SAVE :: rei_min_omp, rei_max_omp
-    INTEGER,SAVE :: iflag_sic_omp
-    REAL,SAVE :: inertie_sol_omp,inertie_sno_omp,inertie_sic_omp
-    REAL,SAVE :: inertie_lic_omp
-    REAL,SAVE :: qsol0_omp
-    REAL,SAVE :: evap0_omp
-    REAL,SAVE :: albsno0_omp
-    REAL      :: solarlong0
-    REAL,SAVE :: solarlong0_omp
-    INTEGER,SAVE :: top_height_omp,overlap_omp
-    REAL,SAVE :: cdmmax_omp,cdhmax_omp,ksta_omp,ksta_ter_omp,f_ri_cd_min_omp
-    LOGICAL,SAVE :: ok_kzmin_omp
-    REAL, SAVE   :: pbl_lmixmin_alpha_omp
-    REAL, SAVE ::  fmagic_omp, pmagic_omp
-    INTEGER,SAVE :: iflag_pbl_omp,lev_histhf_omp,lev_histday_omp,lev_histmth_omp
-    INTEGER,SAVE :: iflag_pbl_split_omp
-!FC
-    INTEGER,SAVE :: ifl_pbltree_omp
-    REAL,SAVE :: Cd_frein_omp
-!FC
-    INTEGER,SAVE :: iflag_order2_sollw_omp
-    INTEGER, SAVE :: lev_histins_omp, lev_histLES_omp 
-    INTEGER, SAVE :: lev_histdayNMC_omp
-    INTEGER, SAVE :: levout_histNMC_omp(3)
-    LOGICAL, SAVE :: ok_histNMC_omp(3)
-    REAL, SAVE    :: freq_outNMC_omp(3), freq_calNMC_omp(3)
-    CHARACTER*4, SAVE :: type_run_omp
-    LOGICAL, SAVE :: ok_cosp_omp, ok_airs_omp
-    LOGICAL, SAVE :: ok_mensuelCOSP_omp,ok_journeCOSP_omp,ok_hfCOSP_omp
-    REAL, SAVE    :: lonmin_ins_omp, lonmax_ins_omp, latmin_ins_omp, latmax_ins_omp
-    REAL, SAVE    :: ecrit_hf_omp, ecrit_day_omp, ecrit_mth_omp, ecrit_reg_omp
-    REAL, SAVE    :: ecrit_ins_omp
-    REAL, SAVE    :: ecrit_LES_omp
-    REAL, SAVE    :: ecrit_tra_omp
-    REAL, SAVE    :: cvl_comp_threshold_omp
-    REAL, SAVE    :: cvl_sig2feed_omp
-    REAL, SAVE    :: cvl_corr_omp
-    LOGICAL, SAVE :: ok_lic_melt_omp
-    LOGICAL, SAVE :: ok_lic_cond_omp
-    !
-    INTEGER, SAVE :: iflag_cycle_diurne_omp
-    LOGICAL, SAVE :: soil_model_omp,new_oliq_omp
-    LOGICAL, SAVE :: ok_orodr_omp, ok_orolf_omp, ok_limitvrai_omp
-    INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
-    INTEGER, SAVE :: nbapp_cv_omp, nbapp_wk_omp
-    INTEGER, SAVE :: iflag_ener_conserv_omp
-    LOGICAL, SAVE :: ok_conserv_q_omp
-    INTEGER, SAVE :: iflag_fisrtilp_qsat_omp
-    INTEGER, SAVE :: iflag_bergeron_omp
-    LOGICAL,SAVE  :: ok_strato_omp
-    LOGICAL,SAVE  :: ok_hines_omp, ok_gwd_rando_omp
-    REAL, SAVE    :: gwd_rando_ruwmax_omp, gwd_rando_sat_omp
-    REAL, SAVE    :: gwd_front_ruwmax_omp, gwd_front_sat_omp
-    REAL, SAVE    :: sso_gkdrag_omp,sso_grahil_omp,sso_grcrit_omp
-    REAL, SAVE    :: sso_gfrcri_omp,sso_gkwake_omp,sso_gklift_omp
-    LOGICAL, SAVE :: ok_qch4_omp
-    LOGICAL, SAVE :: carbon_cycle_tr_omp
-    LOGICAL, SAVE :: carbon_cycle_cpl_omp
-    LOGICAL, SAVE :: carbon_cycle_rad_omp
-    INTEGER, SAVE :: level_coupling_esm_omp
-    LOGICAL, SAVE :: adjust_tropopause_omp
-    LOGICAL, SAVE :: ok_daily_climoz_omp
-
-    INTEGER, INTENT(OUT):: read_climoz ! read ozone climatology, OpenMP shared
-    ! Allowed values are 0, 1 and 2
-    ! 0: do not read an ozone climatology
-    ! 1: read a single ozone climatology that will be used day and night
-    ! 2: read two ozone climatologies, the average day and night
-    ! climatology and the daylight climatology
-
-    !-----------------------------------------------------------------
-
-    print*,'CONFPHYS ENTREE'
-    !$OMP MASTER 
-    !Config Key  = type_ocean 
-    !Config Desc = Type d'ocean
-    !Config Def  = force
-    !Config Help = Type d'ocean utilise: force, slab,couple
-    !
-    type_ocean_omp = 'force '
-    CALL getin('type_ocean', type_ocean_omp)
-    !
-    !Config Key  = version_ocean 
-    !Config Desc = Version d'ocean
-    !Config Def  = xxxxxx
-    !Config Help = Version d'ocean utilise: opa8/nemo/sicOBS/xxxxxx
-    !
-    version_ocean_omp = 'xxxxxx'
-    CALL getin('version_ocean', version_ocean_omp)
-
-    !Config Key  = OCEAN
-    !Config Desc = Old parameter name for type_ocean
-    !Config Def  = yyyyyy
-    !Config Help = This is only for testing purpose
-    !
-    ocean_omp = 'yyyyyy'
-    CALL getin('OCEAN', ocean_omp)
-    IF (ocean_omp /= 'yyyyyy') THEN
-       WRITE(lunout,*)'ERROR! Old variable name OCEAN used in parmeter file.'
-       WRITE(lunout,*)'Variable OCEAN has been replaced by the variable type_ocean.'
-       WRITE(lunout,*)'You have to update your parameter file physiq.def to succed running'
-       CALL abort_physic('conf_phys','Variable OCEAN no longer existing, use variable name type_ocean',1)
-    ENDIF
-
-    !Config Key  = t_coupl
-    !Config Desc = Pas de temps du couplage atm/oce en sec.
-    !Config Def  = 86400
-    !Config Help = This is only for testing purpose
-    !
-    t_coupl_omp = 86400.
-    CALL getin('t_coupl', t_coupl_omp)
-    IF (t_coupl_omp == 0) THEN
-       WRITE(lunout,*)'ERROR! Timestep of coupling between atmosphere and ocean'
-       WRITE(lunout,*)'cannot be zero.'
-       CALL abort_physic('conf_phys','t_coupl = 0.',1)
-    ENDIF
-
-    !
-    !Config Key  = ok_all_xml 
-    !Config Desc = utiliser les xml pourles définitions des champs pour xios
-    !Config Def  = .FALSE.
-    !Config Help = 
-    !
-    ok_all_xml_omp = .FALSE.
-    CALL getin('ok_all_xml', ok_all_xml_omp)
-
-    !
-    !Config Key  = ok_lwoff
-    !Config Desc = inhiber l effet radiatif LW des nuages
-    !Config Def  = .FALSE.
-    !Config Help = 
-    !
-    ok_lwoff_omp = .FALSE.
-    CALL getin('ok_lwoff', ok_lwoff_omp)
-    !
-
-    !
-    !Config Key  = VEGET 
-    !Config Desc = Type de modele de vegetation
-    !Config Def  = .FALSE.
-    !Config Help = Type de modele de vegetation utilise
-    !
-    type_veget_omp ='orchidee'
-    CALL getin('VEGET', type_veget_omp)
-    !
-
-    ! Martin
-    !Config Key  = ok_snow
-    !Config Desc = Flag to activate snow model SISVAT
-    !Config Def  = .FALSE.
-    ok_snow_omp = .FALSE.
-    CALL getin('ok_snow', ok_snow_omp)
-    ! Martin
-
-    !Config Key  = OK_journe
-    !Config Desc = Pour des sorties journalieres 
-    !Config Def  = .FALSE.
-    !Config Help = Pour creer le fichier histday contenant les sorties
-    !              journalieres 
-    !
-    ok_journe_omp = .FALSE.
-    CALL getin('OK_journe', ok_journe_omp)
-    !
-    !Config Key  = ok_hf
-    !Config Desc = Pour des sorties haute frequence
-    !Config Def  = .FALSE.
-    !Config Help = Pour creer le fichier histhf contenant les sorties
-    !              haute frequence ( 3h ou 6h)
-    !
-    ok_hf_omp = .FALSE.
-    CALL getin('ok_hf', ok_hf_omp)
-    !
-    !Config Key  = OK_mensuel
-    !Config Desc = Pour des sorties mensuelles 
-    !Config Def  = .TRUE.
-    !Config Help = Pour creer le fichier histmth contenant les sorties
-    !              mensuelles 
-    !
-    ok_mensuel_omp = .TRUE.
-    CALL getin('OK_mensuel', ok_mensuel_omp)
-    !
-    !Config Key  = OK_instan
-    !Config Desc = Pour des sorties instantanees 
-    !Config Def  = .FALSE.
-    !Config Help = Pour creer le fichier histins contenant les sorties
-    !              instantanees 
-    !
-    ok_instan_omp = .FALSE.
-    CALL getin('OK_instan', ok_instan_omp)
-    !
-    !Config Key  = ok_ade
-    !Config Desc = Aerosol direct effect or not?
-    !Config Def  = .FALSE.
-    !Config Help = Used in radlwsw.F
-    !
-    ok_ade_omp = .FALSE.
-    CALL getin('ok_ade', ok_ade_omp)
-
-    !Config Key  = ok_alw
-    !Config Desc = Aerosol longwave effect or not?
-    !Config Def  = .FALSE.
-    !Config Help = Used in radlwsw.F
-    !
-    ok_alw_omp = .FALSE.
-    CALL getin('ok_alw', ok_alw_omp)
-
-    !
-    !Config Key  = ok_aie
-    !Config Desc = Aerosol indirect effect or not?
-    !Config Def  = .FALSE.
-    !Config Help = Used in nuage.F and radlwsw.F
-    !
-    ok_aie_omp = .FALSE.
-    CALL getin('ok_aie', ok_aie_omp)
-
-    !
-    !Config Key  = ok_cdnc
-    !Config Desc = ok cloud droplet number concentration
-    !Config Def  = .FALSE.
-    !Config Help = Used in newmicro.F
-    !
-    ok_cdnc_omp = .FALSE.
-    CALL getin('ok_cdnc', ok_cdnc_omp)
-
-    !
-    !Config Key  = ok_volcan
-    !Config Desc = ok to generate volcanic diags
-    !Config Def  = .FALSE.
-    !Config Help = Used in radlwsw_m.F
-    !
-    ok_volcan_omp = .FALSE.
-    CALL getin('ok_volcan', ok_volcan_omp)
-
-    !
-    !Config Key  = aerosol_couple
-    !Config Desc = read aerosol in file or calcul by inca
-    !Config Def  = .FALSE.
-    !Config Help = Used in physiq.F
-    !
-    aerosol_couple_omp = .FALSE.
-    CALL getin('aerosol_couple',aerosol_couple_omp)
-    !
-    !Config Key  = chemistry_couple
-    !Config Desc = read O3 chemistry in file or calcul by inca
-    !Config Def  = .FALSE.
-    !Config Help = Used in physiq.F
-    !
-    chemistry_couple_omp = .FALSE.
-    CALL getin('chemistry_couple',chemistry_couple_omp)
-    !
-    !Config Key  = flag_aerosol
-    !Config Desc = which aerosol is use for coupled model
-    !Config Def  = 1
-    !Config Help = Used in physiq.F
-    !
-    ! - flag_aerosol=0 => no aerosol
-    ! - flag_aerosol=1 => so4 only (defaut) 
-    ! - flag_aerosol=2 => bc  only 
-    ! - flag_aerosol=3 => pom only
-    ! - flag_aerosol=4 => seasalt only 
-    ! - flag_aerosol=5 => dust only
-    ! - flag_aerosol=6 => all aerosol
-    ! - flag_aerosol=7 => natural aerosol + MACv2SP
-    ! - (in this case aerosols.1980.nc should point to aerosols.nat.nc)
-
-    flag_aerosol_omp = 0
-    CALL getin('flag_aerosol',flag_aerosol_omp)
-
-    !
-    !Config Key  = flag_bc_internal_mixture
-    !Config Desc = state of mixture for BC aerosols
-    ! - n = external mixture
-    ! - y = internal mixture
-    !Config Def  = n
-    !Config Help = Used in physiq.F / aeropt
-    !
-    flag_bc_internal_mixture_omp = .FALSE.
-    CALL getin('flag_bc_internal_mixture',flag_bc_internal_mixture_omp)
-
-    ! 
-    !Config Key  = aer_type 
-    !Config Desc = Use a constant field for the aerosols 
-    !Config Def  = scenario 
-    !Config Help = Used in readaerosol.F90 
-    ! 
-    aer_type_omp = 'scenario' 
-    CALL getin('aer_type', aer_type_omp) 
-
-    !
-    !Config Key  = bl95_b0
-    !Config Desc = Parameter in CDNC-maer link (Boucher&Lohmann 1995)
-    !Config Def  = .FALSE.
-    !Config Help = Used in nuage.F
-    !
-    bl95_b0_omp = 2.
-    CALL getin('bl95_b0', bl95_b0_omp)
-
-    !Config Key  = bl95_b1
-    !Config Desc = Parameter in CDNC-maer link (Boucher&Lohmann 1995)
-    !Config Def  = .FALSE.
-    !Config Help = Used in nuage.F
-    !
-    bl95_b1_omp = 0.2
-    CALL getin('bl95_b1', bl95_b1_omp)
-
-    !Config Key  = freq_ISCCP
-    !Config Desc = Frequence d'appel du simulateur ISCCP en secondes;
-    !              par defaut 10800, i.e. 3 heures 
-    !Config Def  = 10800.
-    !Config Help = Used in ini_histISCCP.h
-    !
-    freq_ISCCP_omp = 10800.
-    CALL getin('freq_ISCCP', freq_ISCCP_omp)
-    !
-    !Config Key  = ecrit_ISCCP
-    !Config Desc = Frequence d'ecriture des resultats du simulateur ISCCP en nombre de jours;
-    !              par defaut 1., i.e. 1 jour
-    !Config Def  = 1.
-    !Config Help = Used in ini_histISCCP.h
-    !
-    !
-    ecrit_ISCCP_omp = 1.
-    CALL getin('ecrit_ISCCP', ecrit_ISCCP_omp)
-
-    !Config Key  = freq_COSP
-    !Config Desc = Frequence d'appel du simulateur COSP en secondes;
-    !              par defaut 10800, i.e. 3 heures
-    !Config Def  = 10800.
-    !Config Help = Used in ini_histdayCOSP.h
-    !
-    freq_COSP_omp = 10800.
-    CALL getin('freq_COSP', freq_COSP_omp)
-
-    !Config Key  = freq_AIRS
-    !Config Desc = Frequence d'appel du simulateur AIRS en secondes;
-    !              par defaut 10800, i.e. 3 heures
-    !Config Def  = 10800.
-    !Config Help = Used in ini_histdayAIRS.h
-    !
-    freq_AIRS_omp = 10800.
-    CALL getin('freq_AIRS', freq_AIRS_omp)
-
-    !
-    !Config Key  = ip_ebil_phy
-    !Config Desc = Niveau de sortie pour les diags bilan d'energie 
-    !Config Def  = 0
-    !Config Help = 
-    !               
-    ip_ebil_phy_omp = 0
-    CALL getin('ip_ebil_phy', ip_ebil_phy_omp)
-    IF (ip_ebil_phy_omp/=0) THEN
-       CALL abort_physic('conf_phys','ip_ebil_phy_omp doit etre 0 sur cette version',1)
-    ENDIF
-
-    !
-    !Config Key  = seuil_inversion
-    !Config Desc = Seuil ur dTh pour le choix entre les schemas de CL
-    !Config Def  = -0.1
-    !Config Help = 
-    !               
-    seuil_inversion_omp = -0.1
-    CALL getin('seuil_inversion', seuil_inversion_omp)
-
-    !
-    ! Constante solaire & Parametres orbitaux & taux gaz effet de serre BEG
-    !
-    !Config Key  = R_ecc
-    !Config Desc = Excentricite
-    !Config Def  = 0.016715
-    !Config Help = 
-    !               
-    !valeur AMIP II
-    R_ecc_omp = 0.016715
-    CALL getin('R_ecc', R_ecc_omp)
-    !
-    !Config Key  = R_peri
-    !Config Desc = Equinoxe
-    !Config Def  = 
-    !Config Help = 
-    !               
-    !
-    !valeur AMIP II
-    R_peri_omp = 102.7
-    CALL getin('R_peri', R_peri_omp)
-    !
-    !Config Key  = R_incl
-    !Config Desc = Inclinaison
-    !Config Def  = 
-    !Config Help = 
-    !               
-    !
-    !valeur AMIP II
-    R_incl_omp = 23.441
-    CALL getin('R_incl', R_incl_omp)
-    !
-    !Config Key  = solaire
-    !Config Desc = Constante solaire en W/m2
-    !Config Def  = 1365.
-    !Config Help = 
-    !               
-    !
-    !valeur AMIP II
-    solaire_omp = 1365.
-    solaire_omp_init = solaire_omp     !--we keep track of the default value
-    CALL getin('solaire', solaire_omp)
-    !
-    !Config Key  = co2_ppm
-    !Config Desc = concentration du gaz carbonique en ppmv
-    !Config Def  = 348.
-    !Config Help = 
-    !               
-    !
-    !valeur AMIP II
-    co2_ppm_omp = 348.
-    CALL getin('co2_ppm', co2_ppm_omp)
-    !
-    !Config Key  = RCO2
-    !Config Desc = Concentration du CO2
-    !Config Def  = co2_ppm * 1.0e-06  * 44.011/28.97
-    !Config Def  = 348. * 1.0e-06  * 44.011/28.97
-    !Config Help = 
-    !               
-    ! RCO2 = 5.286789092164308E-04
-    !ancienne valeur
-    RCO2_omp = co2_ppm_omp * 1.0e-06 * RMCO2 / RMD ! pour co2_ppm=348.
-
-    !  CALL getin('RCO2', RCO2)
-    !
-    !Config Key  = RCH4
-    !Config Desc = Concentration du CH4
-    !Config Def  = 1.65E-06* 16.043/28.97
-    !Config Help = 
-    !               
-    !
-    !valeur AMIP II
-    !OK  RCH4 = 1.65E-06* 16.043/28.97
-    ! RCH4 = 9.137366240938903E-07
-    !
-    !ancienne valeur
-    ! RCH4 = 1.72E-06* 16.043/28.97
-    !OK CALL getin('RCH4', RCH4)
-    zzz = 1650.
-    CALL getin('CH4_ppb', zzz)
-    CH4_ppb_omp = zzz
-    RCH4_omp = CH4_ppb_omp * 1.0E-09 * RMCH4 / RMD
-    !
-    !Config Key  = RN2O
-    !Config Desc = Concentration du N2O
-    !Config Def  = 306.E-09* 44.013/28.97
-    !Config Help = 
-    !               
-    !
-    !valeur AMIP II
-    !OK  RN2O = 306.E-09* 44.013/28.97
-    ! RN2O = 4.648939592682085E-07
-    !
-    !ancienne valeur
-    ! RN2O = 310.E-09* 44.013/28.97
-    !OK  CALL getin('RN2O', RN2O)
-    zzz=306.
-    CALL getin('N2O_ppb', zzz)
-    N2O_ppb_omp = zzz
-    RN2O_omp = N2O_ppb_omp * 1.0E-09 * RMN2O / RMD
-    !
-    !Config Key  = RCFC11
-    !Config Desc = Concentration du CFC11
-    !Config Def  = 280.E-12* 137.3686/28.97
-    !Config Help = 
-    !               
-    !
-    !OK RCFC11 = 280.E-12* 137.3686/28.97
-    zzz = 280.
-    CALL getin('CFC11_ppt',zzz)
-    CFC11_ppt_omp = zzz
-    RCFC11_omp=CFC11_ppt_omp* 1.0E-12 * RMCFC11 / RMD
-    ! RCFC11 = 1.327690990680013E-09
-    !OK CALL getin('RCFC11', RCFC11)
-    !
-    !Config Key  = RCFC12
-    !Config Desc = Concentration du CFC12
-    !Config Def  = 484.E-12* 120.9140/28.97
-    !Config Help = 
-    !               
-    !
-    !OK RCFC12 = 484.E-12* 120.9140/28.97
-    zzz = 484.
-    CALL getin('CFC12_ppt',zzz)
-    CFC12_ppt_omp = zzz
-    RCFC12_omp = CFC12_ppt_omp * 1.0E-12 * RMCFC12 / RMD
-    ! RCFC12 = 2.020102726958923E-09
-    !OK CALL getin('RCFC12', RCFC12)
-
-    !ajout CFMIP begin
-    !
-    !Config Key  = co2_ppm_per
-    !Config Desc = concentration du co2_ppm_per
-    !Config Def  = 348.
-    !Config Help = 
-    !               
-    co2_ppm_per_omp = co2_ppm_omp
-    CALL getin('co2_ppm_per', co2_ppm_per_omp)
-    !
-    !Config Key  = RCO2_per
-    !Config Desc = Concentration du CO2_per
-    !Config Def  = co2_ppm_per * 1.0e-06  * 44.011/28.97
-    !Config Def  = 348. * 1.0e-06  * 44.011/28.97
-    !Config Help = 
-    !               
-    RCO2_per_omp = co2_ppm_per_omp * 1.0e-06 * RMCO2 / RMD
-
-    !Config Key  = ok_4xCO2atm
-    !Config Desc = Calcul ou non effet radiatif 4xco2
-    !Config Def  = .FALSE.
-    !Config Help = 
-
-    !Config Key  = RCH4_per
-    !Config Desc = Concentration du CH4_per
-    !Config Def  = 1.65E-06* 16.043/28.97
-    !Config Help = 
-    !               
-    zzz = CH4_ppb_omp
-    CALL getin('CH4_ppb_per', zzz)
-    CH4_ppb_per_omp = zzz
-    RCH4_per_omp = CH4_ppb_per_omp * 1.0E-09 * RMCH4 / RMD
-    !
-    !Config Key  = RN2O_per
-    !Config Desc = Concentration du N2O_per
-    !Config Def  = 306.E-09* 44.013/28.97
-    !Config Help = 
-    !               
-    zzz = N2O_ppb_omp
-    CALL getin('N2O_ppb_per', zzz)
-    N2O_ppb_per_omp = zzz
-    RN2O_per_omp = N2O_ppb_per_omp * 1.0E-09 * RMN2O / RMD
-    !
-    !Config Key  = RCFC11_per
-    !Config Desc = Concentration du CFC11_per
-    !Config Def  = 280.E-12* 137.3686/28.97
-    !Config Help = 
-    !               
-    zzz = CFC11_ppt_omp
-    CALL getin('CFC11_ppt_per',zzz)
-    CFC11_ppt_per_omp = zzz
-    RCFC11_per_omp=CFC11_ppt_per_omp* 1.0E-12 * RMCFC11 / RMD
-    !
-    !Config Key  = RCFC12_per
-    !Config Desc = Concentration du CFC12_per
-    !Config Def  = 484.E-12* 120.9140/28.97
-    !Config Help = 
-    !               
-    zzz = CFC12_ppt_omp
-    CALL getin('CFC12_ppt_per',zzz)
-    CFC12_ppt_per_omp = zzz
-    RCFC12_per_omp = CFC12_ppt_per_omp * 1.0E-12 * RMCFC12 / RMD
-    !ajout CFMIP end
-
-    !
-    ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
-    ! Constantes precedemment dans dyn3d/conf_gcm
-
-    !Config  Key  = iflag_cycle_diurne
-    !Config  Desc = Cycle diurne
-    !Config  Def  = 1
-    !Config  Help = Cette option permet d'eteidre le cycle diurne.
-    !Config         Peut etre util pour accelerer le code !
-    iflag_cycle_diurne_omp = 1
-    CALL getin('iflag_cycle_diurne',iflag_cycle_diurne_omp)
-
-    !Config  Key  = soil_model
-    !Config  Desc = Modele de sol
-    !Config  Def  = y
-    !Config  Help = Choix du modele de sol (Thermique ?)
-    !Config         Option qui pourait un string afin de pouvoir
-    !Config         plus de choix ! Ou meme une liste d'options !
-    soil_model_omp = .TRUE.
-    CALL getin('soil_model',soil_model_omp)
-
-    !Config  Key  = new_oliq
-    !Config  Desc = Nouvelle eau liquide
-    !Config  Def  = y
-    !Config  Help = Permet de mettre en route la
-    !Config         nouvelle parametrisation de l'eau liquide !
-    new_oliq_omp = .TRUE.
-    CALL getin('new_oliq',new_oliq_omp)
-
-    !Config  Key  = ok_orodr
-    !Config  Desc = Orodr ???
-    !Config  Def  = y
-    !Config  Help = Y en a pas comprendre !
-    !Config         
-    ok_orodr_omp = .TRUE.
-    CALL getin('ok_orodr',ok_orodr_omp)
-
-    !Config  Key  =  ok_orolf
-    !Config  Desc = Orolf ??
-    !Config  Def  = y
-    !Config  Help = Connais pas !
-    ok_orolf_omp = .TRUE.
-    CALL getin('ok_orolf', ok_orolf_omp)
-
-    !Config  Key  = ok_limitvrai
-    !Config  Desc = Force la lecture de la bonne annee
-    !Config  Def  = n
-    !Config  Help = On peut forcer le modele a lire le
-    !Config         fichier SST de la bonne annee. C'est une tres bonne
-    !Config         idee, pourquoi ne pas mettre toujours a y ???
-    ok_limitvrai_omp = .FALSE.
-    CALL getin('ok_limitvrai',ok_limitvrai_omp)
-
-    !Config  Key  = nbapp_rad
-    !Config  Desc = Frequence d'appel au rayonnement
-    !Config  Def  = 12
-    !Config  Help = Nombre  d'appels des routines de rayonnements
-    !Config         par jour.
-    nbapp_rad_omp = 12
-    CALL getin('nbapp_rad',nbapp_rad_omp)
-
-    !Config  Key  = iflag_con
-    !Config  Desc = Flag de convection
-    !Config  Def  = 2
-    !Config  Help = Flag  pour la convection les options suivantes existent :
-    !Config         1 pour LMD,
-    !Config         2 pour Tiedtke,
-    !Config         3 pour CCM(NCAR)  
-    iflag_con_omp = 2
-    CALL getin('iflag_con',iflag_con_omp)
-
-    !Config  Key  = nbapp_cv
-    !Config  Desc = Frequence d'appel a la convection
-    !Config  Def  = 0
-    !Config  Help = Nombre  d'appels des routines de convection
-    !Config         par jour. Si =0, appel a chaque pas de temps physique.
-    nbapp_cv_omp = 0
-    CALL getin('nbapp_cv',nbapp_cv_omp)
-
-    !Config  Key  = nbapp_wk
-    !Config  Desc = Frequence d'appel aux wakes
-    !Config  Def  = 0
-    !Config  Help = Nombre  d'appels des routines de wakes
-    !Config         par jour. Si =0, appel a chaque pas de temps physique.
-    nbapp_wk_omp = 0
-    CALL getin('nbapp_wk',nbapp_wk_omp)
-
-    !Config  Key  = iflag_ener_conserv
-    !Config  Desc = Flag de convection
-    !Config  Def  = 1
-    !Config  Help = Flag  pour la convection les options suivantes existent :
-    !Config         -1 pour Kinetic energy correction
-    !Config         1  conservation kinetic and enthalpy
-    iflag_ener_conserv_omp = -1
-    CALL getin('iflag_ener_conserv',iflag_ener_conserv_omp)
-
-    !Config  Key  = ok_conserv_q
-    !Config  Desc = Switch des corrections de conservation de l'eau
-    !Config  Def  = y
-    !Config  Help = Switch des corrections de conservation de l'eau
-    !Config         y -> corrections activees
-    !Config         n -> conformite avec versions anterieures au 1/4/2014
-    ok_conserv_q_omp = .FALSE.
-    CALL getin('ok_conserv_q',ok_conserv_q_omp)
-
-    !Config  Key  = iflag_fisrtilp_qsat
-    !Config  Desc = Flag de fisrtilp
-    !Config  Def  = 0
-    !Config  Help = Flag  pour la pluie grande-échelle les options suivantes existent :
-    !Config         >1 nb iterations pour converger dans le calcul de qsat
-    iflag_fisrtilp_qsat_omp = 0
-    CALL getin('iflag_fisrtilp_qsat',iflag_fisrtilp_qsat_omp)
-
-    !Config  Key  = iflag_bergeron
-    !Config  Desc = Flag de fisrtilp
-    !Config  Def  = 0
-    !Config  Help = Flag  pour la pluie grande-échelle les options suivantes existent :
-    !Config         0 pas d effet Bergeron
-    !Config         1 effet Bergeron pour T<0
-    iflag_bergeron_omp = 0
-    CALL getin('iflag_bergeron',iflag_bergeron_omp)
-
-    !
-    !
-    !
-    ! Constante solaire & Parametres orbitaux & taux gaz effet de serre END
-    !
-    ! KE
-    !
-
-    !Config key  = cvl_comp_threshold
-    !Config Desc = maximum fraction of convective points enabling compression
-    !Config Def  = 1.00
-    !Config Help = fields are compressed when less than a fraction cvl_comp_threshold
-    !Config Help = of the points is convective.
-    cvl_comp_threshold_omp = 1.00
-    CALL getin('cvl_comp_threshold', cvl_comp_threshold_omp)
-
-    !Config key  = cvl_sig2feed
-    !Config Desc = sigma coordinate at top of feeding layer
-    !Config Def  = 0.97
-    !Config Help = deep convection is fed by the layer extending from the surface (pressure ps)
-    !Config Help = and cvl_sig2feed*ps.
-    cvl_sig2feed_omp = 0.97
-    CALL getin('cvl_sig2feed', cvl_sig2feed_omp)
-
-    !Config key  = cvl_corr
-    !Config Desc = Facteur multiplication des precip convectives dans KE
-    !Config Def  = 1.00
-    !Config Help = 1.02 pour un moderne ou un pre-ind. A ajuster pour un glaciaire
-    cvl_corr_omp = 1.00
-    CALL getin('cvl_corr', cvl_corr_omp)
-
-
-    !Config Key  = epmax
-    !Config Desc = Efficacite precip
-    !Config Def  = 0.993
-    !Config Help = 
-    !
-    epmax_omp = .993
-    CALL getin('epmax', epmax_omp)
-
-    coef_epmax_cape_omp = 0.0   
-    CALL getin('coef_epmax_cape', coef_epmax_cape_omp)        
-    !
-    !Config Key  = ok_adj_ema
-    !Config Desc =  
-    !Config Def  = FALSE
-    !Config Help = 
-    !
-    ok_adj_ema_omp = .FALSE.
-    CALL getin('ok_adj_ema',ok_adj_ema_omp)
-    !
-    !Config Key  = iflag_clw
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_clw_omp = 0
-    CALL getin('iflag_clw',iflag_clw_omp)
-    !
-    !Config Key  = cld_lc_lsc 
-    !Config Desc =  
-    !Config Def  = 2.6e-4
-    !Config Help = 
-    !
-    cld_lc_lsc_omp = 2.6e-4
-    CALL getin('cld_lc_lsc',cld_lc_lsc_omp)
-    !
-    !Config Key  = cld_lc_con
-    !Config Desc =  
-    !Config Def  = 2.6e-4
-    !Config Help = 
-    !
-    cld_lc_con_omp = 2.6e-4
-    CALL getin('cld_lc_con',cld_lc_con_omp)
-    !
-    !Config Key  = cld_tau_lsc
-    !Config Desc =  
-    !Config Def  = 3600.
-    !Config Help = 
-    !
-    cld_tau_lsc_omp = 3600.
-    CALL getin('cld_tau_lsc',cld_tau_lsc_omp)
-    !
-    !Config Key  = cld_tau_con
-    !Config Desc =  
-    !Config Def  = 3600.
-    !Config Help = 
-    !
-    cld_tau_con_omp = 3600.
-    CALL getin('cld_tau_con',cld_tau_con_omp)
-    !
-    !Config Key  = ffallv_lsc
-    !Config Desc =  
-    !Config Def  = 1.
-    !Config Help = 
-    !
-    ffallv_lsc_omp = 1.
-    CALL getin('ffallv_lsc',ffallv_lsc_omp)
-    !
-    !Config Key  = ffallv_con
-    !Config Desc =  
-    !Config Def  = 1.
-    !Config Help = 
-    !
-    ffallv_con_omp = 1.
-    CALL getin('ffallv_con',ffallv_con_omp)
-    !
-    !Config Key  = coef_eva
-    !Config Desc =  
-    !Config Def  = 2.e-5
-    !Config Help = 
-    !
-    coef_eva_omp = 2.e-5
-    CALL getin('coef_eva',coef_eva_omp)
-    !
-    !Config Key  = reevap_ice
-    !Config Desc =  
-    !Config Def  = .FALSE.
-    !Config Help = 
-    !
-    reevap_ice_omp = .FALSE.
-    CALL getin('reevap_ice',reevap_ice_omp)
-
-    !Config Key  = iflag_ratqs
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    iflag_ratqs_omp = 1
-    CALL getin('iflag_ratqs',iflag_ratqs_omp)
-
-    !
-    !Config Key  = iflag_radia 
-    !Config Desc =  
-    !Config Def  = 1
-    !Config Help = 
-    !
-    iflag_radia_omp = 1
-    CALL getin('iflag_radia',iflag_radia_omp)
-
-    !
-    !Config Key  = iflag_rrtm 
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_rrtm_omp = 0
-    CALL getin('iflag_rrtm',iflag_rrtm_omp)
-
-    !
-    !Config Key  = NSW 
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    NSW_omp = 2
-    CALL getin('NSW',NSW_omp)
-    !albedo SB >>>
-    iflag_albedo_omp = 0
-    CALL getin('iflag_albedo',iflag_albedo_omp)
-
-    ok_chlorophyll_omp=.FALSE.
-    CALL getin('ok_chlorophyll',ok_chlorophyll_omp)
-    !albedo SB <<<
-    !
-    !Config Key  = ok_sun_time
-    !Config Desc = oui ou non variabilite solaire
-    !Config Def  = .FALSE.
-    !Config Help =
-    !
-    !
-    !valeur AMIP II
-    ok_suntime_rrtm_omp = .FALSE.
-    IF (iflag_rrtm_omp==1) THEN
-      CALL getin('ok_suntime_rrtm',ok_suntime_rrtm_omp)
-    ENDIF
-    
-    !Config Key  = flag_aerosol_strat
-    !Config Desc = use stratospheric aerosols 0, 1, 2
-    ! - 0 = no stratospheric aerosols 
-    ! - 1 = stratospheric aerosols scaled from 550 nm AOD 
-    ! - 2 = stratospheric aerosol properties from CMIP6
-    !Option 2 is only available with RRTM, this is tested later on 
-    !Config Def  = 0
-    !Config Help = Used in physiq.F
-    !
-    flag_aerosol_strat_omp = 0
-    CALL getin('flag_aerosol_strat',flag_aerosol_strat_omp)
-
-    !Config Key  = flag_aer_feedback
-    !Config Desc = (des)activate aerosol radiative feedback
-    ! - F = no aerosol radiative feedback
-    ! - T = aerosol radiative feedback
-    !Config Def  = T
-    !Config Help = Used in physiq.F
-    !
-    flag_aer_feedback_omp = .TRUE. 
-    IF (iflag_rrtm_omp==1) THEN
-       CALL getin('flag_aer_feedback',flag_aer_feedback_omp)
-    ENDIF
-
-    !Config Key  = iflag_cld_th 
-    !Config Desc =  
-    !Config Def  = 1
-    !Config Help = 
-    !
-    iflag_cld_th_omp = 1
-    ! On lit deux fois avec l'ancien et le nouveau nom 
-    ! pour assurer une retrocompatiblite.
-    ! A abandonner un jour
-    CALL getin('iflag_cldcon',iflag_cld_th_omp)
-    CALL getin('iflag_cld_th',iflag_cld_th_omp)
-    iflag_cld_cv_omp = 0 
-    CALL getin('iflag_cld_cv',iflag_cld_cv_omp)
-
-    !
-    !Config Key  = tau_cld_cv
-    !Config Desc =
-    !Config Def  = 10.
-    !Config Help =
-    !
-    tau_cld_cv_omp = 10.
-    CALL getin('tau_cld_cv',tau_cld_cv_omp)
-
-    !
-    !Config Key  = coefw_cld_cv
-    !Config Desc =
-    !Config Def  = 0.1
-    !Config Help =
-    !
-    coefw_cld_cv_omp = 0.1
-    CALL getin('coefw_cld_cv',coefw_cld_cv_omp)
-
-
-
-
-    !
-    !Config Key  = iflag_pdf 
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_pdf_omp = 0
-    CALL getin('iflag_pdf',iflag_pdf_omp)
-    !
-    !Config Key  = fact_cldcon
-    !Config Desc =  
-    !Config Def  = 0.375
-    !Config Help = 
-    !
-    fact_cldcon_omp = 0.375
-    CALL getin('fact_cldcon',fact_cldcon_omp)
-
-    !
-    !Config Key  = facttemps
-    !Config Desc =  
-    !Config Def  = 1.e-4
-    !Config Help = 
-    !
-    facttemps_omp = 1.e-4
-    CALL getin('facttemps',facttemps_omp)
-
-    !
-    !Config Key  = ok_newmicro
-    !Config Desc =  
-    !Config Def  = .TRUE.
-    !Config Help = 
-    !
-    ok_newmicro_omp = .TRUE.
-    CALL getin('ok_newmicro',ok_newmicro_omp)
-    !
-    !Config Key  = ratqsbas
-    !Config Desc =  
-    !Config Def  = 0.01
-    !Config Help = 
-    !
-    ratqsbas_omp = 0.01
-    CALL getin('ratqsbas',ratqsbas_omp)
-    !
-    !Config Key  = ratqshaut
-    !Config Desc =  
-    !Config Def  = 0.3
-    !Config Help = 
-    !
-    ratqshaut_omp = 0.3
-    CALL getin('ratqshaut',ratqshaut_omp)
-
-    !Config Key  = tau_ratqs
-    !Config Desc =  
-    !Config Def  = 1800.
-    !Config Help = 
-    !
-    tau_ratqs_omp = 1800.
-    CALL getin('tau_ratqs',tau_ratqs_omp)
-
-    !
-    !-----------------------------------------------------------------------
-    ! Longitude solaire pour le calcul de l'ensoleillement en degre
-    ! si on veut imposer la saison. Sinon, solarlong0=-999.999
-    !Config Key  = solarlong0
-    !Config Desc =  
-    !Config Def  = -999.999 
-    !Config Help = 
-    !
-    solarlong0_omp = -999.999
-    CALL getin('solarlong0',solarlong0_omp)
-    !
-    !-----------------------------------------------------------------------
-    !  Valeur imposee pour configuration idealisees
-    !Config Key  = qsol0 pour le bucket, evap0 pour aquaplanetes, albsno0
-    ! Default value -1 to activate the full computation
-    qsol0_omp = -1.
-    CALL getin('qsol0',qsol0_omp)
-    evap0_omp = -1.
-    CALL getin('evap0',evap0_omp)
-    albsno0_omp = -1.
-    CALL getin('albsno0',albsno0_omp)
-    !
-    !-----------------------------------------------------------------------
-    !
-    !Config Key  = iflag_sic
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_sic_omp = 0
-    CALL getin('iflag_sic',iflag_sic_omp)
-    !
-    !Config Key  = inertie_sic
-    !Config Desc =  
-    !Config Def  = 2000.
-    !Config Help = 
-    !
-    inertie_sic_omp = 2000.
-    CALL getin('inertie_sic',inertie_sic_omp)
-    !
-    !Config Key  = inertie_lic
-    !Config Desc =  
-    !Config Def  = 2000.
-    !Config Help = 
-    !
-    inertie_lic_omp = 2000.
-    CALL getin('inertie_lic',inertie_lic_omp)
-    !
-    !Config Key  = inertie_sno
-    !Config Desc =  
-    !Config Def  = 2000.
-    !Config Help = 
-    !
-    inertie_sno_omp = 2000.
-    CALL getin('inertie_sno',inertie_sno_omp)
-    !
-    !Config Key  = inertie_sol
-    !Config Desc =  
-    !Config Def  = 2000.
-    !Config Help = 
-    !
-    inertie_sol_omp = 2000.
-    CALL getin('inertie_sol',inertie_sol_omp)
-
-    !
-    !Config Key  = rad_froid
-    !Config Desc =  
-    !Config Def  = 35.0
-    !Config Help = 
-    !
-    rad_froid_omp = 35.0
-    CALL getin('rad_froid',rad_froid_omp)
-
-    !
-    !Config Key  = rad_chau1
-    !Config Desc =  
-    !Config Def  = 13.0
-    !Config Help = 
-    !
-    rad_chau1_omp = 13.0
-    CALL getin('rad_chau1',rad_chau1_omp)
-
-    !
-    !Config Key  = rad_chau2
-    !Config Desc =  
-    !Config Def  = 9.0
-    !Config Help = 
-    !
-    rad_chau2_omp = 9.0
-    CALL getin('rad_chau2',rad_chau2_omp)
-
-    !
-    !Config Key  = t_glace_min
-    !Config Desc =  
-    !Config Def  = 258.
-    !Config Help = 
-    !
-    t_glace_min_omp = 258.
-    CALL getin('t_glace_min',t_glace_min_omp)
-
-    !
-    !Config Key  = t_glace_max
-    !Config Desc =  
-    !Config Def  = 273.13
-    !Config Help = 
-    !
-    t_glace_max_omp = 273.13
-    CALL getin('t_glace_max',t_glace_max_omp)
-
-    !
-    !Config Key  = exposant_glace
-    !Config Desc =  
-    !Config Def  = 2.
-    !Config Help = 
-    !
-    exposant_glace_omp = 1.
-    CALL getin('exposant_glace',exposant_glace_omp)
-
-    !
-    !Config Key  = iflag_t_glace
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_t_glace_omp = 0
-    CALL getin('iflag_t_glace',iflag_t_glace_omp)
-
-    !
-    !Config Key  = iflag_cloudth_vert
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_cloudth_vert_omp = 0
-    CALL getin('iflag_cloudth_vert',iflag_cloudth_vert_omp)
-
-    !
-    !Config Key  = iflag_rain_incloud_vol
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_rain_incloud_vol_omp = 0
-    CALL getin('iflag_rain_incloud_vol',iflag_rain_incloud_vol_omp)
-
-    !
-    !Config Key  = iflag_ice_thermo
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_ice_thermo_omp = 0
-    CALL getin('iflag_ice_thermo',iflag_ice_thermo_omp)
-
-    !Config Key  = rei_min
-    !Config Desc =  
-    !Config Def  = 3.5
-    !Config Help = 
-    !
-    rei_min_omp = 3.5
-    CALL getin('rei_min',rei_min_omp)
-
-    !
-    !Config Key  = rei_max
-    !Config Desc =  
-    !Config Def  = 61.29
-    !Config Help = 
-    !
-    rei_max_omp = 61.29
-    CALL getin('rei_max',rei_max_omp)
-
-    !
-    !Config Key  = top_height
-    !Config Desc =
-    !Config Def  = 3
-    !Config Help =
-    !
-    top_height_omp = 3
-    CALL getin('top_height',top_height_omp)
-
-    !
-    !Config Key  = overlap
-    !Config Desc =
-    !Config Def  = 3
-    !Config Help =
-    !
-    overlap_omp = 3
-    CALL getin('overlap',overlap_omp)
-
-    !
-    !Config Key  = cdmmax
-    !Config Desc =
-    !Config Def  = 1.3E-3
-    !Config Help =
-    !
-    cdmmax_omp = 1.3E-3
-    CALL getin('cdmmax',cdmmax_omp)
-
-    !
-    !Config Key  = cdhmax
-    !Config Desc =
-    !Config Def  = 1.1E-3
-    !Config Help =
-    !
-    cdhmax_omp = 1.1E-3
-    CALL getin('cdhmax',cdhmax_omp)
-
-    !261103
-    !
-    !Config Key  = ksta
-    !Config Desc =
-    !Config Def  = 1.0e-10
-    !Config Help =
-    !
-    ksta_omp = 1.0e-10
-    CALL getin('ksta',ksta_omp)
-
-    !
-    !Config Key  = ksta_ter
-    !Config Desc =
-    !Config Def  = 1.0e-10
-    !Config Help =
-    !
-    ksta_ter_omp = 1.0e-10
-    CALL getin('ksta_ter',ksta_ter_omp)
-
-    !Config Key  = f_ri_cd_min
-    !Config Desc =
-    !Config Def  = 0.1
-    !Config Help =
-    !
-    f_ri_cd_min_omp = 0.1
-    CALL getin('f_ri_cd_min',f_ri_cd_min_omp)
-
-    !
-    !Config Key  = ok_kzmin
-    !Config Desc =
-    !Config Def  = .TRUE.
-    !Config Help =
-    !
-    ok_kzmin_omp = .TRUE.
-    CALL getin('ok_kzmin',ok_kzmin_omp)
-
-    pbl_lmixmin_alpha_omp=0.0
-    CALL getin('pbl_lmixmin_alpha',pbl_lmixmin_alpha_omp)
-
-    !
-    !Config Key  = fmagic
-    !Config Desc = additionnal multiplicator factor used for albedo
-    !Config Def  = 1.
-    !Config Help = additionnal multiplicator factor used in albedo.F
-    !
-    fmagic_omp = 1.
-    CALL getin('fmagic',fmagic_omp)
-
-    !
-    !Config Key  = pmagic
-    !Config Desc = additional factor used for albedo
-    !Config Def  = 0.
-    !Config Help = additional factor used in albedo.F
-    !
-    pmagic_omp = 0.
-    CALL getin('pmagic',pmagic_omp)
-
-
-    !Config Key = ok_lic_melt
-    !Config Desc = Prise en compte de la fonte de la calotte dans le bilan d'eau
-    !Config Def  = .FALSE.
-    !Config Help = mettre a .FALSE. pour assurer la conservation en eau
-    ok_lic_melt_omp = .FALSE.
-    CALL getin('ok_lic_melt', ok_lic_melt_omp)
-
-
-    !Config Key = ok_lic_cond
-    !Config Desc = Prise en compte depot de vapeur d'eau sur la calotte dans le bilan d'eau
-    !Config Def  = .FALSE.
-    !Config Help = mettre a .TRUE. pour assurer la conservation en eau
-    ok_lic_cond_omp = .FALSE.
-    CALL getin('ok_lic_cond', ok_lic_cond_omp)
-
-    !
-    ! PARAMETER FOR THE PLANETARY BOUNDARY LAYER
-    !
-
-    !Config Key  = iflag_pbl
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    iflag_pbl_omp = 1
-    CALL getin('iflag_pbl',iflag_pbl_omp)
-
-!FC
-    !Config Key  = ifl_pbltree
-    !Config Desc = drag from trees 0 no activated
-    !Config Def  = 0
-    !Config Help =
-    !
-    ifl_pbltree_omp = 0
-    CALL getin('ifl_pbltree',ifl_pbltree_omp)
-!FC
-    !Config Key  = Cd_frein
-    !Config Desc = drag from trees 
-    !Config Def  = 7.5E-02 (valeur Masson mais fait planter avec des LAI eleves)
-    !Config Help =
-    !
-    Cd_frein_omp = 7.5E-02
-    CALL getin('Cd_frein',Cd_frein_omp)
-
-    !
-    !Config Key  = iflag_pbl_split
-    !Config Desc = decimal flag: least signif digit = split vdf; next digit = split thermals
-    !Config Def  = 0
-    !Config Help = 0-> no splitting; 1-> vdf splitting; 10-> thermals splitting; 11-> full splitting
-    !
-    iflag_pbl_split_omp = 0
-    call getin('iflag_pbl_split',iflag_pbl_split_omp)
-    !
-    !Config Key  = iflag_order2_sollw
-    !Config Desc =
-    !Config Def  = 0
-    !Config Help =
-    !
-    iflag_order2_sollw_omp = 0
-    CALL getin('iflag_order2_sollw',iflag_order2_sollw_omp)
-    !
-    !Config Key  = iflag_thermals
-    !Config Desc =
-    !Config Def  = 0
-    !Config Help =
-    !
-    iflag_thermals_omp = 0
-    CALL getin('iflag_thermals',iflag_thermals_omp)
-    !
-    !Config Key  = iflag_thermals_ed
-    !Config Desc =
-    !Config Def  = 0
-    !Config Help =
-    !
-    fact_thermals_ed_dz_omp = 0.1
-
-    CALL getin('fact_thermals_ed_dz',fact_thermals_ed_dz_omp)
-    !
-    !
-    !Config Key  = iflag_thermals_ed
-    !Config Desc =
-    !Config Def  = 0
-    !Config Help =
-    !
-    iflag_thermals_ed_omp = 0
-    CALL getin('iflag_thermals_ed',iflag_thermals_ed_omp)
-    !
-    !
-    !Config Key  = iflag_thermals_optflux
-    !Config Desc =
-    !Config Def  = 0
-    !Config Help =
-    !
-    iflag_thermals_optflux_omp = 0
-    CALL getin('iflag_thermals_optflux',iflag_thermals_optflux_omp)
-    !
-    !Config Key  = iflag_thermals_closure
-    !Config Desc =
-    !Config Def  = 0
-    !Config Help =
-    !
-    iflag_thermals_closure_omp = 1
-    CALL getin('iflag_thermals_closure',iflag_thermals_closure_omp)
-    !
-    !Config Key  = nsplit_thermals
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    nsplit_thermals_omp = 1
-    CALL getin('nsplit_thermals',nsplit_thermals_omp)
-
-    !Config Key  = alp_bl_k
-    !Config Desc =
-    !Config Def  = 0.
-    !Config Help =
-    !
-    alp_bl_k_omp = 1.
-    CALL getin('alp_bl_k',alp_bl_k_omp)
-
-    ! nrlmd le 10/04/2012
-
-    !Config Key  = iflag_trig_bl
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_trig_bl_omp = 0
-    CALL getin('iflag_trig_bl',iflag_trig_bl_omp)
-
-    !Config Key  = s_trig_bl
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    s_trig_omp = 2e7
-    CALL getin('s_trig',s_trig_omp)
-
-    !Config Key  = tau_trig_shallow
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    tau_trig_shallow_omp = 600
-    CALL getin('tau_trig_shallow',tau_trig_shallow_omp)
-
-    !Config Key  = tau_trig_deep
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    tau_trig_deep_omp = 1800
-    CALL getin('tau_trig_deep',tau_trig_deep_omp)
-
-    !Config Key  = iflag_clos_bl
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_clos_bl_omp = 0
-    CALL getin('iflag_clos_bl',iflag_clos_bl_omp)
-
-    ! fin nrlmd le 10/04/2012
-
-    !
-    !Config Key  = tau_thermals
-    !Config Desc =
-    !Config Def  = 0.
-    !Config Help =
-    !
-    tau_thermals_omp = 0.
-    CALL getin('tau_thermals',tau_thermals_omp)
-
-    !
-    !Config Key  = iflag_coupl
-    !Config Desc =
-    !Config Def  = 0
-    !Config Help =
-    !
-    iflag_coupl_omp = 0
-    CALL getin('iflag_coupl',iflag_coupl_omp)
-
-    !
-    !Config Key  = iflag_clos
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_clos_omp = 1
-    CALL getin('iflag_clos',iflag_clos_omp)
-    !
-    !Config Key  = coef_clos_ls
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    coef_clos_ls_omp = 0.
-    CALL getin('coef_clos_ls',coef_clos_ls_omp)
-
-    !
-    !Config Key  = iflag_cvl_sigd
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_cvl_sigd_omp = 0
-    CALL getin('iflag_cvl_sigd',iflag_cvl_sigd_omp)
-
-    !Config Key  = iflag_wake
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_wake_omp = 0
-    CALL getin('iflag_wake',iflag_wake_omp)
-
-    !Config Key  = alp_offset
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    alp_offset_omp = 0.
-    CALL getin('alp_offset',alp_offset_omp)
-
-    !
-    !Config Key  = lev_histhf
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    lev_histhf_omp = 1
-    CALL getin('lev_histhf',lev_histhf_omp)
-
-    !
-    !Config Key  = lev_histday
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    lev_histday_omp = 1
-    CALL getin('lev_histday',lev_histday_omp)
-
-    !
-    !Config Key  = lev_histmth
-    !Config Desc =
-    !Config Def  = 2
-    !Config Help =
-    !
-    lev_histmth_omp = 2
-    CALL getin('lev_histmth',lev_histmth_omp)
-    !
-    !Config Key  = lev_histins
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    lev_histins_omp = 1
-    CALL getin('lev_histins',lev_histins_omp)
-    !
-    !Config Key  = lev_histLES
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    lev_histLES_omp = 1
-    CALL getin('lev_histLES',lev_histLES_omp)
-    ! 
-    !Config Key  = lev_histdayNMC
-    !Config Desc =
-    !Config Def  = 8
-    !Config Help =
-    !
-    lev_histdayNMC_omp = 8
-    CALL getin('lev_histdayNMC',lev_histdayNMC_omp)
-    !
-    !Config Key  = levout_histNMC
-    !Config Desc =
-    !Config Def  = 5
-    !Config Help =
-    !
-    levout_histNMC_omp(1) = 5
-    levout_histNMC_omp(2) = 5
-    levout_histNMC_omp(3) = 5
-    CALL getin('levout_histNMC',levout_histNMC_omp)
-    !
-    !histNMC BEG
-    !Config Key  = ok_histNMC
-    !Config Desc = ok_histNMC(1) = frequence de sortie fichiers histmthNMC
-    !Config Desc = ok_histNMC(2) = frequence de sortie fichiers histdayNMC
-    !Config Desc = ok_histNMC(3) = frequence de sortie fichiers histhfNMC
-    !Config Def  = n, n, n
-    !Config Help =
-    !
-    ok_histNMC_omp(1) = .FALSE.
-    ok_histNMC_omp(2) = .FALSE.
-    ok_histNMC_omp(3) = .FALSE.
-    CALL getin('ok_histNMC',ok_histNMC_omp)
-    !
-    !Config Key  = freq_outNMC
-    !Config Desc = freq_outNMC(1) = frequence de sortie fichiers histmthNMC
-    !Config Desc = freq_outNMC(2) = frequence de sortie fichiers histdayNMC
-    !Config Desc = freq_outNMC(3) = frequence de sortie fichiers histhfNMC
-    !Config Def  = 2592000., 86400., 21600. (1mois, 1jour, 6h) 
-    !Config Help =
-    !
-    freq_outNMC_omp(1) = mth_len
-    freq_outNMC_omp(2) = 1.
-    freq_outNMC_omp(3) = 1./4.
-    CALL getin('freq_outNMC',freq_outNMC_omp)
-    !
-    !Config Key  = freq_calNMC
-    !Config Desc = freq_calNMC(1) = frequence de calcul fichiers histmthNMC
-    !Config Desc = freq_calNMC(2) = frequence de calcul fichiers histdayNMC
-    !Config Desc = freq_calNMC(3) = frequence de calcul fichiers histhfNMC
-    !Config Def  = phys_tstep
-    !Config Help =
-    !
-    freq_calNMC_omp(1) = phys_tstep
-    freq_calNMC_omp(2) = phys_tstep
-    freq_calNMC_omp(3) = phys_tstep
-    CALL getin('freq_calNMC',freq_calNMC_omp)
-    !
-    !Config Key  = type_run
-    !Config Desc =
-    !Config Def  = 'AMIP'/'CFMIP'  ou 'CLIM'/'ENSP'
-    !Config Help =
-    !
-    type_run_omp = 'AMIP'
-    CALL getin('type_run',type_run_omp)
-
-    !
-    !Config Key  = ok_cosp
-    !Config Desc =
-    !Config Def  = .FALSE.
-    !Config Help =
-    !
-    ok_cosp_omp = .FALSE.
-    CALL getin('ok_cosp',ok_cosp_omp)
-
-    !
-    !Config Key  = ok_airs
-    !Config Desc =
-    !Config Def  = .FALSE.
-    !Config Help =
-    !
-    ok_airs_omp = .FALSE.
-    CALL getin('ok_airs',ok_airs_omp)
-
-    !
-    !Config Key  = ok_mensuelCOSP
-    !Config Desc =
-    !Config Def  = .TRUE.
-    !Config Help =
-    !
-    ok_mensuelCOSP_omp = .TRUE.
-    CALL getin('ok_mensuelCOSP',ok_mensuelCOSP_omp)
-
-    !
-    !Config Key  = ok_journeCOSP
-    !Config Desc =
-    !Config Def  = .TRUE.
-    !Config Help = 
-    !
-    ok_journeCOSP_omp = .TRUE.
-    CALL getin('ok_journeCOSP',ok_journeCOSP_omp)
-
-    !
-    !Config Key  = ok_hfCOSP
-    !Config Desc =
-    !Config Def  = .FALSE.
-    !Config Help =
-    !
-    ok_hfCOSP_omp = .FALSE.
-    CALL getin('ok_hfCOSP',ok_hfCOSP_omp)
-
-    !
-    ! coordonnees (lonmin_ins, lonmax_ins, latmin_ins, latmax_ins) pour la zone 
-    ! avec sorties instantannees tous les pas de temps de la physique => "histbilKP_ins.nc"
-    !
-    !Config Key  = lonmin_ins
-    !Config Desc = 100.  
-    !Config Def  = longitude minimale sorties "bilKP_ins"
-    !Config Help = 
-    !
-    lonmin_ins_omp = 100.
-    CALL getin('lonmin_ins',lonmin_ins_omp)
-    !
-    !Config Key  = lonmax_ins
-    !Config Desc = 130. 
-    !Config Def  = longitude maximale sorties "bilKP_ins"
-    !Config Help =
-    !
-    lonmax_ins_omp = 130.
-    CALL getin('lonmax_ins',lonmax_ins_omp)
-    !
-    !Config Key  = latmin_ins
-    !Config Desc = -20.  
-    !Config Def  = latitude minimale sorties "bilKP_ins"
-    !Config Help = 
-    !
-    latmin_ins_omp = -20.
-    CALL getin('latmin_ins',latmin_ins_omp)
-    !
-    !Config Key  = latmax_ins
-    !Config Desc = 20. 
-    !Config Def  = latitude maximale sorties "bilKP_ins"
-    !Config Help =
-    !
-    latmax_ins_omp = 20.
-    CALL getin('latmax_ins',latmax_ins_omp)
-    !
-    !Config Key  = ecrit_hf
-    !Config Desc =
-    !Config Def  = 1./8. !toutes les 3h
-    !Config Help =
-    !
-    ecrit_hf_omp = 1./8.
-    CALL getin('ecrit_hf',ecrit_hf_omp)
-    !
-    !Config Key  = ecrit_ins
-    !Config Desc =
-    !Config Def  = 1./48. ! toutes les 1/2 h
-    !Config Help =
-    !
-    ecrit_ins_omp = 1./48.
-    CALL getin('ecrit_ins',ecrit_ins_omp)
-    !
-    !Config Key  = ecrit_day
-    !Config Desc =
-    !Config Def  = 1.0 !tous les jours
-    !Config Help = nombre de jours pour ecriture fichier histday.nc
-    !
-    ecrit_day_omp = 1.0
-    CALL getin('ecrit_day',ecrit_day_omp)
-    !
-    !Config Key  = ecrit_mth
-    !Config Desc =
-    !Config Def  = 30. !tous les 30jours (1 fois par mois)
-    !Config Help =
-    !
-    ecrit_mth_omp = 30.
-    CALL getin('ecrit_mth',ecrit_mth_omp)
-    !
-    !Config Key  = ecrit_tra
-    !Config Desc =
-    !Config Def  = 30. !tous les 30jours (1 fois par mois)
-    !Config Help =
-    !
-    ecrit_tra_omp = 0.
-    CALL getin('ecrit_tra',ecrit_tra_omp)
-    !
-    !Config Key  = ecrit_reg
-    !Config Desc =
-    !Config Def  = 0.25  !4 fois par jour
-    !Config Help =
-    !
-    ecrit_reg_omp = 0.25   !4 fois par jour
-    CALL getin('ecrit_reg',ecrit_reg_omp)
-    !
-    !
-    print*,'CONFPHYS OOK avant drag_ter'
-    !
-    ! PARAMETRES CDRAG
-    !
-    f_cdrag_ter_omp = 0.8
-    CALL getin('f_cdrag_ter',f_cdrag_ter_omp)
-    !
-    f_cdrag_oce_omp = 0.8
-    CALL getin('f_cdrag_oce',f_cdrag_oce_omp)
-    !
-
-    ! Gustiness flags
-    f_z0qh_oce_omp = 1.
-    CALL getin('f_z0qh_oce',f_z0qh_oce_omp)
-    !
-    f_qsat_oce_omp = 1.
-    CALL getin('f_qsat_oce',f_qsat_oce_omp)
-    !
-    f_gust_bl_omp = 0.
-    CALL getin('f_gust_bl',f_gust_bl_omp)
-    !
-    f_gust_wk_omp = 0.
-    CALL getin('f_gust_wk',f_gust_wk_omp)
-    !
-    !Config Key  = iflag_z0_oce
-    !Config Desc = 0 (z0h=z0m), 1 (diff. equ. for z0h and z0m), -1 (z0m=z0h=z0min)
-    !Config Def  = 0   ! z0h = z0m
-    !Config Help =
-    !
-    iflag_z0_oce_omp=0
-    CALL getin('iflag_z0_oce',iflag_z0_oce_omp)
-    !
-    iflag_gusts_omp=0
-    CALL getin('iflag_gusts',iflag_gusts_omp)
-    !
-    min_wind_speed_omp = 1.
-    CALL getin('min_wind_speed',min_wind_speed_omp)
-
-    z0m_seaice_omp = 0.002 ; CALL getin('z0m_seaice',z0m_seaice_omp)
-    z0h_seaice_omp = 0.002 ; CALL getin('z0h_seaice',z0h_seaice_omp)
-
-    f_rugoro_omp = 0.
-    CALL getin('f_rugoro',f_rugoro_omp)
-
-    z0min_omp = 0.000015
-    CALL getin('z0min',z0min_omp)
-
-
-    ! PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
-    !
-    !Config Key  = supcrit1
-    !Config Desc =
-    !Config Def  = .540
-    !Config Help =
-    !
-    supcrit1_omp = .540
-    CALL getin('supcrit1',supcrit1_omp)
-
-    !
-    !Config Key  = supcrit2
-    !Config Desc =
-    !Config Def  = .600
-    !Config Help =
-    !
-    supcrit2_omp = .600
-    CALL getin('supcrit2',supcrit2_omp)
-
-    !
-    ! PARAMETERS FOR THE MIXING DISTRIBUTION
-    ! iflag_mix: 0=OLD, 
-    !            1=NEW (JYG),            
-    !            2=NEW + conv. depth inhib. by tropos. dryness
-    ! '2' is NOT operationnal and should not be used.
-    !
-    !Config Key  = iflag_mix
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    iflag_mix_omp = 1
-    CALL getin('iflag_mix',iflag_mix_omp)
-
-!
-    ! PARAMETERS FOR THE EROSION OF THE ADIABATIC ASCENTS
-    ! iflag_mix_adiab: 0=OLD, 
-    !                  1=NEW (CR),            
-    !            
-    !
-    !Config Key  = iflag_mix_adiab
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    iflag_mix_adiab_omp = 0
-    CALL getin('iflag_mix_adiab',iflag_mix_adiab_omp)
-
-    !
-    !Config Key  = scut
-    !Config Desc =
-    !Config Def  = 0.95
-    !Config Help =
-    !
-    scut_omp = 0.95
-    CALL getin('scut',scut_omp)
-
-    !
-    !Config Key  = qqa1
-    !Config Desc =
-    !Config Def  = 1.0
-    !Config Help =
-    !
-    qqa1_omp = 1.0
-    CALL getin('qqa1',qqa1_omp)
-
-    !
-    !Config Key  = qqa2
-    !Config Desc =
-    !Config Def  = 0.0
-    !Config Help =
-    !
-    qqa2_omp = 0.0
-    CALL getin('qqa2',qqa2_omp)
-
-    !
-    !Config Key  = gammas
-    !Config Desc =
-    !Config Def  = 0.05
-    !Config Help =
-    !
-    gammas_omp = 0.05
-    CALL getin('gammas',gammas_omp)
-
-    !
-    !Config Key  = Fmax
-    !Config Desc =
-    !Config Def  = 0.65
-    !Config Help =
-    !
-    Fmax_omp = 0.65
-    CALL getin('Fmax',Fmax_omp)
-
-    !
-    !Config Key  = tmax_fonte_cv
-    !Config Desc =
-    !Config Def  = 275.15
-    !Config Help =
-    !
-    tmax_fonte_cv_omp = 275.15
-    CALL getin('tmax_fonte_cv',tmax_fonte_cv_omp)
-
-    !
-    !Config Key  = alphas  
-    !Config Desc =
-    !Config Def  = -5.
-    !Config Help =
-    !
-    alphas_omp = -5.
-    CALL getin('alphas',alphas_omp)
-
-    !Config key = ok_strato
-    !Config  Desc = activation de la version strato
-    !Config  Def  = .FALSE.
-    !Config  Help = active la version stratosph\'erique de LMDZ de F. Lott
-    !               Et la sponge layer (Runs Stratospheriques)
-
-    ok_strato_omp=.FALSE.
-    CALL getin('ok_strato',ok_strato_omp)
-
-    !Config  key = ok_hines
-    !Config  Desc = activation de la parametrisation de hines
-    !Config  Def  = .FALSE.
-    !Config  Help = Clefs controlant la parametrization de Hines
-
-    ok_hines_omp=.FALSE.
-    CALL getin('ok_hines',ok_hines_omp)
-
-    !  Parametres pour les ondes de gravite
-    !  
-    !  Subgrid Scale Orography (Lott Miller (1997), Lott (1999))
-
-    sso_gkdrag_omp = merge(0.1875, 0.2, ok_strato_omp)
-    CALL getin('sso_gkdrag', sso_gkdrag_omp)
-
-    sso_grahil_omp=merge(0.1,1.,ok_strato_omp)
-    CALL getin('sso_grahil', sso_grahil_omp)
-
-    sso_grcrit_omp =merge(1.,0.01,ok_strato_omp)
-    CALL getin('sso_grcrit', sso_grcrit_omp)
-
-    sso_gfrcri_omp = 1.
-    CALL getin('sso_gfrcri', sso_gfrcri_omp)
-
-    sso_gkwake_omp = 0.50
-    CALL getin('sso_gkwake', sso_gkwake_omp)
-
-    sso_gklift_omp = merge(0.25,0.50,ok_strato_omp)
-    CALL getin('sso_gklift', sso_gklift_omp)
-
-    ! Random gravity waves:
-
-    ok_gwd_rando_omp = .FALSE.
-    IF ( klon_glo == 1 ) THEN
-       print*,'La parametrisation des ondes de gravites non orographiques'
-       print*,'ne fonctionne pas en 1D'
-    ELSE
-       CALL getin('ok_gwd_rando', ok_gwd_rando_omp)
-    ENDIF
-
-    gwd_rando_ruwmax_omp = 2.00
-    CALL getin('gwd_rando_ruwmax', gwd_rando_ruwmax_omp)
-
-    gwd_rando_sat_omp = 0.25
-    CALL getin('gwd_rando_sat', gwd_rando_sat_omp)
-
-    gwd_front_ruwmax_omp = 2.50
-    CALL getin('gwd_front_ruwmax', gwd_front_ruwmax_omp)
-
-    gwd_front_sat_omp = 0.60
-    CALL getin('gwd_front_sat', gwd_front_sat_omp)
-
-
-    !Config  key = ok_qch4
-    !Config  Desc = activation de la parametrisation du methane
-    !Config  Def  = .FALSE.
-    !Config  Help = Clef controlant l'activation de la parametrisation
-    !               de l'humidite due a oxydation+photolyse du methane strato
-
-    ok_qch4_omp=.FALSE.
-    CALL getin('ok_qch4',ok_qch4_omp)
-
-    !Config Key  = OK_LES                                               
-    !Config Desc = Pour des sorties LES                                 
-    !Config Def  = .FALSE.                                              
-    !Config Help = Pour creer le fichier histLES contenant les sorties  
-    !              LES                                                  
-    !                                                                   
-    ok_LES_omp = .FALSE.                                              
-    CALL getin('OK_LES', ok_LES_omp)                                  
-
-    !Config Key  = callstats                                               
-    !Config Desc = Pour des sorties callstats                                 
-    !Config Def  = .FALSE.                                              
-    !Config Help = Pour creer le fichier stats contenant les sorties  
-    !              stats                                                  
-    !                                                                   
-    callstats_omp = .FALSE.                                              
-    CALL getin('callstats', callstats_omp)                                  
-    !
-    !Config Key  = ecrit_LES
-    !Config Desc = Frequence d'ecriture des resultats du LES en nombre de jours;
-    !              par defaut 1., i.e. 1 jour
-    !Config Def  = 1./8.
-    !Config Help = ... 
-    !
-    !
-    adjust_tropopause = .FALSE.
-    CALL getin('adjust_tropopause', adjust_tropopause_omp)
-    !
-    !Config Key  = adjust_tropopause
-    !Config Desc = Adjust the ozone field from the climoz file by stretching its
-    !              tropopause so that it matches the one of LMDZ.
-    !Config Def  = .FALSE.
-    !Config Help = Ensure tropospheric ozone column conservation.
-    !
-    !
-    ok_daily_climoz = .FALSE.
-    CALL getin('ok_daily_climoz', ok_daily_climoz_omp)
-    !
-    !Config Key  = ok_daily_climoz
-    !Config Desc = Interpolate in time the ozone forcings within ce0l.
-    !              .TRUE. if backward compatibility is needed.
-    !Config Def  = .TRUE.
-    !Config Help = .FALSE. ensure much fewer (no calendar dependency)
-    !  and lighter monthly climoz files, inetrpolated in time at gcm run time.
-    !
-    ecrit_LES_omp = 1./8.
-    CALL getin('ecrit_LES', ecrit_LES_omp)
-    !
-    read_climoz = 0 ! default value
-    CALL getin('read_climoz', read_climoz)
-
-    carbon_cycle_tr_omp=.FALSE.
-    CALL getin('carbon_cycle_tr',carbon_cycle_tr_omp)
-
-    carbon_cycle_cpl_omp=.FALSE.
-    CALL getin('carbon_cycle_cpl',carbon_cycle_cpl_omp)
-
-    carbon_cycle_rad_omp=.FALSE.
-    CALL getin('carbon_cycle_rad',carbon_cycle_rad_omp)
-
-    ! >> PC
-    ! level_coupling_esm : level of coupling of the biogeochemical fields between LMDZ, ORCHIDEE and NEMO
-    ! Definitions of level_coupling_esm in physiq.def
-    ! level_coupling_esm = 0  ! No field exchange between LMDZ and ORCHIDEE models
-    !                         ! No field exchange between LMDZ and NEMO
-    ! level_coupling_esm = 1  ! Field exchange between LMDZ and ORCHIDEE models
-    !                         ! No field exchange between LMDZ and NEMO models
-    ! level_coupling_esm = 2  ! No field exchange between LMDZ and ORCHIDEE models
-    !                         ! Field exchange between LMDZ and NEMO models
-    ! level_coupling_esm = 3  ! Field exchange between LMDZ and ORCHIDEE models
-    !                         ! Field exchange between LMDZ and NEMO models
-    level_coupling_esm_omp=0 ! default value
-    CALL getin('level_coupling_esm',level_coupling_esm_omp)
-    ! << PC
-
-    !$OMP END MASTER
-    !$OMP BARRIER
-
-    R_ecc = R_ecc_omp
-    R_peri = R_peri_omp
-    R_incl = R_incl_omp
-    solaire = solaire_omp
-    ok_suntime_rrtm = ok_suntime_rrtm_omp
-    co2_ppm = co2_ppm_omp
-    RCO2 = RCO2_omp
-    CH4_ppb = CH4_ppb_omp
-    RCH4 = RCH4_omp
-    N2O_ppb = N2O_ppb_omp
-    RN2O = RN2O_omp
-    CFC11_ppt = CFC11_ppt_omp
-    RCFC11 = RCFC11_omp
-    CFC12_ppt = CFC12_ppt_omp
-    RCFC12 = RCFC12_omp
-    RCO2_act = RCO2
-    RCH4_act = RCH4
-    RN2O_act = RN2O
-    RCFC11_act = RCFC11
-    RCFC12_act = RCFC12
-    RCO2_per = RCO2_per_omp
-    RCH4_per = RCH4_per_omp
-    RN2O_per = RN2O_per_omp
-    RCFC11_per = RCFC11_per_omp
-    RCFC12_per = RCFC12_per_omp
-
-    iflag_cycle_diurne = iflag_cycle_diurne_omp
-    soil_model = soil_model_omp
-    new_oliq = new_oliq_omp
-    ok_orodr = ok_orodr_omp
-    ok_orolf = ok_orolf_omp
-    ok_limitvrai = ok_limitvrai_omp
-    nbapp_rad = nbapp_rad_omp
-    iflag_con = iflag_con_omp
-    nbapp_cv = nbapp_cv_omp
-    nbapp_wk = nbapp_wk_omp
-    iflag_ener_conserv = iflag_ener_conserv_omp
-    ok_conserv_q = ok_conserv_q_omp
-    iflag_fisrtilp_qsat = iflag_fisrtilp_qsat_omp
-    iflag_bergeron = iflag_bergeron_omp
-
-    epmax = epmax_omp
-    coef_epmax_cape = coef_epmax_cape_omp
-    ok_adj_ema = ok_adj_ema_omp
-    iflag_clw = iflag_clw_omp
-    cld_lc_lsc = cld_lc_lsc_omp
-    cld_lc_con = cld_lc_con_omp
-    cld_tau_lsc = cld_tau_lsc_omp
-    cld_tau_con = cld_tau_con_omp
-    ffallv_lsc = ffallv_lsc_omp
-    ffallv_con = ffallv_con_omp
-    coef_eva = coef_eva_omp
-    reevap_ice = reevap_ice_omp
-    iflag_pdf = iflag_pdf_omp
-    solarlong0 = solarlong0_omp
-    qsol0 = qsol0_omp
-    evap0 = evap0_omp
-    albsno0 = albsno0_omp
-    iflag_sic = iflag_sic_omp
-    inertie_sol = inertie_sol_omp
-    inertie_sic = inertie_sic_omp
-    inertie_lic = inertie_lic_omp
-    inertie_sno = inertie_sno_omp
-    rad_froid = rad_froid_omp
-    rad_chau1 = rad_chau1_omp
-    rad_chau2 = rad_chau2_omp
-    t_glace_min = t_glace_min_omp
-    t_glace_max = t_glace_max_omp
-    exposant_glace = exposant_glace_omp
-    iflag_t_glace = iflag_t_glace_omp
-    iflag_cloudth_vert=iflag_cloudth_vert_omp
-    iflag_rain_incloud_vol=iflag_rain_incloud_vol_omp
-    iflag_ice_thermo = iflag_ice_thermo_omp
-    rei_min = rei_min_omp
-    rei_max = rei_max_omp
-    top_height = top_height_omp
-    overlap = overlap_omp
-    cdmmax = cdmmax_omp
-    cdhmax = cdhmax_omp
-    ksta = ksta_omp
-    ksta_ter = ksta_ter_omp
-    f_ri_cd_min = f_ri_cd_min_omp
-    ok_kzmin = ok_kzmin_omp
-    pbl_lmixmin_alpha=pbl_lmixmin_alpha_omp
-    fmagic = fmagic_omp
-    pmagic = pmagic_omp
-    iflag_pbl = iflag_pbl_omp
-    iflag_pbl_split = iflag_pbl_split_omp
-!FC
-    ifl_pbltree = ifl_pbltree_omp
-    Cd_frein    =Cd_frein_omp
-    iflag_order2_sollw = iflag_order2_sollw_omp
-    lev_histhf = lev_histhf_omp
-    lev_histday = lev_histday_omp
-    lev_histmth = lev_histmth_omp
-    lev_histins = lev_histins_omp
-    lev_histLES = lev_histLES_omp
-    lev_histdayNMC = lev_histdayNMC_omp
-    levout_histNMC = levout_histNMC_omp
-    ok_histNMC(:) = ok_histNMC_omp(:)
-    freq_outNMC(:) = freq_outNMC_omp(:)
-    freq_calNMC(:) = freq_calNMC_omp(:)
-
-    type_ocean = type_ocean_omp
-    version_ocean = version_ocean_omp
-    t_coupl = t_coupl_omp
-
-    ok_veget=.TRUE.
-    type_veget=type_veget_omp
-    IF (type_veget=='n' .or. type_veget=='bucket' .or. type_veget=='betaclim') THEN
-       ok_veget=.FALSE.
-    ENDIF
-    ! Martin
-    ok_snow = ok_snow_omp
-    ! Martin
-
-    ok_all_xml = ok_all_xml_omp
-    ok_lwoff = ok_lwoff_omp
-    ok_newmicro = ok_newmicro_omp
-    ok_journe = ok_journe_omp
-    ok_hf = ok_hf_omp
-    ok_mensuel = ok_mensuel_omp
-    ok_instan = ok_instan_omp
-    freq_ISCCP = freq_ISCCP_omp
-    ecrit_ISCCP = ecrit_ISCCP_omp
-    freq_COSP = freq_COSP_omp
-    freq_AIRS = freq_AIRS_omp
-    ok_ade = ok_ade_omp
-    ok_aie = ok_aie_omp
-    ok_alw = ok_alw_omp
-    ok_cdnc = ok_cdnc_omp
-    ok_volcan = ok_volcan_omp
-    aerosol_couple = aerosol_couple_omp
-    chemistry_couple = chemistry_couple_omp
-    flag_aerosol=flag_aerosol_omp
-    flag_aerosol_strat=flag_aerosol_strat_omp
-    flag_aer_feedback=flag_aer_feedback_omp
-    flag_bc_internal_mixture=flag_bc_internal_mixture_omp
-    aer_type = aer_type_omp
-    bl95_b0 = bl95_b0_omp
-    bl95_b1 = bl95_b1_omp
-    fact_cldcon = fact_cldcon_omp
-    facttemps = facttemps_omp
-    ratqsbas = ratqsbas_omp
-    ratqshaut = ratqshaut_omp
-    tau_ratqs = tau_ratqs_omp
-
-    iflag_radia = iflag_radia_omp
-    iflag_rrtm = iflag_rrtm_omp
-    iflag_albedo = iflag_albedo_omp
-    ok_chlorophyll = ok_chlorophyll_omp
-    NSW = NSW_omp
-    iflag_cld_th = iflag_cld_th_omp
-    iflag_cld_cv = iflag_cld_cv_omp
-    tau_cld_cv = tau_cld_cv_omp
-    coefw_cld_cv = coefw_cld_cv_omp
-    iflag_ratqs = iflag_ratqs_omp
-    ip_ebil_phy = ip_ebil_phy_omp
-    iflag_thermals = iflag_thermals_omp
-    iflag_thermals_ed = iflag_thermals_ed_omp
-    fact_thermals_ed_dz = fact_thermals_ed_dz_omp
-    iflag_thermals_optflux = iflag_thermals_optflux_omp
-    iflag_thermals_closure = iflag_thermals_closure_omp
-    nsplit_thermals = nsplit_thermals_omp
-    tau_thermals = tau_thermals_omp
-    alp_bl_k = alp_bl_k_omp
-    ! nrlmd le 10/04/2012
-    iflag_trig_bl = iflag_trig_bl_omp
-    s_trig = s_trig_omp
-    tau_trig_shallow = tau_trig_shallow_omp
-    tau_trig_deep = tau_trig_deep_omp
-    iflag_clos_bl = iflag_clos_bl_omp
-    ! fin nrlmd le 10/04/2012
-    iflag_coupl = iflag_coupl_omp
-    iflag_clos = iflag_clos_omp
-    iflag_wake = iflag_wake_omp
-    coef_clos_ls = coef_clos_ls_omp
-    alp_offset = alp_offset_omp
-    iflag_cvl_sigd = iflag_cvl_sigd_omp
-    type_run = type_run_omp
-    ok_cosp = ok_cosp_omp
-    ok_airs = ok_airs_omp
-
-    ok_mensuelCOSP = ok_mensuelCOSP_omp
-    ok_journeCOSP = ok_journeCOSP_omp
-    ok_hfCOSP = ok_hfCOSP_omp
-    seuil_inversion=seuil_inversion_omp
-    lonmin_ins = lonmin_ins_omp
-    lonmax_ins = lonmax_ins_omp
-    latmin_ins = latmin_ins_omp
-    latmax_ins = latmax_ins_omp
-    ecrit_hf   = ecrit_hf_omp
-    ecrit_ins   = ecrit_ins_omp
-    ecrit_day = ecrit_day_omp
-    ecrit_mth = ecrit_mth_omp
-    ecrit_tra = ecrit_tra_omp
-    ecrit_reg = ecrit_reg_omp
-    cvl_comp_threshold = cvl_comp_threshold_omp
-    cvl_sig2feed = cvl_sig2feed_omp
-    cvl_corr = cvl_corr_omp
-    ok_lic_melt = ok_lic_melt_omp
-    ok_lic_cond = ok_lic_cond_omp
-    f_cdrag_ter=f_cdrag_ter_omp
-    f_cdrag_oce=f_cdrag_oce_omp
-
-    f_gust_wk=f_gust_wk_omp
-    f_gust_bl=f_gust_bl_omp
-    f_qsat_oce=f_qsat_oce_omp
-    f_z0qh_oce=f_z0qh_oce_omp
-    min_wind_speed=min_wind_speed_omp
-    iflag_gusts=iflag_gusts_omp
-    iflag_z0_oce=iflag_z0_oce_omp
-
-    z0m_seaice=z0m_seaice_omp
-    z0h_seaice=z0h_seaice_omp
-
-    f_rugoro=f_rugoro_omp
-
-    z0min=z0min_omp
-    supcrit1 = supcrit1_omp
-    supcrit2 = supcrit2_omp
-    iflag_mix = iflag_mix_omp
-    iflag_mix_adiab = iflag_mix_adiab_omp
-    scut = scut_omp
-    qqa1 = qqa1_omp
-    qqa2 = qqa2_omp
-    gammas = gammas_omp
-    Fmax = Fmax_omp
-    tmax_fonte_cv = tmax_fonte_cv_omp
-    alphas = alphas_omp
-
-    gkdrag=sso_gkdrag_omp
-    grahilo=sso_grahil_omp
-    grcrit=sso_grcrit_omp
-    gfrcrit=sso_gfrcri_omp
-    gkwake=sso_gkwake_omp 
-    gklift=sso_gklift_omp 
-
-    ok_strato = ok_strato_omp
-    ok_hines = ok_hines_omp
-    ok_gwd_rando = ok_gwd_rando_omp
-    gwd_rando_ruwmax = gwd_rando_ruwmax_omp
-    gwd_rando_sat = gwd_rando_sat_omp
-    gwd_front_ruwmax = gwd_front_ruwmax_omp
-    gwd_front_sat = gwd_front_sat_omp
-    ok_qch4 = ok_qch4_omp
-    ok_LES = ok_LES_omp
-    callstats = callstats_omp
-    ecrit_LES = ecrit_LES_omp
-    adjust_tropopause = adjust_tropopause_omp
-    ok_daily_climoz = ok_daily_climoz_omp
-    carbon_cycle_tr = carbon_cycle_tr_omp
-    carbon_cycle_cpl = carbon_cycle_cpl_omp
-    carbon_cycle_rad = carbon_cycle_rad_omp
-    level_coupling_esm = level_coupling_esm_omp
-
-    ! Test of coherence between type_ocean and version_ocean
-    IF (type_ocean=='couple' .AND. (version_ocean/='opa8' .AND. version_ocean/='nemo') ) THEN
-       WRITE(lunout,*)' ERROR version_ocean=',version_ocean,' not valid in coupled configuration'
-       CALL abort_physic('conf_phys','version_ocean not valid',1)
-    ENDIF
-
-    IF (type_ocean=='slab' .AND. version_ocean=='xxxxxx') THEN
-       version_ocean='sicOBS'
-    ELSE IF (type_ocean=='slab' .AND. version_ocean/='sicOBS' &
-         .AND. version_ocean/='sicINT' .AND. version_ocean/='sicNO') THEN
-       WRITE(lunout,*)' ERROR version_ocean=',version_ocean,' not valid with slab ocean'
-       CALL abort_physic('conf_phys','version_ocean not valid',1)
-    ENDIF
-
-    !--test on radiative scheme 
-    IF (iflag_rrtm .EQ. 0) THEN 
-      IF (NSW.NE.2) THEN 
-        WRITE(lunout,*) ' ERROR iflag_rrtm=0 and NSW<>2 not possible'
-        CALL abort_physic('conf_phys','choice NSW not valid',1)
-      ENDIF
-    ELSE IF (iflag_rrtm .EQ. 1) THEN
-      IF (NSW.NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN
-        WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible'
-        CALL abort_physic('conf_phys','choice NSW not valid',1)
-      ENDIF
-    ELSE 
-       WRITE(lunout,*) ' ERROR iflag_rrtm<>0,1'
-       CALL abort_physic('conf_phys','choice iflag_rrtm not valid',1)
-    ENDIF
-    !--here we test that solaire has not been changed if ok_suntime_rrtm is activated
-!    IF (ok_suntime_rrtm.AND.ABS(solaire-solaire_omp_init).GT.1.E-7) THEN 
-!       WRITE(lunout,*) ' ERROR ok_suntime_rrtm=y and solaire is provided in def file'
-!       CALL abort_physic('conf_phys','ok_suntime_rrtm=y and solaire is provided',1)
-!    ENDIF
-#ifdef CPP_StratAer
-    IF (iflag_rrtm .NE. 1) THEN 
-       WRITE(lunout,*) ' ERROR iflag_rrtm<>1 but StratAer activated'
-       CALL abort_physic('conf_phys','iflag_rrtm not valid for StratAer',1)
-    ENDIF
-    IF (NSW .NE. 6) THEN 
-       WRITE(lunout,*) ' ERROR NSW<>6 but StratAer activated'
-       CALL abort_physic('conf_phys','NSW not valid for StratAer',1)
-    ENDIF
-#endif
-
-    !--test on ocean surface albedo
-    IF (iflag_albedo.LT.0.OR.iflag_albedo.GT.2) THEN
-       WRITE(lunout,*) ' ERROR iflag_albedo<>0,1'
-       CALL abort_physic('conf_phys','choice iflag_albedo not valid',1)
-    ENDIF
-
-    ! Test sur new_aod. Ce flag permet de retrouver les resultats de l'AR4
-    ! il n'est utilisable que lors du couplage avec le SO4 seul 
-    IF (ok_ade .OR. ok_aie) THEN 
-       IF ( flag_aerosol .EQ. 0 ) THEN
-          CALL abort_physic('conf_phys','flag_aerosol=0 not compatible avec ok_ade ou ok_aie=.TRUE.',1)
-       ENDIF
-    ENDIF
-
-    ! Flag_aerosol cannot be to zero if we are in coupled mode for aerosol
-    IF (aerosol_couple .AND. flag_aerosol .EQ. 0 ) THEN
-       CALL abort_physic('conf_phys', 'flag_aerosol cannot be to zero if aerosol_couple=y ', 1)
-    ENDIF
-
-    ! Read_climoz need to be zero if we are in couple mode for chemistry 
-    IF (chemistry_couple .AND. read_climoz .ne. 0) THEN 
-       CALL abort_physic('conf_phys', 'read_climoz need to be to zero if chemistry_couple=y ', 1) 
-    ENDIF
-
-    ! flag_aerosol need to be different to zero if ok_cdnc is activated
-    IF (ok_cdnc .AND. flag_aerosol .EQ. 0) THEN
-       CALL abort_physic('conf_phys', 'flag_aerosol cannot be to zero if ok_cdnc is activated ', 1)
-    ENDIF
-
-    ! ok_cdnc must be set to y if ok_aie is activated
-    IF (ok_aie .AND. .NOT. ok_cdnc) THEN
-       CALL abort_physic('conf_phys', 'ok_cdnc must be set to y if ok_aie is activated',1)
-    ENDIF
-
-    ! flag_aerosol=7 => MACv2SP climatology 
-    IF (flag_aerosol.EQ.7.AND. iflag_rrtm.NE.1) THEN
-       CALL abort_physic('conf_phys', 'flag_aerosol=7 (MACv2SP) can only be activated with RRTM',1)
-    ENDIF
-    IF (flag_aerosol.EQ.7.AND. NSW.NE.6) THEN
-       CALL abort_physic('conf_phys', 'flag_aerosol=7 (MACv2SP) can only be activated with NSW=6',1)
-    ENDIF
-
-    ! BC internal mixture is only possible with RRTM & NSW=6 & flag_aerosol=6 or aerosol_couple
-    IF (flag_bc_internal_mixture .AND. NSW.NE.6) THEN 
-       CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with NSW=6',1)
-    ENDIF
-    IF (flag_bc_internal_mixture .AND. iflag_rrtm.NE.1) THEN 
-       CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with RRTM',1)
-    ENDIF
-    IF (flag_bc_internal_mixture .AND. flag_aerosol.NE.6) THEN 
-       CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with flag_aerosol=6',1)
-    ENDIF
-
-    ! Test on carbon cycle
-    IF (carbon_cycle_tr .AND. .NOT. carbon_cycle_cpl) THEN
-       CALL abort_physic('conf_phys', 'carbon_cycle_cpl has to be TRUE if carbon_cycle_tr is on',1)
-    ENDIF
-    IF (carbon_cycle_rad .AND. .NOT. carbon_cycle_cpl) THEN
-       CALL abort_physic('conf_phys', 'carbon_cycle_cpl has to be TRUE if carbon_cycle_rad is on',1)
-    ENDIF
-
-    ! ORCHIDEE must be activated for ifl_pbltree=1
-    IF (.NOT. ok_veget .AND. ifl_pbltree==1) THEN
-       WRITE(lunout,*)'Warning: ORCHIDEE must be activated for ifl_pbltree=1'
-       WRITE(lunout,*)'ifl_pbltree is now changed to zero'
-       ifl_pbltree=0
-    ENDIF
-
-    !$OMP MASTER
-
-    WRITE(lunout,*) ' ##############################################'
-    WRITE(lunout,*) ' Configuration des parametres de la physique: '
-    WRITE(lunout,*) ' Type ocean = ', type_ocean
-    WRITE(lunout,*) ' Version ocean = ', version_ocean
-    WRITE(lunout,*) ' Config veget = ', ok_veget,type_veget
-    WRITE(lunout,*) ' Snow model SISVAT : ok_snow = ', ok_snow
-    WRITE(lunout,*) ' Config xml pour XIOS : ok_all_xml = ', ok_all_xml
-    WRITE(lunout,*) ' Sortie journaliere = ', ok_journe
-    WRITE(lunout,*) ' Sortie haute frequence = ', ok_hf
-    WRITE(lunout,*) ' Sortie mensuelle = ', ok_mensuel
-    WRITE(lunout,*) ' Sortie instantanee = ', ok_instan
-    WRITE(lunout,*) ' Frequence appel simulateur ISCCP, freq_ISCCP =', freq_ISCCP
-    WRITE(lunout,*) ' Frequence appel simulateur ISCCP, ecrit_ISCCP =', ecrit_ISCCP
-    WRITE(lunout,*) ' Frequence appel simulateur COSP, freq_COSP =', freq_COSP
-    WRITE(lunout,*) ' Frequence appel simulateur AIRS, freq_AIRS =', freq_AIRS
-    WRITE(lunout,*) ' Sortie bilan d''energie, ip_ebil_phy =', ip_ebil_phy
-    WRITE(lunout,*) ' Excentricite = ',R_ecc
-    WRITE(lunout,*) ' Equinoxe = ',R_peri
-    WRITE(lunout,*) ' Inclinaison =',R_incl
-    WRITE(lunout,*) ' Constante solaire =',solaire
-    WRITE(lunout,*) ' ok_suntime_rrtm =',ok_suntime_rrtm
-    WRITE(lunout,*) ' co2_ppm =',co2_ppm
-    WRITE(lunout,*) ' RCO2_act = ',RCO2_act
-    WRITE(lunout,*) ' CH4_ppb =',CH4_ppb,' RCH4_act = ',RCH4_act
-    WRITE(lunout,*) ' N2O_ppb =',N2O_ppb,' RN2O_act=  ',RN2O_act
-    WRITE(lunout,*) ' CFC11_ppt=',CFC11_ppt,' RCFC11_act=  ',RCFC11_act
-    WRITE(lunout,*) ' CFC12_ppt=',CFC12_ppt,' RCFC12_act=  ',RCFC12_act
-    WRITE(lunout,*) ' RCO2_per = ',RCO2_per,' RCH4_per = ', RCH4_per
-    WRITE(lunout,*) ' RN2O_per = ',RN2O_per,' RCFC11_per = ', RCFC11_per
-    WRITE(lunout,*) ' RCFC12_per = ',RCFC12_per
-    WRITE(lunout,*) ' cvl_comp_threshold=', cvl_comp_threshold
-    WRITE(lunout,*) ' cvl_sig2feed=', cvl_sig2feed
-    WRITE(lunout,*) ' cvl_corr=', cvl_corr
-    WRITE(lunout,*) ' ok_lic_melt=', ok_lic_melt
-    WRITE(lunout,*) ' ok_lic_cond=', ok_lic_cond
-    WRITE(lunout,*) ' iflag_cycle_diurne=',iflag_cycle_diurne
-    WRITE(lunout,*) ' soil_model=',soil_model
-    WRITE(lunout,*) ' new_oliq=',new_oliq
-    WRITE(lunout,*) ' ok_orodr=',ok_orodr
-    WRITE(lunout,*) ' ok_orolf=',ok_orolf
-    WRITE(lunout,*) ' ok_limitvrai=',ok_limitvrai
-    WRITE(lunout,*) ' nbapp_rad=',nbapp_rad
-    WRITE(lunout,*) ' iflag_con=',iflag_con
-    WRITE(lunout,*) ' nbapp_cv=',nbapp_cv
-    WRITE(lunout,*) ' nbapp_wk=',nbapp_wk
-    WRITE(lunout,*) ' iflag_ener_conserv=',iflag_ener_conserv
-    WRITE(lunout,*) ' ok_conserv_q=',ok_conserv_q
-    WRITE(lunout,*) ' iflag_fisrtilp_qsat=',iflag_fisrtilp_qsat
-    WRITE(lunout,*) ' iflag_bergeron=',iflag_bergeron
-    WRITE(lunout,*) ' epmax = ', epmax
-    WRITE(lunout,*) ' coef_epmax_cape = ', coef_epmax_cape
-    WRITE(lunout,*) ' ok_adj_ema = ', ok_adj_ema
-    WRITE(lunout,*) ' iflag_clw = ', iflag_clw
-    WRITE(lunout,*) ' cld_lc_lsc = ', cld_lc_lsc
-    WRITE(lunout,*) ' cld_lc_con = ', cld_lc_con
-    WRITE(lunout,*) ' cld_tau_lsc = ', cld_tau_lsc
-    WRITE(lunout,*) ' cld_tau_con = ', cld_tau_con
-    WRITE(lunout,*) ' ffallv_lsc = ', ffallv_lsc
-    WRITE(lunout,*) ' ffallv_con = ', ffallv_con
-    WRITE(lunout,*) ' coef_eva = ', coef_eva
-    WRITE(lunout,*) ' reevap_ice = ', reevap_ice
-    WRITE(lunout,*) ' iflag_pdf = ', iflag_pdf
-    WRITE(lunout,*) ' iflag_cld_th = ', iflag_cld_th
-    WRITE(lunout,*) ' iflag_cld_cv = ', iflag_cld_cv
-    WRITE(lunout,*) ' tau_cld_cv = ', tau_cld_cv
-    WRITE(lunout,*) ' coefw_cld_cv = ', coefw_cld_cv
-    WRITE(lunout,*) ' iflag_radia = ', iflag_radia
-    WRITE(lunout,*) ' iflag_rrtm = ', iflag_rrtm
-    WRITE(lunout,*) ' NSW = ', NSW
-    WRITE(lunout,*) ' iflag_albedo = ', iflag_albedo !albedo SB
-    WRITE(lunout,*) ' ok_chlorophyll =',ok_chlorophyll ! albedo SB
-    WRITE(lunout,*) ' iflag_ratqs = ', iflag_ratqs
-    WRITE(lunout,*) ' seuil_inversion = ', seuil_inversion
-    WRITE(lunout,*) ' fact_cldcon = ', fact_cldcon
-    WRITE(lunout,*) ' facttemps = ', facttemps
-    WRITE(lunout,*) ' ok_newmicro = ',ok_newmicro 
-    WRITE(lunout,*) ' ratqsbas = ',ratqsbas 
-    WRITE(lunout,*) ' ratqshaut = ',ratqshaut 
-    WRITE(lunout,*) ' tau_ratqs = ',tau_ratqs 
-    WRITE(lunout,*) ' top_height = ',top_height 
-    WRITE(lunout,*) ' rad_froid = ',rad_froid
-    WRITE(lunout,*) ' rad_chau1 = ',rad_chau1
-    WRITE(lunout,*) ' rad_chau2 = ',rad_chau2
-    WRITE(lunout,*) ' t_glace_min = ',t_glace_min
-    WRITE(lunout,*) ' t_glace_max = ',t_glace_max
-    WRITE(lunout,*) ' exposant_glace = ',exposant_glace
-    WRITE(lunout,*) ' iflag_t_glace = ',iflag_t_glace
-    WRITE(lunout,*) ' iflag_cloudth_vert = ',iflag_cloudth_vert
-    WRITE(lunout,*) ' iflag_rain_incloud_vol = ',iflag_rain_incloud_vol
-    WRITE(lunout,*) ' iflag_ice_thermo = ',iflag_ice_thermo
-    WRITE(lunout,*) ' rei_min = ',rei_min
-    WRITE(lunout,*) ' rei_max = ',rei_max
-    WRITE(lunout,*) ' overlap = ',overlap 
-    WRITE(lunout,*) ' cdmmax = ',cdmmax 
-    WRITE(lunout,*) ' cdhmax = ',cdhmax 
-    WRITE(lunout,*) ' ksta = ',ksta 
-    WRITE(lunout,*) ' ksta_ter = ',ksta_ter 
-    WRITE(lunout,*) ' f_ri_cd_min = ',f_ri_cd_min 
-    WRITE(lunout,*) ' ok_kzmin = ',ok_kzmin 
-    WRITE(lunout,*) ' pbl_lmixmin_alpha = ',pbl_lmixmin_alpha
-    WRITE(lunout,*) ' fmagic = ',fmagic
-    WRITE(lunout,*) ' pmagic = ',pmagic
-    WRITE(lunout,*) ' ok_ade = ',ok_ade
-    WRITE(lunout,*) ' ok_volcan = ',ok_volcan
-    WRITE(lunout,*) ' ok_aie = ',ok_aie
-    WRITE(lunout,*) ' ok_alw = ',ok_alw
-    WRITE(lunout,*) ' aerosol_couple = ', aerosol_couple
-    WRITE(lunout,*) ' chemistry_couple = ', chemistry_couple
-    WRITE(lunout,*) ' flag_aerosol = ', flag_aerosol
-    WRITE(lunout,*) ' flag_aerosol_strat= ', flag_aerosol_strat
-    WRITE(lunout,*) ' flag_aer_feedback= ', flag_aer_feedback
-    WRITE(lunout,*) ' aer_type = ',aer_type
-    WRITE(lunout,*) ' bl95_b0 = ',bl95_b0
-    WRITE(lunout,*) ' bl95_b1 = ',bl95_b1
-    WRITE(lunout,*) ' lev_histhf = ',lev_histhf 
-    WRITE(lunout,*) ' lev_histday = ',lev_histday 
-    WRITE(lunout,*) ' lev_histmth = ',lev_histmth 
-    WRITE(lunout,*) ' lev_histins = ',lev_histins
-    WRITE(lunout,*) ' lev_histLES = ',lev_histLES
-    WRITE(lunout,*) ' lev_histdayNMC = ',lev_histdayNMC
-    WRITE(lunout,*) ' levout_histNMC = ',levout_histNMC
-    WRITE(lunout,*) ' ok_histNMC = ',ok_histNMC
-    WRITE(lunout,*) ' freq_outNMC = ',freq_outNMC
-    WRITE(lunout,*) ' freq_calNMC = ',freq_calNMC
-    WRITE(lunout,*) ' iflag_pbl = ', iflag_pbl
-!FC
-    WRITE(lunout,*) ' ifl_pbltree = ', ifl_pbltree
-    WRITE(lunout,*) ' Cd_frein = ', Cd_frein
-    WRITE(lunout,*) ' iflag_pbl_split = ', iflag_pbl_split
-    WRITE(lunout,*) ' iflag_order2_sollw = ', iflag_order2_sollw
-    WRITE(lunout,*) ' iflag_thermals = ', iflag_thermals
-    WRITE(lunout,*) ' iflag_thermals_ed = ', iflag_thermals_ed
-    WRITE(lunout,*) ' fact_thermals_ed_dz = ', fact_thermals_ed_dz
-    WRITE(lunout,*) ' iflag_thermals_optflux = ', iflag_thermals_optflux
-    WRITE(lunout,*) ' iflag_thermals_closure = ', iflag_thermals_closure
-    WRITE(lunout,*) ' iflag_clos = ', iflag_clos
-    WRITE(lunout,*) ' coef_clos_ls = ', coef_clos_ls
-    WRITE(lunout,*) ' type_run = ',type_run 
-    WRITE(lunout,*) ' ok_cosp = ',ok_cosp
-    WRITE(lunout,*) ' ok_airs = ',ok_airs
-
-    WRITE(lunout,*) ' ok_mensuelCOSP = ',ok_mensuelCOSP
-    WRITE(lunout,*) ' ok_journeCOSP = ',ok_journeCOSP
-    WRITE(lunout,*) ' ok_hfCOSP =',ok_hfCOSP
-    WRITE(lunout,*) ' solarlong0 = ', solarlong0
-    WRITE(lunout,*) ' qsol0 = ', qsol0
-    WRITE(lunout,*) ' evap0 = ', evap0
-    WRITE(lunout,*) ' albsno0 = ', albsno0
-    WRITE(lunout,*) ' iflag_sic = ', iflag_sic
-    WRITE(lunout,*) ' inertie_sol = ', inertie_sol
-    WRITE(lunout,*) ' inertie_sic = ', inertie_sic
-    WRITE(lunout,*) ' inertie_lic = ', inertie_lic
-    WRITE(lunout,*) ' inertie_sno = ', inertie_sno
-    WRITE(lunout,*) ' f_cdrag_ter = ',f_cdrag_ter
-    WRITE(lunout,*) ' f_cdrag_oce = ',f_cdrag_oce
-    WRITE(lunout,*) ' f_rugoro = ',f_rugoro
-    WRITE(lunout,*) ' z0min = ',z0min
-    WRITE(lunout,*) ' supcrit1 = ', supcrit1
-    WRITE(lunout,*) ' supcrit2 = ', supcrit2
-    WRITE(lunout,*) ' iflag_mix = ', iflag_mix
-    WRITE(lunout,*) ' iflag_mix_adiab = ', iflag_mix_adiab
-    WRITE(lunout,*) ' scut = ', scut
-    WRITE(lunout,*) ' qqa1 = ', qqa1
-    WRITE(lunout,*) ' qqa2 = ', qqa2
-    WRITE(lunout,*) ' gammas = ', gammas
-    WRITE(lunout,*) ' Fmax = ', Fmax
-    WRITE(lunout,*) ' tmax_fonte_cv = ', tmax_fonte_cv
-    WRITE(lunout,*) ' alphas = ', alphas
-    WRITE(lunout,*) ' iflag_wake = ', iflag_wake
-    WRITE(lunout,*) ' alp_offset = ', alp_offset
-    ! nrlmd le 10/04/2012
-    WRITE(lunout,*) ' iflag_trig_bl = ', iflag_trig_bl
-    WRITE(lunout,*) ' s_trig = ', s_trig
-    WRITE(lunout,*) ' tau_trig_shallow = ', tau_trig_shallow
-    WRITE(lunout,*) ' tau_trig_deep = ', tau_trig_deep
-    WRITE(lunout,*) ' iflag_clos_bl = ', iflag_clos_bl
-    ! fin nrlmd le 10/04/2012
-
-    WRITE(lunout,*) ' lonmin lonmax latmin latmax bilKP_ins =',&
-         lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
-    WRITE(lunout,*) ' ecrit_ hf, ins, day, mth, reg, tra, ISCCP, LES',&
-         ecrit_hf, ecrit_ins, ecrit_day, ecrit_mth, ecrit_reg, ecrit_tra, ecrit_ISCCP, ecrit_LES
-
-    WRITE(lunout,*) ' ok_strato = ', ok_strato
-    WRITE(lunout,*) ' ok_hines = ',  ok_hines
-    WRITE(lunout,*) ' ok_gwd_rando = ',  ok_gwd_rando
-    WRITE(lunout,*) ' ok_qch4 = ',  ok_qch4
-    WRITE(lunout,*) ' gwd_rando_ruwmax = ', gwd_rando_ruwmax
-    WRITE(lunout,*) ' gwd_rando_sat = ', gwd_rando_sat
-    WRITE(lunout,*) ' gwd_front_ruwmax = ', gwd_front_ruwmax
-    WRITE(lunout,*) ' gwd_front_sat = ', gwd_front_sat
-    WRITE(lunout,*) ' SSO gkdrag =',gkdrag
-    WRITE(lunout,*) ' SSO grahilo=',grahilo
-    WRITE(lunout,*) ' SSO grcrit=',grcrit
-    WRITE(lunout,*) ' SSO gfrcrit=',gfrcrit
-    WRITE(lunout,*) ' SSO gkwake=',gkwake
-    WRITE(lunout,*) ' SSO gklift=',gklift
-    WRITE(lunout,*) ' adjust_tropopause = ', adjust_tropopause
-    WRITE(lunout,*) ' ok_daily_climoz = ',ok_daily_climoz
-    WRITE(lunout,*) ' read_climoz = ', read_climoz
-    WRITE(lunout,*) ' carbon_cycle_tr = ', carbon_cycle_tr
-    WRITE(lunout,*) ' carbon_cycle_cpl = ', carbon_cycle_cpl
-    WRITE(lunout,*) ' carbon_cycle_rad = ', carbon_cycle_rad
-    WRITE(lunout,*) ' level_coupling_esm = ', level_coupling_esm
-
-    !$OMP END MASTER
-
-    RETURN
-
-  END SUBROUTINE conf_phys
-
-END MODULE conf_phys_m
-!
-!#################################################################
-!
-
-SUBROUTINE conf_interface(tau_calv)
-
-  USE IOIPSL
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-  ! Configuration de l'interace atm/surf
-  !
-  ! tau_calv:    temps de relaxation pour la fonte des glaciers
-  !
-  REAL          :: tau_calv
-  REAL, SAVE    :: tau_calv_omp
-  !
-  !Config Key  = tau_calv
-  !Config Desc = temps de relaxation pour fonte des glaciers en jours
-  !Config Def  = 1 an 
-  !Config Help = 
-  !
-  tau_calv_omp = 360.*10.
-  !$OMP MASTER
-  CALL getin('tau_calv',tau_calv_omp)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  !
-  tau_calv=tau_calv_omp
-  !
-  !$OMP MASTER
-  WRITE(lunout,*)' ##############################################'
-  WRITE(lunout,*)' Configuration de l''interface atm/surfaces  : '
-  WRITE(lunout,*)' tau_calv = ',tau_calv
-  !$OMP END MASTER
-  !
-  RETURN
-
-END SUBROUTINE conf_interface
+link ../phylmd/conf_phys_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/conflx.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/conflx.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/conflx.F90	(revision 3940)
@@ -1,1608 +1,1 @@
-
-! $Header$
-
-SUBROUTINE conflx(dtime, pres_h, pres_f, t, q, con_t, con_q, pqhfl, w, d_t, &
-    d_q, rain, snow, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
-    kdtop, pmflxr, pmflxs)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19941014
-  ! Objet: Schema flux de masse pour la convection
-  ! (schema de Tiedtke avec qqs modifications mineures)
-  ! Dec.97: Prise en compte des modifications introduites par
-  ! Olivier Boucher et Alexandre Armengaud pour melange
-  ! et lessivage des traceurs passifs.
-  ! ======================================================================
-  include "YOMCST.h"
-  include "YOETHF.h"
-  ! Entree:
-  REAL dtime ! pas d'integration (s)
-  REAL pres_h(klon, klev+1) ! pression half-level (Pa)
-  REAL pres_f(klon, klev) ! pression full-level (Pa)
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! humidite specifique (g/g)
-  REAL w(klon, klev) ! vitesse verticale (Pa/s)
-  REAL con_t(klon, klev) ! convergence de temperature (K/s)
-  REAL con_q(klon, klev) ! convergence de l'eau vapeur (g/g/s)
-  REAL pqhfl(klon) ! evaporation (negative vers haut) mm/s
-  ! Sortie:
-  REAL d_t(klon, klev) ! incrementation de temperature
-  REAL d_q(klon, klev) ! incrementation d'humidite
-  REAL pmfu(klon, klev) ! flux masse (kg/m2/s) panache ascendant
-  REAL pmfd(klon, klev) ! flux masse (kg/m2/s) panache descendant
-  REAL pen_u(klon, klev)
-  REAL pen_d(klon, klev)
-  REAL pde_u(klon, klev)
-  REAL pde_d(klon, klev)
-  REAL rain(klon) ! pluie (mm/s)
-  REAL snow(klon) ! neige (mm/s)
-  REAL pmflxr(klon, klev+1)
-  REAL pmflxs(klon, klev+1)
-  INTEGER kcbot(klon) ! niveau du bas de la convection
-  INTEGER kctop(klon) ! niveau du haut de la convection
-  INTEGER kdtop(klon) ! niveau du haut des downdrafts
-  ! Local:
-  REAL pt(klon, klev)
-  REAL pq(klon, klev)
-  REAL pqs(klon, klev)
-  REAL pvervel(klon, klev)
-  LOGICAL land(klon)
-
-  REAL d_t_bis(klon, klev)
-  REAL d_q_bis(klon, klev)
-  REAL paprs(klon, klev+1)
-  REAL paprsf(klon, klev)
-  REAL zgeom(klon, klev)
-  REAL zcvgq(klon, klev)
-  REAL zcvgt(klon, klev)
-  ! AA
-  REAL zmfu(klon, klev)
-  REAL zmfd(klon, klev)
-  REAL zen_u(klon, klev)
-  REAL zen_d(klon, klev)
-  REAL zde_u(klon, klev)
-  REAL zde_d(klon, klev)
-  REAL zmflxr(klon, klev+1)
-  REAL zmflxs(klon, klev+1)
-  ! AA
-
-
-  INTEGER i, k
-  REAL zdelta, zqsat
-
-  include "FCTTRE.h"
-
-  ! initialiser les variables de sortie (pour securite)
-  DO i = 1, klon
-    rain(i) = 0.0
-    snow(i) = 0.0
-    kcbot(i) = 0
-    kctop(i) = 0
-    kdtop(i) = 0
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_q(i, k) = 0.0
-      pmfu(i, k) = 0.0
-      pmfd(i, k) = 0.0
-      pen_u(i, k) = 0.0
-      pde_u(i, k) = 0.0
-      pen_d(i, k) = 0.0
-      pde_d(i, k) = 0.0
-      zmfu(i, k) = 0.0
-      zmfd(i, k) = 0.0
-      zen_u(i, k) = 0.0
-      zde_u(i, k) = 0.0
-      zen_d(i, k) = 0.0
-      zde_d(i, k) = 0.0
-    END DO
-  END DO
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      zmflxr(i, k) = 0.0
-      zmflxs(i, k) = 0.0
-    END DO
-  END DO
-
-  ! calculer la nature du sol (pour l'instant, ocean partout)
-  DO i = 1, klon
-    land(i) = .FALSE.
-  END DO
-
-  ! preparer les variables d'entree (attention: l'ordre des niveaux
-  ! verticaux augmente du haut vers le bas)
-  DO k = 1, klev
-    DO i = 1, klon
-      pt(i, k) = t(i, klev-k+1)
-      pq(i, k) = q(i, klev-k+1)
-      paprsf(i, k) = pres_f(i, klev-k+1)
-      paprs(i, k) = pres_h(i, klev+1-k+1)
-      pvervel(i, k) = w(i, klev+1-k)
-      zcvgt(i, k) = con_t(i, klev-k+1)
-      zcvgq(i, k) = con_q(i, klev-k+1)
-
-      zdelta = max(0., sign(1.,rtt-pt(i,k)))
-      zqsat = r2es*foeew(pt(i,k), zdelta)/paprsf(i, k)
-      zqsat = min(0.5, zqsat)
-      zqsat = zqsat/(1.-retv*zqsat)
-      pqs(i, k) = zqsat
-    END DO
-  END DO
-  DO i = 1, klon
-    paprs(i, klev+1) = pres_h(i, 1)
-    zgeom(i, klev) = rd*pt(i, klev)/(0.5*(paprs(i,klev+1)+paprsf(i, &
-      klev)))*(paprs(i,klev+1)-paprsf(i,klev))
-  END DO
-  DO k = klev - 1, 1, -1
-    DO i = 1, klon
-      zgeom(i, k) = zgeom(i, k+1) + rd*0.5*(pt(i,k+1)+pt(i,k))/paprs(i, k+1)* &
-        (paprsf(i,k+1)-paprsf(i,k))
-    END DO
-  END DO
-
-  ! appeler la routine principale
-
-  CALL flxmain(dtime, pt, pq, pqs, pqhfl, paprsf, paprs, zgeom, land, zcvgt, &
-    zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, zmfu, zmfd, zen_u, &
-    zde_u, zen_d, zde_d, d_t_bis, d_q_bis, zmflxr, zmflxs)
-
-  ! AA--------------------------------------------------------
-  ! AA rem : De la meme facon que l'on effectue le reindicage
-  ! AA       pour la temperature t et le champ q
-  ! AA       on reindice les flux necessaires a la convection
-  ! AA       des traceurs
-  ! AA--------------------------------------------------------
-  DO k = 1, klev
-    DO i = 1, klon
-      d_q(i, klev+1-k) = dtime*d_q_bis(i, k)
-      d_t(i, klev+1-k) = dtime*d_t_bis(i, k)
-    END DO
-  END DO
-
-  DO i = 1, klon
-    pmfu(i, 1) = 0.
-    pmfd(i, 1) = 0.
-    pen_d(i, 1) = 0.
-    pde_d(i, 1) = 0.
-  END DO
-
-  DO k = 2, klev
-    DO i = 1, klon
-      pmfu(i, klev+2-k) = zmfu(i, k)
-      pmfd(i, klev+2-k) = zmfd(i, k)
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      pen_u(i, klev+1-k) = zen_u(i, k)
-      pde_u(i, klev+1-k) = zde_u(i, k)
-    END DO
-  END DO
-
-  DO k = 1, klev - 1
-    DO i = 1, klon
-      pen_d(i, klev+1-k) = -zen_d(i, k+1)
-      pde_d(i, klev+1-k) = -zde_d(i, k+1)
-    END DO
-  END DO
-
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      pmflxr(i, klev+2-k) = zmflxr(i, k)
-      pmflxs(i, klev+2-k) = zmflxs(i, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE conflx
-! --------------------------------------------------------------------
-SUBROUTINE flxmain(pdtime, pten, pqen, pqsen, pqhfl, pap, paph, pgeo, ldland, &
-    ptte, pqte, pvervel, prsfc, pssfc, kcbot, kctop, kdtop, & ! *
-                                                              ! ldcum, ktype,
-    pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, dt_con, dq_con, pmflxr, pmflxs)
-  USE dimphy
-  IMPLICIT NONE
-  ! ------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "YOECUMF.h"
-  ! ----------------------------------------------------------------
-  REAL pten(klon, klev), pqen(klon, klev), pqsen(klon, klev)
-  REAL ptte(klon, klev)
-  REAL pqte(klon, klev)
-  REAL pvervel(klon, klev)
-  REAL pgeo(klon, klev), pap(klon, klev), paph(klon, klev+1)
-  REAL pqhfl(klon)
-
-  REAL ptu(klon, klev), pqu(klon, klev), plu(klon, klev)
-  REAL plude(klon, klev)
-  REAL pmfu(klon, klev)
-  REAL prsfc(klon), pssfc(klon)
-  INTEGER kcbot(klon), kctop(klon), ktype(klon)
-  LOGICAL ldland(klon), ldcum(klon)
-
-  REAL ztenh(klon, klev), zqenh(klon, klev), zqsenh(klon, klev)
-  REAL zgeoh(klon, klev)
-  REAL zmfub(klon), zmfub1(klon)
-  REAL zmfus(klon, klev), zmfuq(klon, klev), zmful(klon, klev)
-  REAL zdmfup(klon, klev), zdpmel(klon, klev)
-  REAL zentr(klon), zhcbase(klon)
-  REAL zdqpbl(klon), zdqcv(klon), zdhpbl(klon)
-  REAL zrfl(klon)
-  REAL pmflxr(klon, klev+1)
-  REAL pmflxs(klon, klev+1)
-  INTEGER ilab(klon, klev), ictop0(klon)
-  LOGICAL llo1
-  REAL dt_con(klon, klev), dq_con(klon, klev)
-  REAL zmfmax, zdh
-  REAL pdtime, zqumqe, zdqmin, zalvdcp, zhsat, zzz
-  REAL zhhat, zpbmpt, zgam, zeps, zfac
-  INTEGER i, k, ikb, itopm2, kcum
-
-  REAL pen_u(klon, klev), pde_u(klon, klev)
-  REAL pen_d(klon, klev), pde_d(klon, klev)
-
-  REAL ptd(klon, klev), pqd(klon, klev), pmfd(klon, klev)
-  REAL zmfds(klon, klev), zmfdq(klon, klev), zdmfdp(klon, klev)
-  INTEGER kdtop(klon)
-  LOGICAL lddraf(klon)
-  ! ---------------------------------------------------------------------
-  LOGICAL firstcal
-  SAVE firstcal
-  DATA firstcal/.TRUE./
-  !$OMP THREADPRIVATE(firstcal)
-  ! ---------------------------------------------------------------------
-  IF (firstcal) THEN
-    CALL flxsetup
-    firstcal = .FALSE.
-  END IF
-  ! ---------------------------------------------------------------------
-  DO i = 1, klon
-    ldcum(i) = .FALSE.
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      dt_con(i, k) = 0.0
-      dq_con(i, k) = 0.0
-    END DO
-  END DO
-  ! ----------------------------------------------------------------------
-  ! initialiser les variables et faire l'interpolation verticale
-  ! ----------------------------------------------------------------------
-  CALL flxini(pten, pqen, pqsen, pgeo, paph, zgeoh, ztenh, zqenh, zqsenh, &
-    ptu, pqu, ptd, pqd, pmfd, zmfds, zmfdq, zdmfdp, pmfu, zmfus, zmfuq, &
-    zdmfup, zdpmel, plu, plude, ilab, pen_u, pde_u, pen_d, pde_d)
-  ! ---------------------------------------------------------------------
-  ! determiner les valeurs au niveau de base de la tour convective
-  ! ---------------------------------------------------------------------
-  CALL flxbase(ztenh, zqenh, zgeoh, paph, ptu, pqu, plu, ldcum, kcbot, ilab)
-  ! ---------------------------------------------------------------------
-  ! calculer la convergence totale de l'humidite et celle en provenance
-  ! de la couche limite, plus precisement, la convergence integree entre
-  ! le sol et la base de la convection. Cette derniere convergence est
-  ! comparee avec l'evaporation obtenue dans la couche limite pour
-  ! determiner le type de la convection
-  ! ---------------------------------------------------------------------
-  k = 1
-  DO i = 1, klon
-    zdqcv(i) = pqte(i, k)*(paph(i,k+1)-paph(i,k))
-    zdhpbl(i) = 0.0
-    zdqpbl(i) = 0.0
-  END DO
-
-  DO k = 2, klev
-    DO i = 1, klon
-      zdqcv(i) = zdqcv(i) + pqte(i, k)*(paph(i,k+1)-paph(i,k))
-      IF (k>=kcbot(i)) THEN
-        zdqpbl(i) = zdqpbl(i) + pqte(i, k)*(paph(i,k+1)-paph(i,k))
-        zdhpbl(i) = zdhpbl(i) + (rcpd*ptte(i,k)+rlvtt*pqte(i,k))*(paph(i,k+1) &
-          -paph(i,k))
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ktype(i) = 2
-    IF (zdqcv(i)>max(0.,-1.5*pqhfl(i)*rg)) ktype(i) = 1
-    ! cc         if (zdqcv(i).GT.MAX(0.,-1.1*pqhfl(i)*RG)) ktype(i) = 1
-  END DO
-
-  ! ---------------------------------------------------------------------
-  ! determiner le flux de masse entrant a travers la base.
-  ! on ignore, pour l'instant, l'effet du panache descendant
-  ! ---------------------------------------------------------------------
-  DO i = 1, klon
-    ikb = kcbot(i)
-    zqumqe = pqu(i, ikb) + plu(i, ikb) - zqenh(i, ikb)
-    zdqmin = max(0.01*zqenh(i,ikb), 1.E-10)
-    IF (zdqpbl(i)>0. .AND. zqumqe>zdqmin .AND. ldcum(i)) THEN
-      zmfub(i) = zdqpbl(i)/(rg*max(zqumqe,zdqmin))
-    ELSE
-      zmfub(i) = 0.01
-      ldcum(i) = .FALSE.
-    END IF
-    IF (ktype(i)==2) THEN
-      zdh = rcpd*(ptu(i,ikb)-ztenh(i,ikb)) + rlvtt*zqumqe
-      zdh = rg*max(zdh, 1.0E5*zdqmin)
-      IF (zdhpbl(i)>0. .AND. ldcum(i)) zmfub(i) = zdhpbl(i)/zdh
-    END IF
-    zmfmax = (paph(i,ikb)-paph(i,ikb-1))/(rg*pdtime)
-    zmfub(i) = min(zmfub(i), zmfmax)
-    zentr(i) = entrscv
-    IF (ktype(i)==1) zentr(i) = entrpen
-  END DO
-  ! -----------------------------------------------------------------------
-  ! DETERMINE CLOUD ASCENT FOR ENTRAINING PLUME
-  ! -----------------------------------------------------------------------
-  ! (A) calculer d'abord la hauteur "theorique" de la tour convective sans
-  ! considerer l'entrainement ni le detrainement du panache, sachant
-  ! ces derniers peuvent abaisser la hauteur theorique.
-
-  DO i = 1, klon
-    ikb = kcbot(i)
-    zhcbase(i) = rcpd*ptu(i, ikb) + zgeoh(i, ikb) + rlvtt*pqu(i, ikb)
-    ictop0(i) = kcbot(i) - 1
-  END DO
-
-  zalvdcp = rlvtt/rcpd
-  DO k = klev - 1, 3, -1
-    DO i = 1, klon
-      zhsat = rcpd*ztenh(i, k) + zgeoh(i, k) + rlvtt*zqsenh(i, k)
-      zgam = r5les*zalvdcp*zqsenh(i, k)/((1.-retv*zqsenh(i,k))*(ztenh(i, &
-        k)-r4les)**2)
-      zzz = rcpd*ztenh(i, k)*0.608
-      zhhat = zhsat - (zzz+zgam*zzz)/(1.+zgam*zzz/rlvtt)*max(zqsenh(i,k)- &
-        zqenh(i,k), 0.)
-      IF (k<ictop0(i) .AND. zhcbase(i)>zhhat) ictop0(i) = k
-    END DO
-  END DO
-
-  ! (B) calculer le panache ascendant
-
-  CALL flxasc(pdtime, ztenh, zqenh, pten, pqen, pqsen, pgeo, zgeoh, pap, &
-    paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, pmfu, &
-    zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, kctop, ictop0, &
-    kcum, pen_u, pde_u)
-  IF (kcum==0) GO TO 1000
-
-  ! verifier l'epaisseur de la convection et changer eventuellement
-  ! le taux d'entrainement/detrainement
-
-  DO i = 1, klon
-    zpbmpt = paph(i, kcbot(i)) - paph(i, kctop(i))
-    IF (ldcum(i) .AND. ktype(i)==1 .AND. zpbmpt<2.E4) ktype(i) = 2
-    IF (ldcum(i)) ictop0(i) = kctop(i)
-    IF (ktype(i)==2) zentr(i) = entrscv
-  END DO
-
-  IF (lmfdd) THEN ! si l'on considere le panache descendant
-
-    ! calculer la precipitation issue du panache ascendant pour
-    ! determiner l'existence du panache descendant dans la convection
-    DO i = 1, klon
-      zrfl(i) = zdmfup(i, 1)
-    END DO
-    DO k = 2, klev
-      DO i = 1, klon
-        zrfl(i) = zrfl(i) + zdmfup(i, k)
-      END DO
-    END DO
-
-    ! determiner le LFS (level of free sinking: niveau de plonge libre)
-    CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu, ldcum, kcbot, kctop, &
-      zmfub, zrfl, ptd, pqd, pmfd, zmfds, zmfdq, zdmfdp, kdtop, lddraf)
-
-    ! calculer le panache descendant
-    CALL flxddraf(ztenh, zqenh, zgeoh, paph, zrfl, ptd, pqd, pmfd, zmfds, &
-      zmfdq, zdmfdp, lddraf, pen_d, pde_d)
-
-    ! calculer de nouveau le flux de masse entrant a travers la base
-    ! de la convection, sachant qu'il a ete modifie par le panache
-    ! descendant
-    DO i = 1, klon
-      IF (lddraf(i)) THEN
-        ikb = kcbot(i)
-        llo1 = pmfd(i, ikb) < 0.
-        zeps = 0.
-        IF (llo1) zeps = cmfdeps
-        zqumqe = pqu(i, ikb) + plu(i, ikb) - zeps*pqd(i, ikb) - &
-          (1.-zeps)*zqenh(i, ikb)
-        zdqmin = max(0.01*zqenh(i,ikb), 1.E-10)
-        zmfmax = (paph(i,ikb)-paph(i,ikb-1))/(rg*pdtime)
-        IF (zdqpbl(i)>0. .AND. zqumqe>zdqmin .AND. ldcum(i) .AND. &
-            zmfub(i)<zmfmax) THEN
-          zmfub1(i) = zdqpbl(i)/(rg*max(zqumqe,zdqmin))
-        ELSE
-          zmfub1(i) = zmfub(i)
-        END IF
-        IF (ktype(i)==2) THEN
-          zdh = rcpd*(ptu(i,ikb)-zeps*ptd(i,ikb)-(1.-zeps)*ztenh(i,ikb)) + &
-            rlvtt*zqumqe
-          zdh = rg*max(zdh, 1.0E5*zdqmin)
-          IF (zdhpbl(i)>0. .AND. ldcum(i)) zmfub1(i) = zdhpbl(i)/zdh
-        END IF
-        IF (.NOT. ((ktype(i)==1 .OR. ktype(i)==2) .AND. abs(zmfub1(i)-zmfub(i &
-          ))<0.2*zmfub(i))) zmfub1(i) = zmfub(i)
-      END IF
-    END DO
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (lddraf(i)) THEN
-          zfac = zmfub1(i)/max(zmfub(i), 1.E-10)
-          pmfd(i, k) = pmfd(i, k)*zfac
-          zmfds(i, k) = zmfds(i, k)*zfac
-          zmfdq(i, k) = zmfdq(i, k)*zfac
-          zdmfdp(i, k) = zdmfdp(i, k)*zfac
-          pen_d(i, k) = pen_d(i, k)*zfac
-          pde_d(i, k) = pde_d(i, k)*zfac
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (lddraf(i)) zmfub(i) = zmfub1(i)
-    END DO
-
-  END IF ! fin de test sur lmfdd
-
-  ! -----------------------------------------------------------------------
-  ! calculer de nouveau le panache ascendant
-  ! -----------------------------------------------------------------------
-  CALL flxasc(pdtime, ztenh, zqenh, pten, pqen, pqsen, pgeo, zgeoh, pap, &
-    paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, pmfu, &
-    zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, kctop, ictop0, &
-    kcum, pen_u, pde_u)
-
-  ! -----------------------------------------------------------------------
-  ! determiner les flux convectifs en forme finale, ainsi que
-  ! la quantite des precipitations
-  ! -----------------------------------------------------------------------
-  CALL flxflux(pdtime, pqen, pqsen, ztenh, zqenh, pap, paph, ldland, zgeoh, &
-    kcbot, kctop, lddraf, kdtop, ktype, ldcum, pmfu, pmfd, zmfus, zmfds, &
-    zmfuq, zmfdq, zmful, plude, zdmfup, zdmfdp, pten, prsfc, pssfc, zdpmel, &
-    itopm2, pmflxr, pmflxs)
-
-  ! ----------------------------------------------------------------------
-  ! calculer les tendances pour T et Q
-  ! ----------------------------------------------------------------------
-  CALL flxdtdq(pdtime, itopm2, paph, ldcum, pten, zmfus, zmfds, zmfuq, zmfdq, &
-    zmful, zdmfup, zdmfdp, zdpmel, dt_con, dq_con)
-
-1000 CONTINUE
-  RETURN
-END SUBROUTINE flxmain
-SUBROUTINE flxini(pten, pqen, pqsen, pgeo, paph, pgeoh, ptenh, pqenh, pqsenh, &
-    ptu, pqu, ptd, pqd, pmfd, pmfds, pmfdq, pdmfdp, pmfu, pmfus, pmfuq, &
-    pdmfup, pdpmel, plu, plude, klab, pen_u, pde_u, pen_d, pde_d)
-  USE dimphy
-  IMPLICIT NONE
-  ! ----------------------------------------------------------------------
-  ! THIS ROUTINE INTERPOLATES LARGE-SCALE FIELDS OF T,Q ETC.
-  ! TO HALF LEVELS (I.E. GRID FOR MASSFLUX SCHEME),
-  ! AND INITIALIZES VALUES FOR UPDRAFTS
-  ! ----------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-
-  REAL pten(klon, klev) ! temperature (environnement)
-  REAL pqen(klon, klev) ! humidite (environnement)
-  REAL pqsen(klon, klev) ! humidite saturante (environnement)
-  REAL pgeo(klon, klev) ! geopotentiel (g * metre)
-  REAL pgeoh(klon, klev) ! geopotentiel aux demi-niveaux
-  REAL paph(klon, klev+1) ! pression aux demi-niveaux
-  REAL ptenh(klon, klev) ! temperature aux demi-niveaux
-  REAL pqenh(klon, klev) ! humidite aux demi-niveaux
-  REAL pqsenh(klon, klev) ! humidite saturante aux demi-niveaux
-
-  REAL ptu(klon, klev) ! temperature du panache ascendant (p-a)
-  REAL pqu(klon, klev) ! humidite du p-a
-  REAL plu(klon, klev) ! eau liquide du p-a
-  REAL pmfu(klon, klev) ! flux de masse du p-a
-  REAL pmfus(klon, klev) ! flux de l'energie seche dans le p-a
-  REAL pmfuq(klon, klev) ! flux de l'humidite dans le p-a
-  REAL pdmfup(klon, klev) ! quantite de l'eau precipitee dans p-a
-  REAL plude(klon, klev) ! quantite de l'eau liquide jetee du
-  ! p-a a l'environnement
-  REAL pdpmel(klon, klev) ! quantite de neige fondue
-
-  REAL ptd(klon, klev) ! temperature du panache descendant (p-d)
-  REAL pqd(klon, klev) ! humidite du p-d
-  REAL pmfd(klon, klev) ! flux de masse du p-d
-  REAL pmfds(klon, klev) ! flux de l'energie seche dans le p-d
-  REAL pmfdq(klon, klev) ! flux de l'humidite dans le p-d
-  REAL pdmfdp(klon, klev) ! quantite de precipitation dans p-d
-
-  REAL pen_u(klon, klev) ! quantite de masse entrainee pour p-a
-  REAL pde_u(klon, klev) ! quantite de masse detrainee pour p-a
-  REAL pen_d(klon, klev) ! quantite de masse entrainee pour p-d
-  REAL pde_d(klon, klev) ! quantite de masse detrainee pour p-d
-
-  INTEGER klab(klon, klev)
-  LOGICAL llflag(klon)
-  INTEGER k, i, icall
-  REAL zzs
-  ! ----------------------------------------------------------------------
-  ! SPECIFY LARGE SCALE PARAMETERS AT HALF LEVELS
-  ! ADJUST TEMPERATURE FIELDS IF STATICLY UNSTABLE
-  ! ----------------------------------------------------------------------
-  DO k = 2, klev
-
-    DO i = 1, klon
-      pgeoh(i, k) = pgeo(i, k) + (pgeo(i,k-1)-pgeo(i,k))*0.5
-      ptenh(i, k) = (max(rcpd*pten(i,k-1)+pgeo(i,k-1),rcpd*pten(i,k)+pgeo(i, &
-        k))-pgeoh(i,k))/rcpd
-      pqsenh(i, k) = pqsen(i, k-1)
-      llflag(i) = .TRUE.
-    END DO
-
-    icall = 0
-    CALL flxadjtq(paph(1,k), ptenh(1,k), pqsenh(1,k), llflag, icall)
-
-    DO i = 1, klon
-      pqenh(i, k) = min(pqen(i,k-1), pqsen(i,k-1)) + &
-        (pqsenh(i,k)-pqsen(i,k-1))
-      pqenh(i, k) = max(pqenh(i,k), 0.)
-    END DO
-
-  END DO
-
-  DO i = 1, klon
-    ptenh(i, klev) = (rcpd*pten(i,klev)+pgeo(i,klev)-pgeoh(i,klev))/rcpd
-    pqenh(i, klev) = pqen(i, klev)
-    ptenh(i, 1) = pten(i, 1)
-    pqenh(i, 1) = pqen(i, 1)
-    pgeoh(i, 1) = pgeo(i, 1)
-  END DO
-
-  DO k = klev - 1, 2, -1
-    DO i = 1, klon
-      zzs = max(rcpd*ptenh(i,k)+pgeoh(i,k), rcpd*ptenh(i,k+1)+pgeoh(i,k+1))
-      ptenh(i, k) = (zzs-pgeoh(i,k))/rcpd
-    END DO
-  END DO
-
-  ! -----------------------------------------------------------------------
-  ! INITIALIZE VALUES FOR UPDRAFTS AND DOWNDRAFTS
-  ! -----------------------------------------------------------------------
-  DO k = 1, klev
-    DO i = 1, klon
-      ptu(i, k) = ptenh(i, k)
-      pqu(i, k) = pqenh(i, k)
-      plu(i, k) = 0.
-      pmfu(i, k) = 0.
-      pmfus(i, k) = 0.
-      pmfuq(i, k) = 0.
-      pdmfup(i, k) = 0.
-      pdpmel(i, k) = 0.
-      plude(i, k) = 0.
-
-      klab(i, k) = 0
-
-      ptd(i, k) = ptenh(i, k)
-      pqd(i, k) = pqenh(i, k)
-      pmfd(i, k) = 0.0
-      pmfds(i, k) = 0.0
-      pmfdq(i, k) = 0.0
-      pdmfdp(i, k) = 0.0
-
-      pen_u(i, k) = 0.0
-      pde_u(i, k) = 0.0
-      pen_d(i, k) = 0.0
-      pde_d(i, k) = 0.0
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE flxini
-SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, ptu, pqu, plu, ldcum, kcbot, &
-    klab)
-  USE dimphy
-  IMPLICIT NONE
-  ! ----------------------------------------------------------------------
-  ! THIS ROUTINE CALCULATES CLOUD BASE VALUES (T AND Q)
-
-  ! INPUT ARE ENVIRONM. VALUES OF T,Q,P,PHI AT HALF LEVELS.
-  ! IT RETURNS CLOUD BASE VALUES AND FLAGS AS FOLLOWS;
-  ! klab=1 FOR SUBCLOUD LEVELS
-  ! klab=2 FOR CONDENSATION LEVEL
-
-  ! LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE
-  ! (NON ENTRAINING PLUME,I.E.CONSTANT MASSFLUX)
-  ! ----------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-  ! ----------------------------------------------------------------
-  REAL ptenh(klon, klev), pqenh(klon, klev)
-  REAL pgeoh(klon, klev), paph(klon, klev+1)
-
-  REAL ptu(klon, klev), pqu(klon, klev), plu(klon, klev)
-  INTEGER klab(klon, klev), kcbot(klon)
-
-  LOGICAL llflag(klon), ldcum(klon)
-  INTEGER i, k, icall, is
-  REAL zbuo, zqold(klon)
-  ! ----------------------------------------------------------------------
-  ! INITIALIZE VALUES AT LIFTING LEVEL
-  ! ----------------------------------------------------------------------
-  DO i = 1, klon
-    klab(i, klev) = 1
-    kcbot(i) = klev - 1
-    ldcum(i) = .FALSE.
-  END DO
-  ! ----------------------------------------------------------------------
-  ! DO ASCENT IN SUBCLOUD LAYER,
-  ! CHECK FOR EXISTENCE OF CONDENSATION LEVEL,
-  ! ADJUST T,Q AND L ACCORDINGLY
-  ! CHECK FOR BUOYANCY AND SET FLAGS
-  ! ----------------------------------------------------------------------
-  DO k = klev - 1, 2, -1
-
-    is = 0
-    DO i = 1, klon
-      IF (klab(i,k+1)==1) is = is + 1
-      llflag(i) = .FALSE.
-      IF (klab(i,k+1)==1) llflag(i) = .TRUE.
-    END DO
-    IF (is==0) GO TO 290
-
-    DO i = 1, klon
-      IF (llflag(i)) THEN
-        pqu(i, k) = pqu(i, k+1)
-        ptu(i, k) = ptu(i, k+1) + (pgeoh(i,k+1)-pgeoh(i,k))/rcpd
-        zbuo = ptu(i, k)*(1.+retv*pqu(i,k)) - ptenh(i, k)*(1.+retv*pqenh(i,k) &
-          ) + 0.5
-        IF (zbuo>0.) klab(i, k) = 1
-        zqold(i) = pqu(i, k)
-      END IF
-    END DO
-
-    icall = 1
-    CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall)
-
-    DO i = 1, klon
-      IF (llflag(i) .AND. pqu(i,k)/=zqold(i)) THEN
-        klab(i, k) = 2
-        plu(i, k) = plu(i, k) + zqold(i) - pqu(i, k)
-        zbuo = ptu(i, k)*(1.+retv*pqu(i,k)) - ptenh(i, k)*(1.+retv*pqenh(i,k) &
-          ) + 0.5
-        IF (zbuo>0.) kcbot(i) = k
-        IF (zbuo>0.) ldcum(i) = .TRUE.
-      END IF
-    END DO
-
-290 END DO
-
-  RETURN
-END SUBROUTINE flxbase
-SUBROUTINE flxasc(pdtime, ptenh, pqenh, pten, pqen, pqsen, pgeo, pgeoh, pap, &
-    paph, pqte, pvervel, ldland, ldcum, ktype, klab, ptu, pqu, plu, pmfu, &
-    pmfub, pentr, pmfus, pmfuq, pmful, plude, pdmfup, kcbot, kctop, kctop0, &
-    kcum, pen_u, pde_u)
-  USE dimphy
-  IMPLICIT NONE
-  ! ----------------------------------------------------------------------
-  ! THIS ROUTINE DOES THE CALCULATIONS FOR CLOUD ASCENTS
-  ! FOR CUMULUS PARAMETERIZATION
-  ! ----------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "YOECUMF.h"
-
-  REAL pdtime
-  REAL pten(klon, klev), ptenh(klon, klev)
-  REAL pqen(klon, klev), pqenh(klon, klev), pqsen(klon, klev)
-  REAL pgeo(klon, klev), pgeoh(klon, klev)
-  REAL pap(klon, klev), paph(klon, klev+1)
-  REAL pqte(klon, klev)
-  REAL pvervel(klon, klev) ! vitesse verticale en Pa/s
-
-  REAL pmfub(klon), pentr(klon)
-  REAL ptu(klon, klev), pqu(klon, klev), plu(klon, klev)
-  REAL plude(klon, klev)
-  REAL pmfu(klon, klev), pmfus(klon, klev)
-  REAL pmfuq(klon, klev), pmful(klon, klev)
-  REAL pdmfup(klon, klev)
-  INTEGER ktype(klon), klab(klon, klev), kcbot(klon), kctop(klon)
-  INTEGER kctop0(klon)
-  LOGICAL ldland(klon), ldcum(klon)
-
-  REAL pen_u(klon, klev), pde_u(klon, klev)
-  REAL zqold(klon)
-  REAL zdland(klon)
-  LOGICAL llflag(klon)
-  INTEGER k, i, is, icall, kcum
-  REAL ztglace, zdphi, zqeen, zseen, zscde, zqude
-  REAL zmfusk, zmfuqk, zmfulk, zbuo, zdnoprc, zprcon, zlnew
-
-  REAL zpbot(klon), zptop(klon), zrho(klon)
-  REAL zdprho, zentr, zpmid, zmftest, zmfmax
-  LOGICAL llo1, llo2
-
-  REAL zwmax(klon), zzzmb
-  INTEGER klwmin(klon) ! level of maximum vertical velocity
-  REAL fact
-  ! ----------------------------------------------------------------------
-  ztglace = rtt - 13.
-
-  ! Chercher le niveau ou la vitesse verticale est maximale:
-  DO i = 1, klon
-    klwmin(i) = klev
-    zwmax(i) = 0.0
-  END DO
-  DO k = klev, 3, -1
-    DO i = 1, klon
-      IF (pvervel(i,k)<zwmax(i)) THEN
-        zwmax(i) = pvervel(i, k)
-        klwmin(i) = k
-      END IF
-    END DO
-  END DO
-  ! ----------------------------------------------------------------------
-  ! SET DEFAULT VALUES
-  ! ----------------------------------------------------------------------
-  DO i = 1, klon
-    IF (.NOT. ldcum(i)) ktype(i) = 0
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      plu(i, k) = 0.
-      pmfu(i, k) = 0.
-      pmfus(i, k) = 0.
-      pmfuq(i, k) = 0.
-      pmful(i, k) = 0.
-      plude(i, k) = 0.
-      pdmfup(i, k) = 0.
-      IF (.NOT. ldcum(i) .OR. ktype(i)==3) klab(i, k) = 0
-      IF (.NOT. ldcum(i) .AND. paph(i,k)<4.E4) kctop0(i) = k
-    END DO
-  END DO
-
-  DO i = 1, klon
-    IF (ldland(i)) THEN
-      zdland(i) = 3.0E4
-      zdphi = pgeoh(i, kctop0(i)) - pgeoh(i, kcbot(i))
-      IF (ptu(i,kctop0(i))>=ztglace) zdland(i) = zdphi
-      zdland(i) = max(3.0E4, zdland(i))
-      zdland(i) = min(5.0E4, zdland(i))
-    END IF
-  END DO
-
-  ! Initialiser les valeurs au niveau d'ascendance
-
-  DO i = 1, klon
-    kctop(i) = klev - 1
-    IF (.NOT. ldcum(i)) THEN
-      kcbot(i) = klev - 1
-      pmfub(i) = 0.
-      pqu(i, klev) = 0.
-    END IF
-    pmfu(i, klev) = pmfub(i)
-    pmfus(i, klev) = pmfub(i)*(rcpd*ptu(i,klev)+pgeoh(i,klev))
-    pmfuq(i, klev) = pmfub(i)*pqu(i, klev)
-  END DO
-
-  DO i = 1, klon
-    ldcum(i) = .FALSE.
-  END DO
-  ! ----------------------------------------------------------------------
-  ! DO ASCENT: SUBCLOUD LAYER (klab=1) ,CLOUDS (klab=2)
-  ! BY DOING FIRST DRY-ADIABATIC ASCENT AND THEN
-  ! BY ADJUSTING T,Q AND L ACCORDINGLY IN *flxadjtq*,
-  ! THEN CHECK FOR BUOYANCY AND SET FLAGS ACCORDINGLY
-  ! ----------------------------------------------------------------------
-  DO k = klev - 1, 3, -1
-
-    IF (lmfmid .AND. k<klev-1) THEN
-      DO i = 1, klon
-        IF (.NOT. ldcum(i) .AND. klab(i,k+1)==0 .AND. &
-            pqen(i,k)>0.9*pqsen(i,k) .AND. pap(i,k)/paph(i,klev+1)>0.4) THEN
-          ptu(i, k+1) = pten(i, k) + (pgeo(i,k)-pgeoh(i,k+1))/rcpd
-          pqu(i, k+1) = pqen(i, k)
-          plu(i, k+1) = 0.0
-          zzzmb = max(cmfcmin, -pvervel(i,k)/rg)
-          zmfmax = (paph(i,k)-paph(i,k-1))/(rg*pdtime)
-          pmfub(i) = min(zzzmb, zmfmax)
-          pmfu(i, k+1) = pmfub(i)
-          pmfus(i, k+1) = pmfub(i)*(rcpd*ptu(i,k+1)+pgeoh(i,k+1))
-          pmfuq(i, k+1) = pmfub(i)*pqu(i, k+1)
-          pmful(i, k+1) = 0.0
-          pdmfup(i, k+1) = 0.0
-          kcbot(i) = k
-          klab(i, k+1) = 1
-          ktype(i) = 3
-          pentr(i) = entrmid
-        END IF
-      END DO
-    END IF
-
-    is = 0
-    DO i = 1, klon
-      is = is + klab(i, k+1)
-      IF (klab(i,k+1)==0) klab(i, k) = 0
-      llflag(i) = .FALSE.
-      IF (klab(i,k+1)>0) llflag(i) = .TRUE.
-    END DO
-    IF (is==0) GO TO 480
-
-    ! calculer le taux d'entrainement et de detrainement
-
-    DO i = 1, klon
-      pen_u(i, k) = 0.0
-      pde_u(i, k) = 0.0
-      zrho(i) = paph(i, k+1)/(rd*ptenh(i,k+1))
-      zpbot(i) = paph(i, kcbot(i))
-      zptop(i) = paph(i, kctop0(i))
-    END DO
-
-    DO i = 1, klon
-      IF (ldcum(i)) THEN
-        zdprho = (paph(i,k+1)-paph(i,k))/(rg*zrho(i))
-        zentr = pentr(i)*pmfu(i, k+1)*zdprho
-        llo1 = k < kcbot(i)
-        IF (llo1) pde_u(i, k) = zentr
-        zpmid = 0.5*(zpbot(i)+zptop(i))
-        llo2 = llo1 .AND. ktype(i) == 2 .AND. (zpbot(i)-paph(i,k)<0.2E5 .OR. &
-          paph(i,k)>zpmid)
-        IF (llo2) pen_u(i, k) = zentr
-        llo2 = llo1 .AND. (ktype(i)==1 .OR. ktype(i)==3) .AND. &
-          (k>=max(klwmin(i),kctop0(i)+2) .OR. pap(i,k)>zpmid)
-        IF (llo2) pen_u(i, k) = zentr
-        llo1 = pen_u(i, k) > 0. .AND. (ktype(i)==1 .OR. ktype(i)==2)
-        IF (llo1) THEN
-          fact = 1. + 3.*(1.-min(1.,(zpbot(i)-pap(i,k))/1.5E4))
-          zentr = zentr*fact
-          pen_u(i, k) = pen_u(i, k)*fact
-          pde_u(i, k) = pde_u(i, k)*fact
-        END IF
-        IF (llo2 .AND. pqenh(i,k+1)>1.E-5) pen_u(i, k) = zentr + &
-          max(pqte(i,k), 0.)/pqenh(i, k+1)*zrho(i)*zdprho
-      END IF
-    END DO
-
-    ! ----------------------------------------------------------------------
-    ! DO ADIABATIC ASCENT FOR ENTRAINING/DETRAINING PLUME
-    ! ----------------------------------------------------------------------
-
-    DO i = 1, klon
-      IF (llflag(i)) THEN
-        IF (k<kcbot(i)) THEN
-          zmftest = pmfu(i, k+1) + pen_u(i, k) - pde_u(i, k)
-          zmfmax = min(zmftest, (paph(i,k)-paph(i,k-1))/(rg*pdtime))
-          pen_u(i, k) = max(pen_u(i,k)-max(0.0,zmftest-zmfmax), 0.0)
-        END IF
-        pde_u(i, k) = min(pde_u(i,k), 0.75*pmfu(i,k+1))
-        ! calculer le flux de masse du niveau k a partir de celui du k+1
-        pmfu(i, k) = pmfu(i, k+1) + pen_u(i, k) - pde_u(i, k)
-        ! calculer les valeurs Su, Qu et l du niveau k dans le panache
-        ! montant
-        zqeen = pqenh(i, k+1)*pen_u(i, k)
-        zseen = (rcpd*ptenh(i,k+1)+pgeoh(i,k+1))*pen_u(i, k)
-        zscde = (rcpd*ptu(i,k+1)+pgeoh(i,k+1))*pde_u(i, k)
-        zqude = pqu(i, k+1)*pde_u(i, k)
-        plude(i, k) = plu(i, k+1)*pde_u(i, k)
-        zmfusk = pmfus(i, k+1) + zseen - zscde
-        zmfuqk = pmfuq(i, k+1) + zqeen - zqude
-        zmfulk = pmful(i, k+1) - plude(i, k)
-        plu(i, k) = zmfulk*(1./max(cmfcmin,pmfu(i,k)))
-        pqu(i, k) = zmfuqk*(1./max(cmfcmin,pmfu(i,k)))
-        ptu(i, k) = (zmfusk*(1./max(cmfcmin,pmfu(i,k)))-pgeoh(i,k))/rcpd
-        ptu(i, k) = max(100., ptu(i,k))
-        ptu(i, k) = min(400., ptu(i,k))
-        zqold(i) = pqu(i, k)
-      ELSE
-        zqold(i) = 0.0
-      END IF
-    END DO
-
-    ! ----------------------------------------------------------------------
-    ! DO CORRECTIONS FOR MOIST ASCENT BY ADJUSTING T,Q AND L
-    ! ----------------------------------------------------------------------
-
-    icall = 1
-    CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall)
-
-    DO i = 1, klon
-      IF (llflag(i) .AND. pqu(i,k)/=zqold(i)) THEN
-        klab(i, k) = 2
-        plu(i, k) = plu(i, k) + zqold(i) - pqu(i, k)
-        zbuo = ptu(i, k)*(1.+retv*pqu(i,k)) - ptenh(i, k)*(1.+retv*pqenh(i,k) &
-          )
-        IF (klab(i,k+1)==1) zbuo = zbuo + 0.5
-        IF (zbuo>0. .AND. pmfu(i,k)>=0.1*pmfub(i)) THEN
-          kctop(i) = k
-          ldcum(i) = .TRUE.
-          zdnoprc = 1.5E4
-          IF (ldland(i)) zdnoprc = zdland(i)
-          zprcon = cprcon
-          IF ((zpbot(i)-paph(i,k))<zdnoprc) zprcon = 0.0
-          zlnew = plu(i, k)/(1.+zprcon*(pgeoh(i,k)-pgeoh(i,k+1)))
-          pdmfup(i, k) = max(0., (plu(i,k)-zlnew)*pmfu(i,k))
-          plu(i, k) = zlnew
-        ELSE
-          klab(i, k) = 0
-          pmfu(i, k) = 0.
-        END IF
-      END IF
-    END DO
-    DO i = 1, klon
-      IF (llflag(i)) THEN
-        pmful(i, k) = plu(i, k)*pmfu(i, k)
-        pmfus(i, k) = (rcpd*ptu(i,k)+pgeoh(i,k))*pmfu(i, k)
-        pmfuq(i, k) = pqu(i, k)*pmfu(i, k)
-      END IF
-    END DO
-
-480 END DO
-  ! ----------------------------------------------------------------------
-  ! DETERMINE CONVECTIVE FLUXES ABOVE NON-BUOYANCY LEVEL
-  ! (NOTE: CLOUD VARIABLES LIKE T,Q AND L ARE NOT
-  ! AFFECTED BY DETRAINMENT AND ARE ALREADY KNOWN
-  ! FROM PREVIOUS CALCULATIONS ABOVE)
-  ! ----------------------------------------------------------------------
-  DO i = 1, klon
-    IF (kctop(i)==klev-1) ldcum(i) = .FALSE.
-    kcbot(i) = max(kcbot(i), kctop(i))
-  END DO
-
-  ldcum(1) = ldcum(1)
-
-  is = 0
-  DO i = 1, klon
-    IF (ldcum(i)) is = is + 1
-  END DO
-  kcum = is
-  IF (is==0) GO TO 800
-
-  DO i = 1, klon
-    IF (ldcum(i)) THEN
-      k = kctop(i) - 1
-      pde_u(i, k) = (1.-cmfctop)*pmfu(i, k+1)
-      plude(i, k) = pde_u(i, k)*plu(i, k+1)
-      pmfu(i, k) = pmfu(i, k+1) - pde_u(i, k)
-      zlnew = plu(i, k)
-      pdmfup(i, k) = max(0., (plu(i,k)-zlnew)*pmfu(i,k))
-      plu(i, k) = zlnew
-      pmfus(i, k) = (rcpd*ptu(i,k)+pgeoh(i,k))*pmfu(i, k)
-      pmfuq(i, k) = pqu(i, k)*pmfu(i, k)
-      pmful(i, k) = plu(i, k)*pmfu(i, k)
-      plude(i, k-1) = pmful(i, k)
-    END IF
-  END DO
-
-800 CONTINUE
-  RETURN
-END SUBROUTINE flxasc
-SUBROUTINE flxflux(pdtime, pqen, pqsen, ptenh, pqenh, pap, paph, ldland, &
-    pgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, pmfu, pmfd, pmfus, &
-    pmfds, pmfuq, pmfdq, pmful, plude, pdmfup, pdmfdp, pten, prfl, psfl, &
-    pdpmel, ktopm2, pmflxr, pmflxs)
-  USE dimphy
-  USE print_control_mod, ONLY: prt_level
-  IMPLICIT NONE
-  ! ----------------------------------------------------------------------
-  ! THIS ROUTINE DOES THE FINAL CALCULATION OF CONVECTIVE
-  ! FLUXES IN THE CLOUD LAYER AND IN THE SUBCLOUD LAYER
-  ! ----------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "YOECUMF.h"
-
-  REAL cevapcu(klon, klev)
-  ! -----------------------------------------------------------------
-  REAL pqen(klon, klev), pqenh(klon, klev), pqsen(klon, klev)
-  REAL pten(klon, klev), ptenh(klon, klev)
-  REAL paph(klon, klev+1), pgeoh(klon, klev)
-
-  REAL pap(klon, klev)
-  REAL ztmsmlt, zdelta, zqsat
-
-  REAL pmfu(klon, klev), pmfus(klon, klev)
-  REAL pmfd(klon, klev), pmfds(klon, klev)
-  REAL pmfuq(klon, klev), pmful(klon, klev)
-  REAL pmfdq(klon, klev)
-  REAL plude(klon, klev)
-  REAL pdmfup(klon, klev), pdpmel(klon, klev)
-  ! jq The variable maxpdmfdp(klon) has been introduced by Olivier Boucher
-  ! jq 14/11/00 to fix the problem with the negative precipitation.
-  REAL pdmfdp(klon, klev), maxpdmfdp(klon, klev)
-  REAL prfl(klon), psfl(klon)
-  REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
-  INTEGER kcbot(klon), kctop(klon), ktype(klon)
-  LOGICAL ldland(klon), ldcum(klon)
-  INTEGER k, kp, i
-  REAL zcons1, zcons2, zcucov, ztmelp2
-  REAL pdtime, zdp, zzp, zfac, zsnmlt, zrfl, zrnew
-  REAL zrmin, zrfln, zdrfl
-  REAL zpds, zpdr, zdenom
-  INTEGER ktopm2, itop, ikb
-
-  LOGICAL lddraf(klon)
-  INTEGER kdtop(klon)
-
-  include "FCTTRE.h"
-
-  DO k = 1, klev
-    DO i = 1, klon
-      cevapcu(i, k) = 1.93E-6*261.*sqrt(1.E3/(38.3*0.293)*sqrt(0.5*(paph(i,k) &
-        +paph(i,k+1))/paph(i,klev+1)))*0.5/rg
-    END DO
-  END DO
-
-  ! SPECIFY CONSTANTS
-
-  zcons1 = rcpd/(rlmlt*rg*pdtime)
-  zcons2 = 1./(rg*pdtime)
-  zcucov = 0.05
-  ztmelp2 = rtt + 2.
-
-  ! DETERMINE FINAL CONVECTIVE FLUXES
-
-  itop = klev
-  DO i = 1, klon
-    itop = min(itop, kctop(i))
-    IF (.NOT. ldcum(i) .OR. kdtop(i)<kctop(i)) lddraf(i) = .FALSE.
-    IF (.NOT. ldcum(i)) ktype(i) = 0
-  END DO
-
-  ktopm2 = itop - 2
-  DO k = ktopm2, klev
-    DO i = 1, klon
-      IF (ldcum(i) .AND. k>=kctop(i)-1) THEN
-        pmfus(i, k) = pmfus(i, k) - pmfu(i, k)*(rcpd*ptenh(i,k)+pgeoh(i,k))
-        pmfuq(i, k) = pmfuq(i, k) - pmfu(i, k)*pqenh(i, k)
-        zdp = 1.5E4
-        IF (ldland(i)) zdp = 3.E4
-
-        ! l'eau liquide detrainee est precipitee quand certaines
-        ! conditions sont reunies (sinon, elle est consideree
-        ! evaporee dans l'environnement)
-
-        IF (paph(i,kcbot(i))-paph(i,kctop(i))>=zdp .AND. pqen(i,k-1)>0.8* &
-          pqsen(i,k-1)) pdmfup(i, k-1) = pdmfup(i, k-1) + plude(i, k-1)
-
-        IF (lddraf(i) .AND. k>=kdtop(i)) THEN
-          pmfds(i, k) = pmfds(i, k) - pmfd(i, k)*(rcpd*ptenh(i,k)+pgeoh(i,k))
-          pmfdq(i, k) = pmfdq(i, k) - pmfd(i, k)*pqenh(i, k)
-        ELSE
-          pmfd(i, k) = 0.
-          pmfds(i, k) = 0.
-          pmfdq(i, k) = 0.
-          pdmfdp(i, k-1) = 0.
-        END IF
-      ELSE
-        pmfu(i, k) = 0.
-        pmfus(i, k) = 0.
-        pmfuq(i, k) = 0.
-        pmful(i, k) = 0.
-        pdmfup(i, k-1) = 0.
-        plude(i, k-1) = 0.
-        pmfd(i, k) = 0.
-        pmfds(i, k) = 0.
-        pmfdq(i, k) = 0.
-        pdmfdp(i, k-1) = 0.
-      END IF
-    END DO
-  END DO
-
-  DO k = ktopm2, klev
-    DO i = 1, klon
-      IF (ldcum(i) .AND. k>kcbot(i)) THEN
-        ikb = kcbot(i)
-        zzp = ((paph(i,klev+1)-paph(i,k))/(paph(i,klev+1)-paph(i,ikb)))
-        IF (ktype(i)==3) zzp = zzp**2
-        pmfu(i, k) = pmfu(i, ikb)*zzp
-        pmfus(i, k) = pmfus(i, ikb)*zzp
-        pmfuq(i, k) = pmfuq(i, ikb)*zzp
-        pmful(i, k) = pmful(i, ikb)*zzp
-      END IF
-    END DO
-  END DO
-
-  ! CALCULATE RAIN/SNOW FALL RATES
-  ! CALCULATE MELTING OF SNOW
-  ! CALCULATE EVAPORATION OF PRECIP
-
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      pmflxr(i, k) = 0.0
-      pmflxs(i, k) = 0.0
-    END DO
-  END DO
-  DO k = ktopm2, klev
-    DO i = 1, klon
-      IF (ldcum(i)) THEN
-        IF (pmflxs(i,k)>0.0 .AND. pten(i,k)>ztmelp2) THEN
-          zfac = zcons1*(paph(i,k+1)-paph(i,k))
-          zsnmlt = min(pmflxs(i,k), zfac*(pten(i,k)-ztmelp2))
-          pdpmel(i, k) = zsnmlt
-          ztmsmlt = pten(i, k) - zsnmlt/zfac
-          zdelta = max(0., sign(1.,rtt-ztmsmlt))
-          zqsat = r2es*foeew(ztmsmlt, zdelta)/pap(i, k)
-          zqsat = min(0.5, zqsat)
-          zqsat = zqsat/(1.-retv*zqsat)
-          pqsen(i, k) = zqsat
-        END IF
-        IF (pten(i,k)>rtt) THEN
-          pmflxr(i, k+1) = pmflxr(i, k) + pdmfup(i, k) + pdmfdp(i, k) + &
-            pdpmel(i, k)
-          pmflxs(i, k+1) = pmflxs(i, k) - pdpmel(i, k)
-        ELSE
-          pmflxs(i, k+1) = pmflxs(i, k) + pdmfup(i, k) + pdmfdp(i, k)
-          pmflxr(i, k+1) = pmflxr(i, k)
-        END IF
-        ! si la precipitation est negative, on ajuste le plux du
-        ! panache descendant pour eliminer la negativite
-        IF ((pmflxr(i,k+1)+pmflxs(i,k+1))<0.0) THEN
-          pdmfdp(i, k) = -pmflxr(i, k) - pmflxs(i, k) - pdmfup(i, k)
-          pmflxr(i, k+1) = 0.0
-          pmflxs(i, k+1) = 0.0
-          pdpmel(i, k) = 0.0
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! jq The new variable is initialized here.
-  ! jq It contains the humidity which is fed to the downdraft
-  ! jq by evaporation of precipitation in the column below the base
-  ! jq of convection.
-  ! jq
-  ! jq In the former version, this term has been subtracted from precip
-  ! jq as well as the evaporation.
-  ! jq
-  DO k = 1, klev
-    DO i = 1, klon
-      maxpdmfdp(i, k) = 0.0
-    END DO
-  END DO
-  DO k = 1, klev
-    DO kp = k, klev
-      DO i = 1, klon
-        maxpdmfdp(i, k) = maxpdmfdp(i, k) + pdmfdp(i, kp)
-      END DO
-    END DO
-  END DO
-  ! jq End of initialization
-
-  DO k = ktopm2, klev
-    DO i = 1, klon
-      IF (ldcum(i) .AND. k>=kcbot(i)) THEN
-        zrfl = pmflxr(i, k) + pmflxs(i, k)
-        IF (zrfl>1.0E-20) THEN
-          zrnew = (max(0.,sqrt(zrfl/zcucov)-cevapcu(i, &
-            k)*(paph(i,k+1)-paph(i,k))*max(0.,pqsen(i,k)-pqen(i,k))))**2* &
-            zcucov
-          zrmin = zrfl - zcucov*max(0., 0.8*pqsen(i,k)-pqen(i,k))*zcons2*( &
-            paph(i,k+1)-paph(i,k))
-          zrnew = max(zrnew, zrmin)
-          zrfln = max(zrnew, 0.)
-          zdrfl = min(0., zrfln-zrfl)
-          ! jq At least the amount of precipiation needed to feed the
-          ! downdraft
-          ! jq with humidity below the base of convection has to be left and
-          ! can't
-          ! jq be evaporated (surely the evaporation can't be positive):
-          zdrfl = max(zdrfl, min(-pmflxr(i,k)-pmflxs(i,k)-maxpdmfdp(i, &
-            k),0.0))
-          ! jq End of insertion
-
-          zdenom = 1.0/max(1.0E-20, pmflxr(i,k)+pmflxs(i,k))
-          IF (pten(i,k)>rtt) THEN
-            zpdr = pdmfdp(i, k)
-            zpds = 0.0
-          ELSE
-            zpdr = 0.0
-            zpds = pdmfdp(i, k)
-          END IF
-          pmflxr(i, k+1) = pmflxr(i, k) + zpdr + pdpmel(i, k) + &
-            zdrfl*pmflxr(i, k)*zdenom
-          pmflxs(i, k+1) = pmflxs(i, k) + zpds - pdpmel(i, k) + &
-            zdrfl*pmflxs(i, k)*zdenom
-          pdmfup(i, k) = pdmfup(i, k) + zdrfl
-        ELSE
-          pmflxr(i, k+1) = 0.0
-          pmflxs(i, k+1) = 0.0
-          pdmfdp(i, k) = 0.0
-          pdpmel(i, k) = 0.0
-        END IF
-        IF (pmflxr(i,k)+pmflxs(i,k)<-1.E-26 .AND. prt_level>=1) WRITE (*, *) &
-          'precip. < 1e-16 ', pmflxr(i, k) + pmflxs(i, k)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    prfl(i) = pmflxr(i, klev+1)
-    psfl(i) = pmflxs(i, klev+1)
-  END DO
-
-  RETURN
-END SUBROUTINE flxflux
-SUBROUTINE flxdtdq(pdtime, ktopm2, paph, ldcum, pten, pmfus, pmfds, pmfuq, &
-    pmfdq, pmful, pdmfup, pdmfdp, pdpmel, dt_con, dq_con)
-  USE dimphy
-  IMPLICIT NONE
-  ! ----------------------------------------------------------------------
-  ! calculer les tendances T et Q
-  ! ----------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "YOECUMF.h"
-  ! -----------------------------------------------------------------
-  LOGICAL llo1
-
-  REAL pten(klon, klev), paph(klon, klev+1)
-  REAL pmfus(klon, klev), pmfuq(klon, klev), pmful(klon, klev)
-  REAL pmfds(klon, klev), pmfdq(klon, klev)
-  REAL pdmfup(klon, klev)
-  REAL pdmfdp(klon, klev)
-  REAL pdpmel(klon, klev)
-  LOGICAL ldcum(klon)
-  REAL dt_con(klon, klev), dq_con(klon, klev)
-
-  INTEGER ktopm2
-  REAL pdtime
-
-  INTEGER i, k
-  REAL zalv, zdtdt, zdqdt
-
-  DO k = ktopm2, klev - 1
-    DO i = 1, klon
-      IF (ldcum(i)) THEN
-        llo1 = (pten(i,k)-rtt) > 0.
-        zalv = rlstt
-        IF (llo1) zalv = rlvtt
-        zdtdt = rg/(paph(i,k+1)-paph(i,k))/rcpd*(pmfus(i,k+1)-pmfus(i,k)+ &
-          pmfds(i,k+1)-pmfds(i,k)-rlmlt*pdpmel(i,k)-zalv*(pmful(i, &
-          k+1)-pmful(i,k)-pdmfup(i,k)-pdmfdp(i,k)))
-        dt_con(i, k) = zdtdt
-        zdqdt = rg/(paph(i,k+1)-paph(i,k))*(pmfuq(i,k+1)-pmfuq(i,k)+pmfdq(i,k &
-          +1)-pmfdq(i,k)+pmful(i,k+1)-pmful(i,k)-pdmfup(i,k)-pdmfdp(i,k))
-        dq_con(i, k) = zdqdt
-      END IF
-    END DO
-  END DO
-
-  k = klev
-  DO i = 1, klon
-    IF (ldcum(i)) THEN
-      llo1 = (pten(i,k)-rtt) > 0.
-      zalv = rlstt
-      IF (llo1) zalv = rlvtt
-      zdtdt = -rg/(paph(i,k+1)-paph(i,k))/rcpd*(pmfus(i,k)+pmfds(i,k)+rlmlt* &
-        pdpmel(i,k)-zalv*(pmful(i,k)+pdmfup(i,k)+pdmfdp(i,k)))
-      dt_con(i, k) = zdtdt
-      zdqdt = -rg/(paph(i,k+1)-paph(i,k))*(pmfuq(i,k)+pmfdq(i,k)+pmful(i,k)+ &
-        pdmfup(i,k)+pdmfdp(i,k))
-      dq_con(i, k) = zdqdt
-    END IF
-  END DO
-
-  RETURN
-END SUBROUTINE flxdtdq
-SUBROUTINE flxdlfs(ptenh, pqenh, pgeoh, paph, ptu, pqu, ldcum, kcbot, kctop, &
-    pmfub, prfl, ptd, pqd, pmfd, pmfds, pmfdq, pdmfdp, kdtop, lddraf)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! ----------------------------------------------------------------------
-  ! THIS ROUTINE CALCULATES LEVEL OF FREE SINKING FOR
-  ! CUMULUS DOWNDRAFTS AND SPECIFIES T,Q,U AND V VALUES
-
-  ! TO PRODUCE LFS-VALUES FOR CUMULUS DOWNDRAFTS
-  ! FOR MASSFLUX CUMULUS PARAMETERIZATION
-
-  ! INPUT ARE ENVIRONMENTAL VALUES OF T,Q,U,V,P,PHI
-  ! AND UPDRAFT VALUES T,Q,U AND V AND ALSO
-  ! CLOUD BASE MASSFLUX AND CU-PRECIPITATION RATE.
-  ! IT RETURNS T,Q,U AND V VALUES AND MASSFLUX AT LFS.
-
-  ! CHECK FOR NEGATIVE BUOYANCY OF AIR OF EQUAL PARTS OF
-  ! MOIST ENVIRONMENTAL AIR AND CLOUD AIR.
-  ! ----------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "YOECUMF.h"
-
-  REAL ptenh(klon, klev)
-  REAL pqenh(klon, klev)
-  REAL pgeoh(klon, klev), paph(klon, klev+1)
-  REAL ptu(klon, klev), pqu(klon, klev)
-  REAL pmfub(klon)
-  REAL prfl(klon)
-
-  REAL ptd(klon, klev), pqd(klon, klev)
-  REAL pmfd(klon, klev), pmfds(klon, klev), pmfdq(klon, klev)
-  REAL pdmfdp(klon, klev)
-  INTEGER kcbot(klon), kctop(klon), kdtop(klon)
-  LOGICAL ldcum(klon), lddraf(klon)
-
-  REAL ztenwb(klon, klev), zqenwb(klon, klev), zcond(klon)
-  REAL zttest, zqtest, zbuo, zmftop
-  LOGICAL llo2(klon)
-  INTEGER i, k, is, icall
-  ! ----------------------------------------------------------------------
-  DO i = 1, klon
-    lddraf(i) = .FALSE.
-    kdtop(i) = klev + 1
-  END DO
-
-  ! ----------------------------------------------------------------------
-  ! DETERMINE LEVEL OF FREE SINKING BY
-  ! DOING A SCAN FROM TOP TO BASE OF CUMULUS CLOUDS
-
-  ! FOR EVERY POINT AND PROCEED AS FOLLOWS:
-  ! (1) DETEMINE WET BULB ENVIRONMENTAL T AND Q
-  ! (2) DO MIXING WITH CUMULUS CLOUD AIR
-  ! (3) CHECK FOR NEGATIVE BUOYANCY
-
-  ! THE ASSUMPTION IS THAT AIR OF DOWNDRAFTS IS MIXTURE
-  ! OF 50% CLOUD AIR + 50% ENVIRONMENTAL AIR AT WET BULB
-  ! TEMPERATURE (I.E. WHICH BECAME SATURATED DUE TO
-  ! EVAPORATION OF RAIN AND CLOUD WATER)
-  ! ----------------------------------------------------------------------
-
-  DO k = 3, klev - 3
-
-    is = 0
-    DO i = 1, klon
-      ztenwb(i, k) = ptenh(i, k)
-      zqenwb(i, k) = pqenh(i, k)
-      llo2(i) = ldcum(i) .AND. prfl(i) > 0. .AND. .NOT. lddraf(i) .AND. &
-        (k<kcbot(i) .AND. k>kctop(i))
-      IF (llo2(i)) is = is + 1
-    END DO
-    IF (is==0) GO TO 290
-
-    icall = 2
-    CALL flxadjtq(paph(1,k), ztenwb(1,k), zqenwb(1,k), llo2, icall)
-
-    ! ----------------------------------------------------------------------
-    ! DO MIXING OF CUMULUS AND ENVIRONMENTAL AIR
-    ! AND CHECK FOR NEGATIVE BUOYANCY.
-    ! THEN SET VALUES FOR DOWNDRAFT AT LFS.
-    ! ----------------------------------------------------------------------
-    DO i = 1, klon
-      IF (llo2(i)) THEN
-        zttest = 0.5*(ptu(i,k)+ztenwb(i,k))
-        zqtest = 0.5*(pqu(i,k)+zqenwb(i,k))
-        zbuo = zttest*(1.+retv*zqtest) - ptenh(i, k)*(1.+retv*pqenh(i,k))
-        zcond(i) = pqenh(i, k) - zqenwb(i, k)
-        zmftop = -cmfdeps*pmfub(i)
-        IF (zbuo<0. .AND. prfl(i)>10.*zmftop*zcond(i)) THEN
-          kdtop(i) = k
-          lddraf(i) = .TRUE.
-          ptd(i, k) = zttest
-          pqd(i, k) = zqtest
-          pmfd(i, k) = zmftop
-          pmfds(i, k) = pmfd(i, k)*(rcpd*ptd(i,k)+pgeoh(i,k))
-          pmfdq(i, k) = pmfd(i, k)*pqd(i, k)
-          pdmfdp(i, k-1) = -0.5*pmfd(i, k)*zcond(i)
-          prfl(i) = prfl(i) + pdmfdp(i, k-1)
-        END IF
-      END IF
-    END DO
-
-290 END DO
-
-  RETURN
-END SUBROUTINE flxdlfs
-SUBROUTINE flxddraf(ptenh, pqenh, pgeoh, paph, prfl, ptd, pqd, pmfd, pmfds, &
-    pmfdq, pdmfdp, lddraf, pen_d, pde_d)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! ----------------------------------------------------------------------
-  ! THIS ROUTINE CALCULATES CUMULUS DOWNDRAFT DESCENT
-
-  ! TO PRODUCE THE VERTICAL PROFILES FOR CUMULUS DOWNDRAFTS
-  ! (I.E. T,Q,U AND V AND FLUXES)
-
-  ! INPUT IS T,Q,P,PHI,U,V AT HALF LEVELS.
-  ! IT RETURNS FLUXES OF S,Q AND EVAPORATION RATE
-  ! AND U,V AT LEVELS WHERE DOWNDRAFT OCCURS
-
-  ! CALCULATE MOIST DESCENT FOR ENTRAINING/DETRAINING PLUME BY
-  ! A) MOVING AIR DRY-ADIABATICALLY TO NEXT LEVEL BELOW AND
-  ! B) CORRECTING FOR EVAPORATION TO OBTAIN SATURATED STATE.
-
-  ! ----------------------------------------------------------------------
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "YOECUMF.h"
-
-  REAL ptenh(klon, klev), pqenh(klon, klev)
-  REAL pgeoh(klon, klev), paph(klon, klev+1)
-
-  REAL ptd(klon, klev), pqd(klon, klev)
-  REAL pmfd(klon, klev), pmfds(klon, klev), pmfdq(klon, klev)
-  REAL pdmfdp(klon, klev)
-  REAL prfl(klon)
-  LOGICAL lddraf(klon)
-
-  REAL pen_d(klon, klev), pde_d(klon, klev), zcond(klon)
-  LOGICAL llo2(klon), llo1
-  INTEGER i, k, is, icall, itopde
-  REAL zentr, zseen, zqeen, zsdde, zqdde, zmfdsk, zmfdqk, zdmfdp
-  REAL zbuo
-  ! ----------------------------------------------------------------------
-  ! CALCULATE MOIST DESCENT FOR CUMULUS DOWNDRAFT BY
-  ! (A) CALCULATING ENTRAINMENT RATES, ASSUMING
-  ! LINEAR DECREASE OF MASSFLUX IN PBL
-  ! (B) DOING MOIST DESCENT - EVAPORATIVE COOLING
-  ! AND MOISTENING IS CALCULATED IN *flxadjtq*
-  ! (C) CHECKING FOR NEGATIVE BUOYANCY AND
-  ! SPECIFYING FINAL T,Q,U,V AND DOWNWARD FLUXES
-
-  DO k = 3, klev
-
-    is = 0
-    DO i = 1, klon
-      llo2(i) = lddraf(i) .AND. pmfd(i, k-1) < 0.
-      IF (llo2(i)) is = is + 1
-    END DO
-    IF (is==0) GO TO 180
-
-    DO i = 1, klon
-      IF (llo2(i)) THEN
-        zentr = entrdd*pmfd(i, k-1)*rd*ptenh(i, k-1)/(rg*paph(i,k-1))* &
-          (paph(i,k)-paph(i,k-1))
-        pen_d(i, k) = zentr
-        pde_d(i, k) = zentr
-      END IF
-    END DO
-
-    itopde = klev - 2
-    IF (k>itopde) THEN
-      DO i = 1, klon
-        IF (llo2(i)) THEN
-          pen_d(i, k) = 0.
-          pde_d(i, k) = pmfd(i, itopde)*(paph(i,k)-paph(i,k-1))/ &
-            (paph(i,klev+1)-paph(i,itopde))
-        END IF
-      END DO
-    END IF
-
-    DO i = 1, klon
-      IF (llo2(i)) THEN
-        pmfd(i, k) = pmfd(i, k-1) + pen_d(i, k) - pde_d(i, k)
-        zseen = (rcpd*ptenh(i,k-1)+pgeoh(i,k-1))*pen_d(i, k)
-        zqeen = pqenh(i, k-1)*pen_d(i, k)
-        zsdde = (rcpd*ptd(i,k-1)+pgeoh(i,k-1))*pde_d(i, k)
-        zqdde = pqd(i, k-1)*pde_d(i, k)
-        zmfdsk = pmfds(i, k-1) + zseen - zsdde
-        zmfdqk = pmfdq(i, k-1) + zqeen - zqdde
-        pqd(i, k) = zmfdqk*(1./min(-cmfcmin,pmfd(i,k)))
-        ptd(i, k) = (zmfdsk*(1./min(-cmfcmin,pmfd(i,k)))-pgeoh(i,k))/rcpd
-        ptd(i, k) = min(400., ptd(i,k))
-        ptd(i, k) = max(100., ptd(i,k))
-        zcond(i) = pqd(i, k)
-      END IF
-    END DO
-
-    icall = 2
-    CALL flxadjtq(paph(1,k), ptd(1,k), pqd(1,k), llo2, icall)
-
-    DO i = 1, klon
-      IF (llo2(i)) THEN
-        zcond(i) = zcond(i) - pqd(i, k)
-        zbuo = ptd(i, k)*(1.+retv*pqd(i,k)) - ptenh(i, k)*(1.+retv*pqenh(i,k) &
-          )
-        llo1 = zbuo < 0. .AND. (prfl(i)-pmfd(i,k)*zcond(i)>0.)
-        IF (.NOT. llo1) pmfd(i, k) = 0.0
-        pmfds(i, k) = (rcpd*ptd(i,k)+pgeoh(i,k))*pmfd(i, k)
-        pmfdq(i, k) = pqd(i, k)*pmfd(i, k)
-        zdmfdp = -pmfd(i, k)*zcond(i)
-        pdmfdp(i, k-1) = zdmfdp
-        prfl(i) = prfl(i) + zdmfdp
-      END IF
-    END DO
-
-180 END DO
-  RETURN
-END SUBROUTINE flxddraf
-SUBROUTINE flxadjtq(pp, pt, pq, ldflag, kcall)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Objet: ajustement entre T et Q
-  ! ======================================================================
-  ! NOTE: INPUT PARAMETER kcall DEFINES CALCULATION AS
-  ! kcall=0    ENV. T AND QS IN*CUINI*
-  ! kcall=1  CONDENSATION IN UPDRAFTS  (E.G. CUBASE, CUASC)
-  ! kcall=2  EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF)
-
-  include "YOMCST.h"
-
-  REAL pt(klon), pq(klon), pp(klon)
-  LOGICAL ldflag(klon)
-  INTEGER kcall
-
-  REAL zcond(klon), zcond1
-  REAL z5alvcp, z5alscp, zalvdcp, zalsdcp
-  REAL zdelta, zcvm5, zldcp, zqsat, zcor
-  INTEGER is, i
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  z5alvcp = r5les*rlvtt/rcpd
-  z5alscp = r5ies*rlstt/rcpd
-  zalvdcp = rlvtt/rcpd
-  zalsdcp = rlstt/rcpd
-
-
-  DO i = 1, klon
-    zcond(i) = 0.0
-  END DO
-
-  DO i = 1, klon
-    IF (ldflag(i)) THEN
-      zdelta = max(0., sign(1.,rtt-pt(i)))
-      zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
-      zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
-      zqsat = r2es*foeew(pt(i), zdelta)/pp(i)
-      zqsat = min(0.5, zqsat)
-      zcor = 1./(1.-retv*zqsat)
-      zqsat = zqsat*zcor
-      zcond(i) = (pq(i)-zqsat)/(1.+foede(pt(i),zdelta,zcvm5,zqsat,zcor))
-      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)
-      pq(i) = pq(i) - zcond(i)
-    END IF
-  END DO
-
-  is = 0
-  DO i = 1, klon
-    IF (zcond(i)/=0.) is = is + 1
-  END DO
-  IF (is==0) GO TO 230
-
-  DO i = 1, klon
-    IF (ldflag(i) .AND. zcond(i)/=0.) THEN
-      zdelta = max(0., sign(1.,rtt-pt(i)))
-      zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
-      zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
-      zqsat = r2es*foeew(pt(i), zdelta)/pp(i)
-      zqsat = min(0.5, zqsat)
-      zcor = 1./(1.-retv*zqsat)
-      zqsat = zqsat*zcor
-      zcond1 = (pq(i)-zqsat)/(1.+foede(pt(i),zdelta,zcvm5,zqsat,zcor))
-      pt(i) = pt(i) + zldcp*zcond1
-      pq(i) = pq(i) - zcond1
-    END IF
-  END DO
-
-230 CONTINUE
-  RETURN
-END SUBROUTINE flxadjtq
-SUBROUTINE flxsetup
-  IMPLICIT NONE
-
-  ! THIS ROUTINE DEFINES DISPOSABLE PARAMETERS FOR MASSFLUX SCHEME
-
-  include "YOECUMF.h"
-
-  entrpen = 1.0E-4 ! ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
-  entrscv = 3.0E-4 ! ENTRAINMENT RATE FOR SHALLOW CONVECTION
-  entrmid = 1.0E-4 ! ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
-  entrdd = 2.0E-4 ! ENTRAINMENT RATE FOR DOWNDRAFTS
-  cmfctop = 0.33 ! RELATIVE CLOUD MASSFLUX AT LEVEL ABOVE NONBUO LEVEL
-  cmfcmax = 1.0 ! MAXIMUM MASSFLUX VALUE ALLOWED FOR UPDRAFTS ETC
-  cmfcmin = 1.E-10 ! MINIMUM MASSFLUX VALUE (FOR SAFETY)
-  cmfdeps = 0.3 ! FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
-  cprcon = 2.0E-4 ! CONVERSION FROM CLOUD WATER TO RAIN
-  rhcdd = 1. ! RELATIVE SATURATION IN DOWNDRAFRS (NO LONGER USED)
-  ! (FORMULATION IMPLIES SATURATION)
-  lmfpen = .TRUE.
-  lmfscv = .TRUE.
-  lmfmid = .TRUE.
-  lmfdd = .TRUE.
-  lmfdudv = .TRUE.
-
-  RETURN
-END SUBROUTINE flxsetup
+link ../phylmd/conflx.F90
Index: LMDZ6/trunk/libf/phylmdiso/conlmd.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/conlmd.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/conlmd.F90	(revision 3940)
@@ -1,2250 +1,1 @@
-
-! $Header$
-
-SUBROUTINE conlmd(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, rain, snow, &
-    ibas, itop)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-  ! Objet: Schema de convection utilis'e dans le modele du LMD
-  ! Ajustement humide (Manabe) + Ajustement convectif (Kuo)
-  ! ======================================================================
-  include "YOMCST.h"
-  include "YOETHF.h"
-
-  ! Arguments:
-
-  REAL dtime ! pas d'integration (s)
-  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)
-  REAL q(klon, klev) ! humidite specifique (kg/kg)
-  REAL conv_q(klon, klev) ! taux de convergence humidite (g/g/s)
-
-  REAL d_t(klon, klev) ! incrementation temperature
-  REAL d_q(klon, klev) ! incrementation humidite
-  REAL rain(klon) ! pluies (mm/s)
-  REAL snow(klon) ! neige (mm/s)
-  INTEGER ibas(klon) ! niveau du bas
-  INTEGER itop(klon) ! niveau du haut
-
-  LOGICAL usekuo ! utiliser convection profonde (schema Kuo)
-  PARAMETER (usekuo=.TRUE.)
-
-  REAL d_t_bis(klon, klev)
-  REAL d_q_bis(klon, klev)
-  REAL rain_bis(klon)
-  REAL snow_bis(klon)
-  INTEGER ibas_bis(klon)
-  INTEGER itop_bis(klon)
-  REAL d_ql(klon, klev), d_ql_bis(klon, klev)
-  REAL rneb(klon, klev), rneb_bis(klon, klev)
-
-  INTEGER i, k
-  REAL zlvdcp, zlsdcp, zdelta, zz, za, zb
-
-  ! 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)
-
-  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)
-    DO k = 1, klev
-      DO i = 1, klon
-        d_t(i, k) = d_t(i, k) + d_t_bis(i, k)
-        d_q(i, k) = d_q(i, k) + d_q_bis(i, k)
-        d_ql(i, k) = d_ql(i, k) + d_ql_bis(i, k)
-      END DO
-    END DO
-    DO i = 1, klon
-      rain(i) = rain(i) + rain_bis(i)
-      snow(i) = snow(i) + snow_bis(i)
-      ibas(i) = min(ibas(i), ibas_bis(i))
-      itop(i) = max(itop(i), itop_bis(i))
-    END DO
-  END IF
-
-  ! L'eau liquide convective est dispersee dans l'air:
-
-  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)))
-      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)
-      d_t(i, k) = d_t(i, k) + za
-      d_q(i, k) = d_q(i, k) + zb
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE conlmd
-SUBROUTINE conman(dtime, paprs, pplay, t, q, d_t, d_q, d_ql, rneb, rain, &
-    snow, ibas, itop)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19970324
-  ! Objet: ajustement humide convectif avec la possibilite de faire
-  ! l'ajustement sur une fraction de la maille.
-  ! Methode: On impose une distribution uniforme pour la vapeur d'eau
-  ! au sein d'une maille. On applique la procedure d'ajustement
-  ! successivement a la totalite, 75%, 50%, 25% et 5% de la maille
-  ! jusqu'a ce que l'ajustement a lieu. J'espere que ceci augmente
-  ! les activites convectives et corrige le biais "trop froid et sec"
-  ! du modele.
-  ! ======================================================================
-  include "YOMCST.h"
-
-  REAL dtime ! pas d'integration (s)
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! humidite specifique (kg/kg)
-  REAL paprs(klon, klev+1) ! pression inter-couche (Pa)
-  REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
-
-  REAL d_t(klon, klev) ! incrementation temperature
-  REAL d_q(klon, klev) ! incrementation humidite
-  REAL d_ql(klon, klev) ! incrementation eau liquide
-  REAL rneb(klon, klev) ! nebulosite
-  REAL rain(klon) ! pluies (mm/s)
-  REAL snow(klon) ! neige (mm/s)
-  INTEGER ibas(klon) ! niveau du bas
-  INTEGER itop(klon) ! niveau du haut
-
-  LOGICAL afaire(klon) ! .TRUE. implique l'ajustement
-  LOGICAL accompli(klon) ! .TRUE. si l'ajustement est effectif
-
-  INTEGER nb ! nombre de sous-fractions a considere
-  PARAMETER (nb=1)
-  ! cc      PARAMETER (nb=3)
-
-  REAL ratqs ! largeur de la distribution pour vapeur d'eau
-  PARAMETER (ratqs=0.05)
-
-  REAL w_q(klon, klev)
-  REAL w_d_t(klon, klev), w_d_q(klon, klev), w_d_ql(klon, klev)
-  REAL w_rneb(klon, klev)
-  REAL w_rain(klon), w_snow(klon)
-  INTEGER w_ibas(klon), w_itop(klon)
-  REAL zq1, zq2
-  INTEGER i, k, n
-
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-  REAL zdp1, zdp2
-  REAL zqs1, zqs2, zdqs1, zdqs2
-  REAL zgamdz
-  REAL zflo ! flotabilite
-  REAL zsat ! sur-saturation
-  REAL zdelta, zcor, zcvm5
-  LOGICAL imprim
-
-  INTEGER ncpt
-  SAVE ncpt
-  !$OMP THREADPRIVATE(ncpt)
-  REAL frac(nb) ! valeur de la maille fractionnelle
-  SAVE frac
-  !$OMP THREADPRIVATE(frac)
-  INTEGER opt_cld(nb) ! option pour le modele nuageux
-  SAVE opt_cld
-  !$OMP THREADPRIVATE(opt_cld)
-  LOGICAL appel1er
-  SAVE appel1er
-  !$OMP THREADPRIVATE(appel1er)
-
-  ! Fonctions thermodynamiques:
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  DATA frac/1.0/
-  DATA opt_cld/4/
-  ! cc      DATA frac    / 1.0, 0.50, 0.25/
-  ! cc      DATA opt_cld / 4,   4,    4/
-
-  DATA appel1er/.TRUE./
-  DATA ncpt/0/
-
-  IF (appel1er) THEN
-    PRINT *, 'conman, nb:', nb
-    PRINT *, 'conman, frac:', frac
-    PRINT *, 'conman, opt_cld:', opt_cld
-    appel1er = .FALSE.
-  END IF
-
-  ! Initialiser les sorties a zero:
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_q(i, k) = 0.0
-      d_ql(i, k) = 0.0
-      rneb(i, k) = 0.0
-    END DO
-  END DO
-  DO i = 1, klon
-    ibas(i) = klev
-    itop(i) = 1
-    rain(i) = 0.0
-    snow(i) = 0.0
-  END DO
-
-  ! S'il n'y a pas d'instabilite conditionnelle,
-  ! pas la penne de se fatiguer:
-
-  DO i = 1, klon
-    afaire(i) = .FALSE.
-  END DO
-  DO k = 1, klev - 1
-    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)
-        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)
-        zqs2 = min(0.5, zqs2)
-        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)
-        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
-      IF (zflo>0.0) afaire(i) = .TRUE.
-      ! erreur         IF (zflo.GT.0.0 .AND. zsat.GT.0.0) afaire(i) = .TRUE.
-    END DO
-  END DO
-
-  imprim = mod(ncpt, 48) == 0
-  DO n = 1, nb
-
-    DO k = 1, klev
-      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)
-        END IF
-      END DO
-    END DO
-
-    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)
-    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)
-        END IF
-      END DO
-    END DO
-    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)
-        ibas(i) = min(ibas(i), w_ibas(i))
-        itop(i) = max(itop(i), w_itop(i))
-      END IF
-    END DO
-    DO i = 1, klon
-      IF (afaire(i) .AND. accompli(i)) afaire(i) = .FALSE.
-    END DO
-
-  END DO
-
-  ncpt = ncpt + 1
-
-  RETURN
-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)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-  ! Objet: ajustement humide (convection proposee par Manabe).
-  ! Pour une colonne verticale, il peut avoir plusieurs blocs
-  ! necessitant l'ajustement. ibas est le bas du plus bas bloc
-  ! et itop est le haut du plus haut bloc
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! Arguments:
-
-  REAL dtime ! pas d'integration (s)
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! humidite specifique (kg/kg)
-  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
-  LOGICAL afaire(klon) ! .TRUE. si le point est a faire (Input)
-  LOGICAL imprim ! .T. pour imprimer quelques diagnostiques
-
-  REAL d_t(klon, klev) ! incrementation temperature
-  REAL d_q(klon, klev) ! incrementation humidite
-  REAL d_ql(klon, klev) ! incrementation eau liquide
-  REAL rneb(klon, klev) ! nebulosite
-  REAL rain(klon) ! pluies (mm/s)
-  REAL snow(klon) ! neige (mm/s)
-  INTEGER ibas(klon) ! niveau du bas
-  INTEGER itop(klon) ! niveau du haut
-  LOGICAL accompli(klon) ! .TRUE. si l'ajustement a eu lieu (Output)
-
-  ! Quelques options:
-
-  LOGICAL new_top ! re-calculer sommet quand re-ajustement est fait
-  PARAMETER (new_top=.FALSE.)
-  LOGICAL evap_prec ! evaporation de pluie au-dessous de convection
-  PARAMETER (evap_prec=.TRUE.)
-  REAL coef_eva
-  PARAMETER (coef_eva=1.0E-05)
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-  REAL seuil_vap
-  PARAMETER (seuil_vap=1.0E-10)
-  LOGICAL old_tau ! implique precip nulle, si vrai.
-  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)
-  REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-  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)
-  LOGICAL exigent ! implique un calcul supplementaire pour Qs
-  PARAMETER (exigent=.FALSE.)
-
-  INTEGER kbase
-  PARAMETER (kbase=0)
-
-  ! Variables locales:
-
-  INTEGER nexpo
-  INTEGER i, k, k1min, k1max, k2min, k2max, is
-  REAL zgamdz(klon, klev-1)
-  REAL zt(klon, klev), zq(klon, klev)
-  REAL zqs(klon, klev), zdqs(klon, klev)
-  REAL zqmqsdp(klon, klev)
-  REAL ztnew(klon, klev), zqnew(klon, klev)
-  REAL zcond(klon), zvapo(klon), zrapp(klon)
-  REAL zrfl(klon), zrfln, zqev, zqevt
-  REAL zsat(klon) ! sur-saturation
-  REAL zflo(klon) ! flotabilite
-  REAL za(klon), zb(klon), zc(klon)
-  INTEGER k1(klon), k2(klon)
-  REAL zdelta, zcor, zcvm5
-  REAL delp(klon, klev)
-  LOGICAL possible(klon), todo(klon), etendre(klon)
-  LOGICAL aller(klon), todobis(klon)
-  REAL zalfa
-  INTEGER nbtodo, nbdone
-
-  ! 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)
-    END DO
-  END DO
-
-  ! Initialiser les sorties a zero
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_q(i, k) = 0.0
-      d_ql(i, k) = 0.0
-      rneb(i, k) = 0.0
-    END DO
-  END DO
-  DO i = 1, klon
-    ibas(i) = klev
-    itop(i) = 1
-    rain(i) = 0.0
-    snow(i) = 0.0
-    accompli(i) = .FALSE.
-  END DO
-
-  ! Preparations
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (afaire(i)) THEN
-        zt(i, k) = t(i, k)
-        zq(i, k) = q(i, k)
-
-        ! Calculer Qs et L/Cp*dQs/dT
-
-        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)
-        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))
-          ELSE
-            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)
-      END IF
-    END DO
-  END DO
-
-  ! -----zgama is the moist convective lapse rate (-dT/dz).
-  ! -----zgamdz(*,k) est la difference minimale autorisee des temperatures
-  ! -----entre deux couches (k et k+1), c.a.d. si T(k+1)-T(k) est inferieur
-  ! -----a zgamdz(*,k), alors ces 2 couches sont instables conditionnellement
-
-  DO k = 1, klev - 1
-    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)))
-      END IF
-    END DO
-  END DO
-
-  ! On cherche la presence simultanee d'instabilite conditionnelle
-  ! et de sur-saturation. Sinon, pas la penne de se fatiguer:
-
-  DO i = 1, klon
-    possible(i) = .FALSE.
-  END DO
-  DO k = 2, klev
-    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)
-        IF (zflo(i)>0.0 .AND. zsat(i)>0.0) possible(i) = .TRUE.
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    IF (possible(i)) THEN
-      k1(i) = kbase
-      k2(i) = k1(i) + 1
-    END IF
-  END DO
-
-810 CONTINUE ! chercher le bas de la colonne a ajuster
-
-  k2min = klev
-  DO i = 1, klon
-    todo(i) = .FALSE.
-    aller(i) = .TRUE.
-    IF (possible(i)) k2min = min(k2min, k2(i))
-  END DO
-  IF (k2min==klev) GO TO 860
-  DO k = k2min, klev - 1
-    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)
-        IF (zflo(i)>0.0 .AND. zsat(i)>0.0) THEN
-          k1(i) = k
-          k2(i) = k + 1
-          todo(i) = .TRUE.
-          aller(i) = .FALSE.
-        END IF
-      END IF
-    END DO
-  END DO
-  DO i = 1, klon
-    IF (possible(i) .AND. aller(i)) THEN
-      todo(i) = .FALSE.
-      k1(i) = klev
-      k2(i) = klev
-    END IF
-  END DO
-
-  ! CC      DO i = 1, klon
-  ! CC      IF (possible(i)) THEN
-  ! CC  811    k2(i) = k2(i) + 1
-  ! CC         IF (k2(i) .GT. klev) THEN
-  ! CC            todo(i) = .FALSE.
-  ! CC            GOTO 812
-  ! CC         ENDIF
-  ! CC         k = k2(i)
-  ! CC         zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-  ! CC         zsat(i) = zqmqsdp(i,k) + zqmqsdp(i,k-1)
-  ! CC         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) GOTO 811
-  ! CC         k1(i) = k2(i) - 1
-  ! CC         todo(i) = .TRUE.
-  ! CC      ENDIF
-  ! CC  812 CONTINUE
-  ! CC      ENDDO
-
-820 CONTINUE ! chercher le haut de la colonne
-
-  k2min = klev
-  DO i = 1, klon
-    aller(i) = .TRUE.
-    IF (todo(i)) k2min = min(k2min, k2(i))
-  END DO
-  IF (k2min<klev) THEN
-    DO k = k2min, klev
-      DO i = 1, klon
-        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)
-          IF (zflo(i)<=0.0 .OR. zsat(i)<=0.0) THEN
-            aller(i) = .FALSE.
-          ELSE
-            k2(i) = k
-          END IF
-        END IF
-      END DO
-    END DO
-    ! error      is = 0
-    ! error      DO i = 1, klon
-    ! error      IF(todo(i).AND.aller(i)) THEN
-    ! error         is = is + 1
-    ! error         todo(i) = .FALSE.
-    ! error         k2(i) = klev
-    ! error      ENDIF
-    ! error      ENDDO
-    ! error      IF (is.GT.0) THEN
-    ! error         PRINT*, "Bizard. je pourrais continuer mais j arrete"
-    ! error         CALL abort
-    ! error      ENDIF
-  END IF
-
-  ! CC      DO i = 1, klon
-  ! CC      IF (todo(i)) THEN
-  ! CC  821    CONTINUE
-  ! CC         IF (k2(i) .EQ. klev) GOTO 822
-  ! CC         k = k2(i) + 1
-  ! CC         zsat(i) = zsat(i) + zqmqsdp(i,k)
-  ! CC         zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-  ! CC         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) GOTO 822
-  ! CC         k2(i) = k
-  ! CC         GOTO 821
-  ! CC      ENDIF
-  ! CC  822 CONTINUE
-  ! CC      ENDDO
-
-830 CONTINUE ! faire l'ajustement en sachant k1 et k2
-
-  is = 0
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      IF (k2(i)<=k1(i)) is = is + 1
-    END IF
-  END DO
-  IF (is>0) THEN
-    PRINT *, 'Impossible: k1 trop grand ou k2 trop petit'
-    PRINT *, 'is=', is
-    CALL abort
-  END IF
-
-  k1min = klev
-  k1max = 1
-  k2max = 1
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      k1min = min(k1min, k1(i))
-      k1max = max(k1max, k1(i))
-      k2max = max(k2max, k2(i))
-    END IF
-  END DO
-
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      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))
-    END IF
-  END DO
-
-  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))
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    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)
-    END IF
-  END DO
-
-  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)
-      END IF
-    END DO
-  END DO
-
-  ! Quantite de condensation produite pendant l'ajustement:
-
-  DO i = 1, klon
-    zcond(i) = 0.0
-  END DO
-  DO k = k1min, k2max
-    DO i = 1, klon
-      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
-      END IF
-    END DO
-  END DO
-
-  ! Si condensation negative, effort completement perdu:
-
-  DO i = 1, klon
-    IF (todo(i) .AND. zcond(i)<=0.) todo(i) = .FALSE.
-  END DO
-
-  ! L'ajustement a ete accompli, meme les calculs accessoires
-  ! ne sont pas encore faits:
-
-  DO i = 1, klon
-    IF (todo(i)) accompli(i) = .TRUE.
-  END DO
-
-  ! =====
-  ! Une fois que la condensation a lieu, on doit construire un
-  ! "modele nuageux" pour partager la condensation entre l'eau
-  ! liquide nuageuse et la precipitation (leur rapport toliq
-  ! est calcule selon l'epaisseur nuageuse). Je suppose que
-  ! toliq=tomax quand l'epaisseur nuageuse est inferieure a dpmin,
-  ! et que toliq=tomin quand l'epaisseur depasse dpmax (interpolation
-  ! lineaire entre dpmin et dpmax).
-  ! =====
-  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
-      IF (old_tau) toliq(i) = 1.0
-    END IF
-  END DO
-  ! =====
-  ! On doit aussi determiner la distribution verticale de
-  ! l'eau nuageuse. Plusieurs options sont proposees:
-
-  ! (0) La condensation precipite integralement (toliq ne sera
-  ! pas utilise).
-  ! (1) L'eau liquide est distribuee entre k1 et k2 et proportionnelle
-  ! a la vapeur d'eau locale.
-  ! (2) Elle est distribuee entre k1 et k2 avec une valeur constante.
-  ! (3) Elle est seulement distribuee aux couches ou la vapeur d'eau
-  ! est effectivement diminuee pendant le processus d'ajustement.
-  ! (4) Elle est en fonction (lineaire ou exponentielle) de la
-  ! distance (epaisseur en pression) avec le niveau k1 (la couche
-  ! k1 n'aura donc pas d'eau liquide).
-  ! =====
-
-  IF (opt_cld==0) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) zrfl(i) = zcond(i)/dtime
-    END DO
-
-  ELSE IF (opt_cld==1) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de vapeur d'eau
-    END DO
-    DO k = k1min, k2max
-      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
-      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
-      END IF
-    END DO
-    DO k = k1min, k2max
-      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)
-        END IF
-      END DO
-    END DO
-
-  ELSE IF (opt_cld==2) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de masse
-    END DO
-    DO k = k1min, k2max
-      DO i = 1, klon
-        IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) zvapo(i) = zvapo(i) + &
-          delp(i, k)/rg
-      END DO
-    END DO
-    DO k = k1min, k2max
-      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
-    END DO
-
-  ELSE IF (opt_cld==3) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) zvapo(i) = 0.0 ! quantite de l'eau strictement condensee
-    END DO
-    DO k = k1min, k2max
-      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
-      END DO
-    END DO
-    DO k = k1min, k2max
-      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
-    END DO
-
-  ELSE IF (opt_cld==4) THEN
-
-    nexpo = 3
-    ! cc         nexpo = 1 ! distribution lineaire
-
-    DO i = 1, klon
-      IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de masse
-    END DO ! (avec ponderation)
-    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
-      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
-    END DO
-
-  ELSE ! valeur non-prevue pour opt_cld
-
-    PRINT *, 'opt_cld est faux:', opt_cld
-    CALL abort
-
-  END IF ! fin de opt_cld
-
-  ! L'eau precipitante peut etre evaporee:
-
-  zalfa = 0.05
-  IF (evap_prec .AND. (k1max>=2)) THEN
-    DO k = k1max - 1, 1, -1
-      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 = 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))
-          zrfl(i) = zrfln
-        END IF
-      END DO
-    END DO
-  END IF
-
-  ! La temperature de la premiere couche determine la pluie ou la neige:
-
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      IF (zt(i,1)>rtt) THEN
-        rain(i) = rain(i) + zrfl(i)
-      ELSE
-        snow(i) = snow(i) + zrfl(i)
-      END IF
-    END IF
-  END DO
-
-  ! Mise a jour de la temperature et de l'humidite
-
-  DO k = k1min, k2max
-    DO i = 1, klon
-      IF (todo(i) .AND. k>=k1(i) .AND. k<=k2(i)) THEN
-        zt(i, k) = ztnew(i, k)
-        zq(i, k) = zqnew(i, k)
-      END IF
-    END DO
-  END DO
-
-  ! Re-calculer certaines variables pour etendre et re-ajuster la colonne
-
-  IF (exigent) THEN
-    DO k = 1, klev
-      DO i = 1, klon
-        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)
-          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))
-            ELSE
-              zqs(i, k) = qsatl(zt(i,k))/pplay(i, k)
-              zdqs(i, k) = dqsatl(zt(i,k), zqs(i,k))
-            END IF
-          END IF
-        END IF
-      END DO
-    END DO
-  END IF
-
-  IF (exigent) THEN
-    DO k = 1, klev - 1
-      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)))
-        END IF
-      END DO
-    END DO
-  END IF
-
-  ! Puisque l'humidite a ete modifiee, on re-fait (q-qs)*dp
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (todo(i)) THEN
-        zqmqsdp(i, k) = (zq(i,k)-zqs(i,k))*delp(i, k)
-      END IF
-    END DO
-  END DO
-
-  ! Verifier si l'on peut etendre le bas de la colonne
-
-  DO i = 1, klon
-    etendre(i) = .FALSE.
-  END DO
-
-  k1max = 1
-  DO i = 1, klon
-    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)
-      ! sc voici l'ancienne ligne:
-      ! sc         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) THEN
-      ! sc sylvain: il faut RESPECTER les 2 criteres:
-      IF (zflo(i)>0.0 .AND. zsat(i)>0.0) THEN
-        etendre(i) = .TRUE.
-        k1(i) = k1(i) - 1
-        k1max = max(k1max, k1(i))
-        aller(i) = .TRUE.
-      END IF
-    END IF
-  END DO
-
-  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)
-          IF (zsat(i)<=0.0 .OR. zflo(i)<=0.0) THEN
-            aller(i) = .FALSE.
-          ELSE
-            k1(i) = k
-          END IF
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (etendre(i) .AND. aller(i)) THEN
-        k1(i) = 1
-      END IF
-    END DO
-  END IF
-
-  ! CC      DO i = 1, klon
-  ! CC      IF (etendre(i)) THEN
-  ! CC  840    k = k1(i)
-  ! CC         IF (k.GT.1) THEN
-  ! CC            zsat(i) = zsat(i) + zqmqsdp(i,k-1)
-  ! CC            zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-  ! CC            IF (zflo(i).GT.0.0 .AND. zsat(i).GT.0.0) THEN
-  ! CC               k1(i) = k - 1
-  ! CC               GOTO 840
-  ! CC            ENDIF
-  ! CC         ENDIF
-  ! CC      ENDIF
-  ! CC      ENDDO
-
-  DO i = 1, klon
-    todobis(i) = todo(i)
-    todo(i) = .FALSE.
-  END DO
-  is = 0
-  DO i = 1, klon
-    IF (etendre(i)) THEN
-      todo(i) = .TRUE.
-      is = is + 1
-    END IF
-  END DO
-  IF (is>0) THEN
-    IF (new_top) THEN
-      GO TO 820 ! chercher de nouveau le sommet k2
-    ELSE
-      GO TO 830 ! supposer que le sommet est celui deja trouve
-    END IF
-  END IF
-
-  DO i = 1, klon
-    possible(i) = .FALSE.
-  END DO
-  is = 0
-  DO i = 1, klon
-    IF (todobis(i) .AND. k2(i)<klev) THEN
-      is = is + 1
-      possible(i) = .TRUE.
-    END IF
-  END DO
-  IF (is>0) GO TO 810 !on cherche en haut d'autres blocks
-  ! a ajuster a partir du sommet de la colonne precedente
-
-860 CONTINUE ! Calculer les tendances et diagnostiques
-  ! cc      print*, "Apres 860"
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (accompli(i)) THEN
-        d_t(i, k) = zt(i, k) - t(i, k)
-        zq(i, k) = max(zq(i,k), seuil_vap)
-        d_q(i, k) = zq(i, k) - q(i, k)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    IF (accompli(i)) THEN
-      DO k = 1, klev
-        IF (rneb(i,k)>0.0) THEN
-          ibas(i) = k
-          GO TO 807
-        END IF
-      END DO
-807   CONTINUE
-      DO k = klev, 1, -1
-        IF (rneb(i,k)>0.0) THEN
-          itop(i) = k
-          GO TO 808
-        END IF
-      END DO
-808   CONTINUE
-    END IF
-  END DO
-
-  IF (imprim) THEN
-    nbtodo = 0
-    nbdone = 0
-    DO i = 1, klon
-      IF (afaire(i)) nbtodo = nbtodo + 1
-      IF (accompli(i)) nbdone = nbdone + 1
-    END DO
-    PRINT *, 'nbTodo, nbDone=', nbtodo, nbdone
-  END IF
-
-  RETURN
-END SUBROUTINE conmanv
-SUBROUTINE conkuo(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, d_ql, rneb, &
-    rain, snow, ibas, itop)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-  ! Objet: Schema de convection de type Kuo (1965).
-  ! Cette version du code peut calculer le niveau de depart
-  ! N.B. version vectorielle (le 6 oct. 1997)
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! Arguments:
-
-  REAL dtime ! intervalle du temps (s)
-  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)
-  REAL q(klon, klev) ! humidite specifique
-  REAL conv_q(klon, klev) ! taux de convergence humidite (g/g/s)
-
-  REAL d_t(klon, klev) ! incrementation temperature
-  REAL d_q(klon, klev) ! incrementation humidite
-  REAL d_ql(klon, klev) ! incrementation eau liquide
-  REAL rneb(klon, klev) ! nebulosite
-  REAL rain(klon) ! pluies (mm/s)
-  REAL snow(klon) ! neige (mm/s)
-  INTEGER itop(klon) ! niveau du sommet
-  INTEGER ibas(klon) ! niveau du bas
-
-  LOGICAL ldcum(klon) ! convection existe
-  LOGICAL todo(klon)
-
-  ! Quelsques options:
-
-  LOGICAL calcfcl ! calculer le niveau de convection libre
-  PARAMETER (calcfcl=.TRUE.)
-  INTEGER ldepar ! niveau fixe de convection libre
-  PARAMETER (ldepar=4)
-  INTEGER opt_cld ! comment traiter l'eau liquide
-  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.)
-  REAL coef_eva
-  PARAMETER (coef_eva=1.0E-05)
-  LOGICAL new_deh ! nouvelle facon de calculer dH
-  PARAMETER (new_deh=.FALSE.)
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-  LOGICAL old_tau ! implique precipitation nulle
-  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)
-  REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-  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)
-
-  ! Variables locales:
-
-  INTEGER nexpo
-  LOGICAL nuage(klon)
-  INTEGER i, k, kbmin, kbmax, khmax
-  REAL ztotal(klon, klev), zdeh(klon, klev)
-  REAL zgz(klon, klev)
-  REAL zqs(klon, klev)
-  REAL zdqs(klon, klev)
-  REAL ztemp(klon, klev)
-  REAL zpres(klon, klev)
-  REAL zconv(klon) ! convergence d'humidite
-  REAL zvirt(klon) ! convergence virtuelle d'humidite
-  REAL zfrac(klon) ! fraction convective
-  INTEGER kb(klon), kh(klon)
-
-  REAL zcond(klon), zvapo(klon), zrapp(klon)
-  REAL zrfl(klon), zrfln, zqev, zqevt
-  REAL zdelta, zcvm5, zcor
-  REAL zvar
-
-  LOGICAL appel1er
-  SAVE appel1er
-  !$OMP THREADPRIVATE(appel1er)
-
-  ! Fonctions thermodynamiques
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  DATA appel1er/.TRUE./
-
-  IF (appel1er) THEN
-    PRINT *, 'conkuo, calcfcl:', calcfcl
-    IF (.NOT. calcfcl) PRINT *, 'conkuo, ldepar:', ldepar
-    PRINT *, 'conkuo, opt_cld:', opt_cld
-    PRINT *, 'conkuo, evap_prec:', evap_prec
-    PRINT *, 'conkuo, new_deh:', new_deh
-    appel1er = .FALSE.
-  END IF
-
-  ! Initialiser les sorties a zero
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_q(i, k) = 0.0
-      d_t(i, k) = 0.0
-      d_ql(i, k) = 0.0
-      rneb(i, k) = 0.0
-    END DO
-  END DO
-  DO i = 1, klon
-    rain(i) = 0.0
-    snow(i) = 0.0
-    ibas(i) = 0
-    itop(i) = 0
-  END DO
-
-  ! Calculer la vapeur d'eau saturante Qs et sa derive L/Cp * dQs/dT
-
-  DO k = 1, klev
-    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)
-      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))
-        ELSE
-          zqs(i, k) = qsatl(t(i,k))/pplay(i, k)
-          zdqs(i, k) = dqsatl(t(i,k), zqs(i,k))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! Calculer gz (energie potentielle)
-
-  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))
-  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))
-    END DO
-  END DO
-
-  ! Calculer l'energie statique humide saturee (Cp*T + gz + L*Qs)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ztotal(i, k) = rcpd*t(i, k) + rlvtt*zqs(i, k) + zgz(i, k)
-    END DO
-  END DO
-
-  ! Determiner le niveau de depart et calculer la difference de
-  ! l'energie statique humide saturee (ztotal) entre la couche
-  ! de depart et chaque couche au-dessus.
-
-  IF (calcfcl) THEN
-    DO k = 1, klev
-      DO i = 1, klon
-        zpres(i, k) = pplay(i, k)
-        ztemp(i, k) = t(i, k)
-      END DO
-    END DO
-    CALL kuofcl(ztemp, q, zgz, zpres, ldcum, kb)
-    DO i = 1, klon
-      IF (ldcum(i)) THEN
-        k = kb(i)
-        IF (new_deh) THEN
-          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
-      END IF
-    END DO
-    DO k = 1, klev
-      DO i = 1, klon
-        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))
-          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))
-          END IF
-        END IF
-      END DO
-    END DO
-  ELSE
-    DO i = 1, klon
-      k = ldepar
-      kb(i) = ldepar
-      ldcum(i) = .TRUE.
-      IF (new_deh) THEN
-        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
-    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))
-        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))
-        END IF
-      END DO
-    END DO
-  END IF
-
-  ! -----Chercher le sommet du nuage
-  ! -----Calculer la convergence de l'humidite (en kg/m**2 a un facteur
-  ! -----psolpa/RG pres) du bas jusqu'au sommet du nuage.
-  ! -----Calculer la convergence virtuelle pour que toute la maille
-  ! -----deviennt nuageuse (du bas jusqu'au sommet du nuage)
-
-  DO i = 1, klon
-    nuage(i) = .TRUE.
-    zconv(i) = 0.0
-    zvirt(i) = 0.0
-    kh(i) = -999
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (k>=kb(i) .AND. ldcum(i)) THEN
-        nuage(i) = nuage(i) .AND. zdeh(i, k) > 0.0
-        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))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    todo(i) = ldcum(i) .AND. kh(i) > kb(i) .AND. zconv(i) > 0.0
-  END DO
-
-  kbmin = klev
-  kbmax = 0
-  khmax = 0
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      kbmin = min(kbmin, kb(i))
-      kbmax = max(kbmax, kb(i))
-      khmax = max(khmax, kh(i))
-    END IF
-  END DO
-
-  ! -----Calculer la surface couverte par le nuage
-
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      zfrac(i) = max(0.0, min(zconv(i)/zvirt(i),1.0))
-    END IF
-  END DO
-
-  ! -----Calculs essentiels:
-
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      zcond(i) = 0.0
-    END IF
-  END DO
-  DO k = kbmin, khmax
-    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
-        rneb(i, k) = zfrac(i)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    IF (todo(i) .AND. zcond(i)<0.0) THEN
-      PRINT *, 'WARNING: cond. negative (Kuo) ', i, kb(i), kh(i), zcond(i)
-      zcond(i) = 0.0
-      DO k = kb(i), kh(i)
-        d_t(i, k) = 0.0
-        d_q(i, k) = 0.0
-      END DO
-      todo(i) = .FALSE. ! effort totalement perdu
-    END IF
-  END DO
-
-  ! =====
-  ! Une fois que la condensation a lieu, on doit construire un
-  ! "modele nuageux" pour partager la condensation entre l'eau
-  ! liquide nuageuse et la precipitation (leur rapport toliq
-  ! est calcule selon l'epaisseur nuageuse). Je suppose que
-  ! toliq=tomax quand l'epaisseur nuageuse est inferieure a dpmin,
-  ! et que toliq=tomin quand l'epaisseur depasse dpmax (interpolation
-  ! lineaire entre dpmin et dpmax).
-  ! =====
-  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
-      IF (old_tau) toliq(i) = 1.0
-    END IF
-  END DO
-  ! =====
-  ! On doit aussi determiner la distribution verticale de
-  ! l'eau nuageuse. Plusieurs options sont proposees:
-
-  ! (0) La condensation precipite integralement (toliq ne sera
-  ! pas utilise).
-  ! (1) L'eau liquide est distribuee entre k1 et k2 et proportionnelle
-  ! a la vapeur d'eau locale.
-  ! (2) Elle est distribuee entre k1 et k2 avec une valeur constante.
-  ! (3) Elle est seulement distribuee aux couches ou la vapeur d'eau
-  ! est effectivement diminuee pendant le processus d'ajustement.
-  ! (4) Elle est en fonction (lineaire ou exponentielle) de la
-  ! distance (epaisseur en pression) avec le niveau k1 (la couche
-  ! k1 n'aura donc pas d'eau liquide).
-  ! =====
-
-  IF (opt_cld==0) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) zrfl(i) = zcond(i)/dtime
-    END DO
-
-  ELSE IF (opt_cld==1) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de vapeur d'eau
-    END DO
-    DO k = kbmin, khmax
-      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
-        END IF
-      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)))
-      END IF
-    END DO
-    DO k = kbmin, khmax
-      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))
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
-      END IF
-    END DO
-
-  ELSE IF (opt_cld==2) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de masse
-    END DO
-    DO k = kbmin, khmax
-      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
-        END IF
-      END DO
-    END DO
-    DO k = kbmin, khmax
-      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)
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
-      END IF
-    END DO
-
-  ELSE IF (opt_cld==3) THEN
-
-    DO i = 1, klon
-      IF (todo(i)) THEN
-        zvapo(i) = 0.0 ! quantite de l'eau strictement condensee
-      END IF
-    END DO
-    DO k = kbmin, khmax
-      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
-        END IF
-      END DO
-    END DO
-    DO k = kbmin, khmax
-      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))
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
-      END IF
-    END DO
-
-  ELSE IF (opt_cld==4) THEN
-
-    nexpo = 3
-    ! cc         nexpo = 1 ! distribution lineaire
-
-    DO i = 1, klon
-      IF (todo(i)) THEN
-        zvapo(i) = 0.0 ! quantite integrale de masse (avec ponderation)
-      END IF
-    END DO
-    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
-        END IF
-      END DO
-    END DO
-    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
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (todo(i)) THEN
-        zrfl(i) = (1.0-toliq(i))*zcond(i)/dtime
-      END IF
-    END DO
-
-  ELSE ! valeur non-prevue pour opt_cld
-
-    PRINT *, 'opt_cld est faux:', opt_cld
-    CALL abort
-
-  END IF ! fin de opt_cld
-
-  ! L'eau precipitante peut etre re-evaporee:
-
-  IF (evap_prec .AND. kbmax>=2) THEN
-    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))
-          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
-          zrfl(i) = zrfln
-        END IF
-      END DO
-    END DO
-  END IF
-
-  ! La temperature de la premiere couche determine la pluie ou la neige:
-
-  DO i = 1, klon
-    IF (todo(i)) THEN
-      IF (t(i,1)>rtt) THEN
-        rain(i) = rain(i) + zrfl(i)
-      ELSE
-        snow(i) = snow(i) + zrfl(i)
-      END IF
-    END IF
-  END DO
-
-  RETURN
-END SUBROUTINE conkuo
-SUBROUTINE kuofcl(pt, pq, pg, pp, ldcum, kcbot)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19940927
-  ! adaptation du code de Tiedtke du ECMWF
-  ! Objet: calculer le niveau de convection libre
-  ! (FCL: Free Convection Level)
-  ! ======================================================================
-  ! Arguments:
-  ! pt---input-R- temperature (K)
-  ! pq---input-R- vapeur d'eau (kg/kg)
-  ! pg---input-R- geopotentiel (g*z ou z est en metre)
-  ! pp---input-R- pression (Pa)
-
-  ! LDCUM---output-L- Y-t-il la convection
-  ! kcbot---output-I- Niveau du bas de la convection
-  ! ======================================================================
-  include "YOMCST.h"
-  include "YOETHF.h"
-
-  REAL pt(klon, klev), pq(klon, klev), pg(klon, klev), pp(klon, klev)
-  INTEGER kcbot(klon)
-  LOGICAL ldcum(klon)
-
-  REAL ztu(klon, klev), zqu(klon, klev), zlu(klon, klev)
-  REAL zqold(klon), zbuo
-  INTEGER is, i, k
-
-  ! klab=1: on est sous le nuage convectif
-  ! klab=2: le bas du nuage convectif
-  ! klab=0: autres couches
-  INTEGER klab(klon, klev)
-
-  ! quand lflag=.true., on est sous le nuage, il faut donc appliquer
-  ! le processus d'elevation.
-  LOGICAL lflag(klon)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ztu(i, k) = pt(i, k)
-      zqu(i, k) = pq(i, k)
-      zlu(i, k) = 0.0
-      klab(i, k) = 0
-    END DO
-  END DO
-  ! ----------------------------------------------------------------------
-  DO i = 1, klon
-    klab(i, 1) = 1
-    kcbot(i) = 2
-    ldcum(i) = .FALSE.
-  END DO
-
-  DO k = 2, klev - 1
-
-    is = 0
-    DO i = 1, klon
-      IF (klab(i,k-1)==1) is = is + 1
-      lflag(i) = .FALSE.
-      IF (klab(i,k-1)==1) lflag(i) = .TRUE.
-    END DO
-    IF (is==0) GO TO 290
-
-    ! on eleve le parcel d'air selon l'adiabatique sec
-
-    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
-        IF (zbuo>0.) klab(i, k) = 1
-        zqold(i) = zqu(i, k)
-      END IF
-    END DO
-
-    ! on calcule la condensation eventuelle
-
-    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
-    ! c'est bien le bas de la tour de convection
-
-    DO i = 1, klon
-      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
-        IF (zbuo>0.) THEN
-          kcbot(i) = k
-          ldcum(i) = .TRUE.
-        END IF
-      END IF
-    END DO
-
-290 END DO
-
-  RETURN
-END SUBROUTINE kuofcl
-SUBROUTINE adjtq(pp, pt, pq, ldflag, kcall)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19940927
-  ! adaptation du code de Tiedtke du ECMWF
-  ! Objet: ajustement entre T et Q
-  ! ======================================================================
-  ! Arguments:
-  ! pp---input-R- pression (Pa)
-  ! pt---input/output-R- temperature (K)
-  ! pq---input/output-R- vapeur d'eau (kg/kg)
-  ! ======================================================================
-  ! TO PRODUCE T,Q AND L VALUES FOR CLOUD ASCENT
-
-  ! NOTE: INPUT PARAMETER KCALL DEFINES CALCULATION AS
-  ! KCALL=0    ENV. T AND QS IN*CUINI*
-  ! KCALL=1  CONDENSATION IN UPDRAFTS  (E.G. CUBASE, CUASC)
-  ! KCALL=2  EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF)
-
-  include "YOMCST.h"
-
-  REAL pt(klon), pq(klon), pp(klon)
-  LOGICAL ldflag(klon)
-  INTEGER kcall
-
-  REAL t_coup
-  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
-    zcond(i) = 0.0
-  END DO
-
-  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))
-      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)
-        zqsat = min(0.5, zqsat)
-        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)
-          zdqsat = dqsats(pt(i), zqsat)
-        ELSE
-          zqsat = qsatl(pt(i))/pp(i)
-          zdqsat = dqsatl(pt(i), zqsat)
-        END IF
-      END IF
-      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)
-      pq(i) = pq(i) - zcond(i)
-    END IF
-  END DO
-
-  is = 0
-  DO i = 1, klon
-    IF (zcond(i)/=0.) is = is + 1
-  END DO
-  IF (is==0) GO TO 230
-
-  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))
-      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)
-        zqsat = min(0.5, zqsat)
-        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)
-          zdqsat = dqsats(pt(i), zqsat)
-        ELSE
-          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
-      pq(i) = pq(i) - zcond1
-    END IF
-  END DO
-
-230 CONTINUE
-  RETURN
-END SUBROUTINE adjtq
-SUBROUTINE fiajh(dtime, paprs, pplay, t, q, d_t, d_q, d_ql, rneb, rain, snow, &
-    ibas, itop)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! Ajustement humide (Schema de convection de Manabe)
-  ! .
-  include "YOMCST.h"
-
-  ! Arguments:
-
-  REAL dtime ! intervalle du temps (s)
-  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 pplay(klon, klev) ! pression au milieu de couche (Pa)
-
-  REAL d_t(klon, klev) ! incrementation pour la temperature
-  REAL d_q(klon, klev) ! incrementation pour vapeur d'eau
-  REAL d_ql(klon, klev) ! incrementation pour l'eau liquide
-  REAL rneb(klon, klev) ! fraction nuageuse
-
-  REAL rain(klon) ! variable non utilisee
-  REAL snow(klon) ! variable non utilisee
-  INTEGER ibas(klon) ! variable non utilisee
-  INTEGER itop(klon) ! variable non utilisee
-
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-  REAL seuil_vap
-  PARAMETER (seuil_vap=1.0E-10)
-
-  ! Variables locales:
-
-  INTEGER i, k
-  INTEGER k1, k1p, k2, k2p
-  LOGICAL itest(klon)
-  REAL delta_q(klon, klev)
-  REAL cp_new_t(klev)
-  REAL cp_delta_t(klev)
-  REAL new_qb(klev)
-  REAL v_cptj(klev), v_cptjk1, v_ssig
-  REAL v_cptt(klon, klev), v_p, v_t
-  REAL v_qs(klon, klev), v_qsd(klon, klev)
-  REAL zq1(klon), zq2(klon)
-  REAL gamcpdz(klon, 2:klev)
-  REAL zdp, zdpm
-
-  REAL zsat ! sur-saturation
-  REAL zflo ! flotabilite
-
-  REAL local_q(klon, klev), local_t(klon, klev)
-
-  REAL zdelta, zcor, zcvm5
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  DO k = 1, klev
-    DO i = 1, klon
-      local_q(i, k) = q(i, k)
-      local_t(i, k) = t(i, k)
-      rneb(i, k) = 0.0
-      d_ql(i, k) = 0.0
-      d_t(i, k) = 0.0
-      d_q(i, k) = 0.0
-    END DO
-  END DO
-  DO i = 1, klon
-    rain(i) = 0.0
-    snow(i) = 0.0
-    ibas(i) = 0
-    itop(i) = 0
-  END DO
-
-  ! Calculer v_qs et v_qsd:
-
-  DO k = 1, klev
-    DO i = 1, klon
-      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)
-      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))
-        ELSE
-          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
-  END DO
-
-  ! Calculer Gamma * Cp * dz: (gamm est le gradient critique)
-
-  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))
-    END DO
-  END DO
-
-  ! ------------------------------------ modification des profils instables
-  DO i = 1, klon
-    itest(i) = .FALSE.
-
-    k1 = 0
-    k2 = 1
-
-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))
-    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
-    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)
-    IF (zflo<=0.0 .OR. zsat<=0.0) GO TO 821
-    k2 = k2p
-    GO TO 820
-821 CONTINUE
-
-    ! ------------------------------------------------------ ajustement local
-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))
-
-    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))
-    END DO
-
-    DO k = k1, k2
-      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
-      local_q(i, k) = new_qb(k)
-      local_t(i, k) = cp_new_t(k)/rcpd
-    END DO
-
-    ! --------------------------------------------------- sondage vers le bas
-    ! -- on redefinit les variables prognostiques dans
-    ! -- la colonne qui vient d'etre ajustee
-
-    DO k = k1, k2
-      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)
-      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))
-        ELSE
-          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))
-    END DO
-
-    ! Verifier si l'on peut etendre la colonne vers le bas
-
-    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))
-    IF (zflo<=0.0 .OR. zsat<=0.0) GO TO 841 ! extension echouee
-
-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)
-    IF (zflo>0.0 .AND. zsat>0.0) THEN
-      GO TO 840
-    ELSE
-      GO TO 830 ! GOTO 820 (a tester, Z.X.Li, mars 1995)
-    END IF
-841 CONTINUE
-
-    GO TO 810 ! chercher d'autres blocks en haut
-
-9999 END DO ! boucle sur tous les points
-  ! -----------------------------------------------------------------------
-
-  ! Determiner la fraction nuageuse (hypothese: la nebulosite a lieu
-  ! a l'endroit ou la vapeur d'eau est diminuee par l'ajustement):
-
-  DO k = 1, klev
-    DO i = 1, klon
-      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
-      END IF
-    END DO
-  END DO
-
-  ! Distribuer l'eau condensee en eau liquide nuageuse (hypothese:
-  ! l'eau liquide est distribuee aux endroits ou la vapeur d'eau
-  ! diminue et d'une maniere proportionnelle a cet diminution):
-
-  DO i = 1, klon
-    IF (itest(i)) THEN
-      zq1(i) = 0.0
-      zq2(i) = 0.0
-    END IF
-  END DO
-  DO k = 1, klev
-    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
-      END IF
-    END DO
-  END DO
-  DO k = 1, klev
-    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)
-      END IF
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      local_q(i, k) = max(local_q(i,k), seuil_vap)
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = local_t(i, k) - t(i, k)
-      d_q(i, k) = local_q(i, k) - q(i, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE fiajh
-SUBROUTINE fiajc(dtime, paprs, pplay, t, q, conv_q, d_t, d_q, d_ql, rneb, &
-    rain, snow, ibas, itop)
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-
-  ! Options:
-
-  INTEGER plb ! niveau de depart pour la convection
-  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.)
-
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-
-  ! Arguments:
-
-  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 pplay(klon, klev) ! pression au milieu de couche (Pa)
-  REAL dtime ! intervalle du temps (s)
-  REAL conv_q(klon, klev) ! taux de convergence de l'humidite
-  REAL rneb(klon, klev) ! fraction nuageuse
-  REAL d_q(klon, klev) ! incrementaion pour la vapeur d'eau
-  REAL d_ql(klon, klev) ! incrementation pour l'eau liquide
-  REAL d_t(klon, klev) ! incrementation pour la temperature
-  REAL rain(klon) ! variable non-utilisee
-  REAL snow(klon) ! variable non-utilisee
-  INTEGER itop(klon) ! variable non-utilisee
-  INTEGER ibas(klon) ! variable non-utilisee
-
-  INTEGER kh(klon), i, k
-  LOGICAL nuage(klon), test(klon, klev)
-  REAL zconv(klon), zdeh(klon, klev), zvirt(klon)
-  REAL zdqs(klon, klev), zqs(klon, klev)
-  REAL ztt, zvar, zfrac(klon)
-  REAL zq1(klon), zq2(klon)
-  REAL zdelta, zcor, zcvm5
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! Initialiser les sorties:
-
-  DO k = 1, klev
-    DO i = 1, klon
-      rneb(i, k) = 0.0
-      d_ql(i, k) = 0.0
-      d_t(i, k) = 0.0
-      d_q(i, k) = 0.0
-    END DO
-  END DO
-  DO i = 1, klon
-    itop(i) = 0
-    ibas(i) = 0
-    rain(i) = 0.0
-    snow(i) = 0.0
-  END DO
-
-  ! Calculer Qs et L/Cp * dQs/dT:
-
-  DO k = 1, klev
-    DO i = 1, klon
-      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)
-      ELSE
-        IF (ztt<t_coup) THEN
-          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))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! Determiner la difference de l'energie totale saturee:
-
-  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
-  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))
-    END DO
-  END DO
-
-  ! Determiner le sommet du nuage selon l'instabilite
-  ! Calculer les convergences d'humidite (reelle et virtuelle)
-
-  DO i = 1, klon
-    nuage(i) = .TRUE.
-    zconv(i) = 0.0
-    zvirt(i) = 0.0
-    kh(i) = -999
-  END DO
-  DO k = plb, klev
-    DO i = 1, klon
-      nuage(i) = nuage(i) .AND. zdeh(i, k) > 0.0
-      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))
-      END IF
-    END DO
-  END DO
-
-  IF (vector) THEN
-
-
-    DO k = plb, klev
-      DO i = 1, klon
-        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))
-        ELSE
-          test(i, k) = .FALSE.
-        END IF
-      END DO
-    END DO
-
-    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
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      zq1(i) = 0.0
-      zq2(i) = 0.0
-    END DO
-    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))
-        END IF
-      END DO
-    END DO
-
-    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)
-        END IF
-      END DO
-    END DO
-
-  ELSE ! (.NOT. vector)
-
-    DO i = 1, klon
-      IF (kh(i)>plb .AND. zconv(i)>0.0) THEN
-        ! 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))
-        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
-        END DO
-
-        zq1(i) = 0.0
-        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))
-        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)
-        END DO
-      END IF
-    END DO
-
-  END IF ! fin de teste sur vector
-
-  RETURN
-END SUBROUTINE fiajc
+link ../phylmd/conlmd.F90
Index: LMDZ6/trunk/libf/phylmdiso/convect1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/convect1.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/convect1.F90	(revision 3940)
@@ -1,641 +1,1 @@
-
-! $Header$
-
-SUBROUTINE convect1(len, nd, ndp1, noff, minorig, t, q, qs, u, v, p, ph, &
-    iflag, ft, fq, fu, fv, precip, cbmf, delt, ma)
-  ! .............................START PROLOGUE............................
-
-  ! SCCS IDENTIFICATION:  @(#)convect1.f	1.1 04/21/00
-  ! 19:40:52 /h/cm/library/nogaps4/src/sub/fcst/convect1.f_v
-
-  ! CONFIGURATION IDENTIFICATION:  None
-
-  ! MODULE NAME:  convect1
-
-  ! DESCRIPTION:
-
-  ! convect1     The Emanuel Cumulus Convection Scheme
-
-  ! CONTRACT NUMBER AND TITLE:  None
-
-  ! REFERENCES: Programmers  K. Emanuel (MIT), Timothy F. Hogan, M. Peng
-  ! (NRL)
-
-  ! CLASSIFICATION:  Unclassified
-
-  ! RESTRICTIONS: None
-
-  ! COMPILER DEPENDENCIES: FORTRAN 77, FORTRAN 90
-
-  ! COMPILE OPTIONS: Fortran 77: -Zu -Wf"-ei -o aggress"
-  ! Fortran 90: -O vector3,scalar3,task1,aggress,overindex  -ei -r 2
-
-  ! LIBRARIES OF RESIDENCE: /a/ops/lib/libfcst159.a
-
-  ! USAGE: call convect1(len,nd,noff,minorig,
-  ! &                   t,q,qs,u,v,
-  ! &                   p,ph,iflag,ft,
-  ! &                   fq,fu,fv,precip,cbmf,delt)
-
-  ! PARAMETERS:
-  ! Name            Type         Usage            Description
-  ! ----------      ----------     -------  ----------------------------
-
-  ! len           Integer        Input        first (i) dimension
-  ! nd            Integer        Input        vertical (k) dimension
-  ! ndp1          Integer        Input        nd + 1
-  ! noff          Integer        Input        integer limit for convection
-  ! (nd-noff)
-  ! minorig       Integer        Input        First level of convection
-  ! t             Real           Input        temperature
-  ! q             Real           Input        specific hum
-  ! qs            Real           Input        sat specific hum
-  ! u             Real           Input        u-wind
-  ! v             Real           Input        v-wind
-  ! p             Real           Input        full level pressure
-  ! ph            Real           Input        half level pressure
-  ! iflag         Integer        Output       iflag on latitude strip
-  ! ft            Real           Output       temp tend
-  ! fq            Real           Output       spec hum tend
-  ! fu            Real           Output       u-wind tend
-  ! fv            Real           Output       v-wind tend
-  ! cbmf          Real           In/Out       cumulus mass flux
-  ! delt          Real           Input        time step
-  ! iflag         Integer        Output       integer flag for Emanuel
-  ! conditions
-
-  ! COMMON BLOCKS:
-  ! Block      Name     Type    Usage              Notes
-  ! --------  --------   ----    ------   ------------------------
-
-  ! FILES: None
-
-  ! DATA BASES: None
-
-  ! NON-FILE INPUT/OUTPUT: None
-
-  ! ERROR CONDITIONS: None
-
-  ! ADDITIONAL COMMENTS: None
-
-  ! .................MAINTENANCE SECTION................................
-
-  ! MODULES CALLED:
-  ! Name           Description
-  ! convect2        Emanuel cumulus convection tendency calculations
-  ! -------     ----------------------
-  ! LOCAL VARIABLES AND
-  ! STRUCTURES:
-  ! Name     Type    Description
-  ! -------  ------  -----------
-  ! See Comments Below
-
-  ! i        Integer loop index
-  ! k        Integer loop index
-
-  ! METHOD:
-
-  ! See Emanuel, K. and M. Zivkovic-Rothman, 2000: Development and evaluation
-  ! of a
-  ! convective scheme for use in climate models.
-
-  ! FILES: None
-
-  ! INCLUDE FILES: None
-
-  ! MAKEFILE: /a/ops/met/nogaps/src/sub/fcst/fcst159lib.mak
-
-  ! ..............................END PROLOGUE.............................
-
-
-  USE dimphy
-  IMPLICIT NONE
-
-  INTEGER len
-  INTEGER nd
-  INTEGER ndp1
-  INTEGER noff
-  REAL t(len, nd)
-  REAL q(len, nd)
-  REAL qs(len, nd)
-  REAL u(len, nd)
-  REAL v(len, nd)
-  REAL p(len, nd)
-  REAL ph(len, ndp1)
-  INTEGER iflag(len)
-  REAL ft(len, nd)
-  REAL fq(len, nd)
-  REAL fu(len, nd)
-  REAL fv(len, nd)
-  REAL precip(len)
-  REAL cbmf(len)
-  REAL ma(len, nd)
-  INTEGER minorig
-  REAL delt, cpd, cpv, cl, rv, rd, lv0, g
-  REAL sigs, sigd, elcrit, tlcrit, omtsnow, dtmax, damp
-  REAL alpha, entp, coeffs, coeffr, omtrain, cu
-
-  ! -------------------------------------------------------------------
-  ! --- ARGUMENTS
-  ! -------------------------------------------------------------------
-  ! --- On input:
-
-  ! t:   Array of absolute temperature (K) of dimension ND, with first
-  ! index corresponding to lowest model level. Note that this array
-  ! will be altered by the subroutine if dry convective adjustment
-  ! occurs and if IPBL is not equal to 0.
-
-  ! q:   Array of specific humidity (gm/gm) of dimension ND, with first
-  ! index corresponding to lowest model level. Must be defined
-  ! at same grid levels as T. Note that this array will be altered
-  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! qs:  Array of saturation specific humidity of dimension ND, with first
-  ! index corresponding to lowest model level. Must be defined
-  ! at same grid levels as T. Note that this array will be altered
-  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
-  ! index corresponding with the lowest model level. Defined at
-  ! same levels as T. Note that this array will be altered if
-  ! dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! v:   Same as u but for meridional velocity.
-
-  ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
-  ! where NTRA is the number of different tracers. If no
-  ! convective tracer transport is needed, define a dummy
-  ! input array of dimension (ND,1). Tracers are defined at
-  ! same vertical levels as T. Note that this array will be altered
-  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
-
-  ! p:   Array of pressure (mb) of dimension ND, with first
-  ! index corresponding to lowest model level. Must be defined
-  ! at same grid levels as T.
-
-  ! ph:  Array of pressure (mb) of dimension ND+1, with first index
-  ! corresponding to lowest level. These pressures are defined at
-  ! levels intermediate between those of P, T, Q and QS. The first
-  ! value of PH should be greater than (i.e. at a lower level than)
-  ! the first value of the array P.
-
-  ! nl:  The maximum number of levels to which convection can penetrate, plus
-  ! 1.
-  ! NL MUST be less than or equal to ND-1.
-
-  ! delt: The model time step (sec) between calls to CONVECT
-
-  ! ----------------------------------------------------------------------------
-  ! ---   On Output:
-
-  ! iflag: An output integer whose value denotes the following:
-  ! VALUE   INTERPRETATION
-  ! -----   --------------
-  ! 0     Moist convection occurs.
-  ! 1     Moist convection occurs, but a CFL condition
-  ! on the subsidence warming is violated. This
-  ! does not cause the scheme to terminate.
-  ! 2     Moist convection, but no precip because ep(inb) lt 0.0001
-  ! 3     No moist convection because new cbmf is 0 and old cbmf is 0.
-  ! 4     No moist convection; atmosphere is not
-  ! unstable
-  ! 6     No moist convection because ihmin le minorig.
-  ! 7     No moist convection because unreasonable
-  ! parcel level temperature or specific humidity.
-  ! 8     No moist convection: lifted condensation
-  ! level is above the 200 mb level.
-  ! 9     No moist convection: cloud base is higher
-  ! then the level NL-1.
-
-  ! ft:   Array of temperature tendency (K/s) of dimension ND, defined at
-  ! same
-  ! grid levels as T, Q, QS and P.
-
-  ! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
-  ! defined at same grid levels as T, Q, QS and P.
-
-  ! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
-  ! defined at same grid levels as T.
-
-  ! fv:   Same as FU, but for forcing of meridional velocity.
-
-  ! ftra: Array of forcing of tracer content, in tracer mixing ratio per
-  ! second, defined at same levels as T. Dimensioned (ND,NTRA).
-
-  ! precip: Scalar convective precipitation rate (mm/day).
-
-  ! wd:   A convective downdraft velocity scale. For use in surface
-  ! flux parameterizations. See convect.ps file for details.
-
-  ! tprime: A convective downdraft temperature perturbation scale (K).
-  ! For use in surface flux parameterizations. See convect.ps
-  ! file for details.
-
-  ! qprime: A convective downdraft specific humidity
-  ! perturbation scale (gm/gm).
-  ! For use in surface flux parameterizations. See convect.ps
-  ! file for details.
-
-  ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
-  ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
-  ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
-  ! by the calling program between calls to CONVECT.
-
-  ! det:   Array of detrainment mass flux of dimension ND.
-
-  ! -------------------------------------------------------------------
-
-  ! Local arrays
-
-  INTEGER nl
-  INTEGER nlp
-  INTEGER nlm
-  INTEGER i, k, n
-  REAL delti
-  REAL rowl
-  REAL clmcpv
-  REAL clmcpd
-  REAL cpdmcp
-  REAL cpvmcpd
-  REAL eps
-  REAL epsi
-  REAL epsim1
-  REAL ginv
-  REAL hrd
-  REAL prccon1
-  INTEGER icbmax
-  REAL lv(klon, klev)
-  REAL cpn(klon, klev)
-  REAL cpx(klon, klev)
-  REAL tv(klon, klev)
-  REAL gz(klon, klev)
-  REAL hm(klon, klev)
-  REAL h(klon, klev)
-  REAL work(klon)
-  INTEGER ihmin(klon)
-  INTEGER nk(klon)
-  REAL rh(klon)
-  REAL chi(klon)
-  REAL plcl(klon)
-  INTEGER icb(klon)
-  REAL tnk(klon)
-  REAL qnk(klon)
-  REAL gznk(klon)
-  REAL pnk(klon)
-  REAL qsnk(klon)
-  REAL ticb(klon)
-  REAL gzicb(klon)
-  REAL tp(klon, klev)
-  REAL tvp(klon, klev)
-  REAL clw(klon, klev)
-
-  REAL ah0(klon), cpp(klon)
-  REAL tg, qg, s, alv, tc, ahg, denom, es, rg
-
-  INTEGER ncum
-  INTEGER idcum(klon)
-
-  cpd = 1005.7
-  cpv = 1870.0
-  cl = 4190.0
-  rv = 461.5
-  rd = 287.04
-  lv0 = 2.501E6
-  g = 9.8
-
-  ! *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
-  ! ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
-  ! ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
-  ! ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
-  ! ***               BETWEEN 0 C AND TLCRIT)                        ***
-  ! ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
-  ! ***                       FORMULATION                            ***
-  ! ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-  ! ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
-  ! ***                        OF CLOUD                              ***
-  ! ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
-  ! ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
-  ! ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-  ! ***                          OF RAIN                             ***
-  ! ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-  ! ***                          OF SNOW                             ***
-  ! ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
-  ! ***                         TRANSPORT                            ***
-  ! ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
-  ! ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
-  ! ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-  ! ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-  ! ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
-  ! ***                   (DAMP MUST BE LESS THAN 1)                 ***
-
-  sigs = 0.12
-  sigd = 0.05
-  elcrit = 0.0011
-  tlcrit = -55.0
-  omtsnow = 5.5
-  dtmax = 0.9
-  damp = 0.1
-  alpha = 0.2
-  entp = 1.5
-  coeffs = 0.8
-  coeffr = 1.0
-  omtrain = 50.0
-
-  cu = 0.70
-  damp = 0.1
-
-
-  ! Define nl, nlp, nlm, and delti
-
-  nl = nd - noff
-  nlp = nl + 1
-  nlm = nl - 1
-  delti = 1.0/delt
-
-  ! -------------------------------------------------------------------
-  ! --- SET CONSTANTS
-  ! -------------------------------------------------------------------
-
-  rowl = 1000.0
-  clmcpv = cl - cpv
-  clmcpd = cl - cpd
-  cpdmcp = cpd - cpv
-  cpvmcpd = cpv - cpd
-  eps = rd/rv
-  epsi = 1.0/eps
-  epsim1 = epsi - 1.0
-  ginv = 1.0/g
-  hrd = 0.5*rd
-  prccon1 = 86400.0*1000.0/(rowl*g)
-
-  ! dtmax is the maximum negative temperature perturbation.
-
-  ! =====================================================================
-  ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
-  ! =====================================================================
-
-  DO k = 1, nd
-    DO i = 1, len
-      ft(i, k) = 0.0
-      fq(i, k) = 0.0
-      fu(i, k) = 0.0
-      fv(i, k) = 0.0
-      tvp(i, k) = 0.0
-      tp(i, k) = 0.0
-      clw(i, k) = 0.0
-      gz(i, k) = 0.
-    END DO
-  END DO
-  DO i = 1, len
-    precip(i) = 0.0
-    iflag(i) = 0
-  END DO
-
-  ! =====================================================================
-  ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
-  ! =====================================================================
-  DO k = 1, nl + 1
-    DO i = 1, len
-      lv(i, k) = lv0 - clmcpv*(t(i,k)-273.15)
-      cpn(i, k) = cpd*(1.0-q(i,k)) + cpv*q(i, k)
-      cpx(i, k) = cpd*(1.0-q(i,k)) + cl*q(i, k)
-      tv(i, k) = t(i, k)*(1.0+q(i,k)*epsim1)
-    END DO
-  END DO
-
-  ! gz = phi at the full levels (same as p).
-
-  DO i = 1, len
-    gz(i, 1) = 0.0
-  END DO
-  DO k = 2, nlp
-    DO i = 1, len
-      gz(i, k) = gz(i, k-1) + hrd*(tv(i,k-1)+tv(i,k))*(p(i,k-1)-p(i,k))/ph(i, &
-        k)
-    END DO
-  END DO
-
-  ! h  = phi + cpT (dry static energy).
-  ! hm = phi + cp(T-Tbase)+Lq
-
-  DO k = 1, nlp
-    DO i = 1, len
-      h(i, k) = gz(i, k) + cpn(i, k)*t(i, k)
-      hm(i, k) = gz(i, k) + cpx(i, k)*(t(i,k)-t(i,1)) + lv(i, k)*q(i, k)
-    END DO
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Find level of minimum moist static energy
-  ! --- If level of minimum moist static energy coincides with
-  ! --- or is lower than minimum allowable parcel origin level,
-  ! --- set iflag to 6.
-  ! -------------------------------------------------------------------
-  DO i = 1, len
-    work(i) = 1.0E12
-    ihmin(i) = nl
-  END DO
-  DO k = 2, nlp
-    DO i = 1, len
-      IF ((hm(i,k)<work(i)) .AND. (hm(i,k)<hm(i,k-1))) THEN
-        work(i) = hm(i, k)
-        ihmin(i) = k
-      END IF
-    END DO
-  END DO
-  DO i = 1, len
-    ihmin(i) = min(ihmin(i), nlm)
-    IF (ihmin(i)<=minorig) THEN
-      iflag(i) = 6
-    END IF
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Find that model level below the level of minimum moist static
-  ! --- energy that has the maximum value of moist static energy
-  ! -------------------------------------------------------------------
-
-  DO i = 1, len
-    work(i) = hm(i, minorig)
-    nk(i) = minorig
-  END DO
-  DO k = minorig + 1, nl
-    DO i = 1, len
-      IF ((hm(i,k)>work(i)) .AND. (k<=ihmin(i))) THEN
-        work(i) = hm(i, k)
-        nk(i) = k
-      END IF
-    END DO
-  END DO
-  ! -------------------------------------------------------------------
-  ! --- Check whether parcel level temperature and specific humidity
-  ! --- are reasonable
-  ! -------------------------------------------------------------------
-  DO i = 1, len
-    IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0) .OR. (p(i,ihmin(i))< &
-      400.0)) .AND. (iflag(i)==0)) iflag(i) = 7
-  END DO
-  ! -------------------------------------------------------------------
-  ! --- Calculate lifted condensation level of air at parcel origin level
-  ! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)
-  ! -------------------------------------------------------------------
-  DO i = 1, len
-    tnk(i) = t(i, nk(i))
-    qnk(i) = q(i, nk(i))
-    gznk(i) = gz(i, nk(i))
-    pnk(i) = p(i, nk(i))
-    qsnk(i) = qs(i, nk(i))
-
-    rh(i) = qnk(i)/qsnk(i)
-    rh(i) = min(1.0, rh(i))
-    chi(i) = tnk(i)/(1669.0-122.0*rh(i)-tnk(i))
-    plcl(i) = pnk(i)*(rh(i)**chi(i))
-    IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) iflag(i &
-      ) = 8
-  END DO
-  ! -------------------------------------------------------------------
-  ! --- Calculate first level above lcl (=icb)
-  ! -------------------------------------------------------------------
-  DO i = 1, len
-    icb(i) = nlm
-  END DO
-
-  DO k = minorig, nl
-    DO i = 1, len
-      IF ((k>=(nk(i)+1)) .AND. (p(i,k)<plcl(i))) icb(i) = min(icb(i), k)
-    END DO
-  END DO
-
-  DO i = 1, len
-    IF ((icb(i)>=nlm) .AND. (iflag(i)==0)) iflag(i) = 9
-  END DO
-
-  ! Compute icbmax.
-
-  icbmax = 2
-  DO i = 1, len
-    icbmax = max(icbmax, icb(i))
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Calculates the lifted parcel virtual temperature at nk,
-  ! --- the actual temperature, and the adiabatic
-  ! --- liquid water content. The procedure is to solve the equation.
-  ! cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-  ! -------------------------------------------------------------------
-
-  DO i = 1, len
-    tnk(i) = t(i, nk(i))
-    qnk(i) = q(i, nk(i))
-    gznk(i) = gz(i, nk(i))
-    ticb(i) = t(i, icb(i))
-    gzicb(i) = gz(i, icb(i))
-  END DO
-
-  ! ***  Calculate certain parcel quantities, including static energy   ***
-
-  DO i = 1, len
-    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) + qnk(i)*(lv0-clmcpv*(tnk(i)- &
-      273.15)) + gznk(i)
-    cpp(i) = cpd*(1.-qnk(i)) + qnk(i)*cpv
-  END DO
-
-  ! ***   Calculate lifted parcel quantities below cloud base   ***
-
-  DO k = minorig, icbmax - 1
-    DO i = 1, len
-      tp(i, k) = tnk(i) - (gz(i,k)-gznk(i))/cpp(i)
-      tvp(i, k) = tp(i, k)*(1.+qnk(i)*epsi)
-    END DO
-  END DO
-
-  ! ***  Find lifted parcel quantities above cloud base    ***
-
-  DO i = 1, len
-    tg = ticb(i)
-    qg = qs(i, icb(i))
-    alv = lv0 - clmcpv*(ticb(i)-273.15)
-
-    ! First iteration.
-
-    s = cpd + alv*alv*qg/(rv*ticb(i)*ticb(i))
-    s = 1./s
-    ahg = cpd*tg + (cl-cpd)*qnk(i)*ticb(i) + alv*qg + gzicb(i)
-    tg = tg + s*(ah0(i)-ahg)
-    tg = max(tg, 35.0)
-    tc = tg - 273.15
-    denom = 243.5 + tc
-    IF (tc>=0.0) THEN
-      es = 6.112*exp(17.67*tc/denom)
-    ELSE
-      es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
-    END IF
-    qg = eps*es/(p(i,icb(i))-es*(1.-eps))
-
-    ! Second iteration.
-
-    s = cpd + alv*alv*qg/(rv*ticb(i)*ticb(i))
-    s = 1./s
-    ahg = cpd*tg + (cl-cpd)*qnk(i)*ticb(i) + alv*qg + gzicb(i)
-    tg = tg + s*(ah0(i)-ahg)
-    tg = max(tg, 35.0)
-    tc = tg - 273.15
-    denom = 243.5 + tc
-    IF (tc>=0.0) THEN
-      es = 6.112*exp(17.67*tc/denom)
-    ELSE
-      es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
-    END IF
-    qg = eps*es/(p(i,icb(i))-es*(1.-eps))
-
-    alv = lv0 - clmcpv*(ticb(i)-273.15)
-    tp(i, icb(i)) = (ah0(i)-(cl-cpd)*qnk(i)*ticb(i)-gz(i,icb(i))-alv*qg)/cpd
-    clw(i, icb(i)) = qnk(i) - qg
-    clw(i, icb(i)) = max(0.0, clw(i,icb(i)))
-    rg = qg/(1.-qnk(i))
-    tvp(i, icb(i)) = tp(i, icb(i))*(1.+rg*epsi)
-  END DO
-
-  DO k = minorig, icbmax
-    DO i = 1, len
-      tvp(i, k) = tvp(i, k) - tp(i, k)*qnk(i)
-    END DO
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Test for instability.
-  ! --- If there was no convection at last time step and parcel
-  ! --- is stable at icb, then set iflag to 4.
-  ! -------------------------------------------------------------------
-
-  DO i = 1, len
-    IF ((cbmf(i)==0.0) .AND. (iflag(i)==0) .AND. (tvp(i, &
-      icb(i))<=(tv(i,icb(i))-dtmax))) iflag(i) = 4
-  END DO
-
-  ! =====================================================================
-  ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
-  ! =====================================================================
-
-  ncum = 0
-  DO i = 1, len
-    IF (iflag(i)==0) THEN
-      ncum = ncum + 1
-      idcum(ncum) = i
-    END IF
-  END DO
-
-  ! Call convect2, which compresses the points and computes the heating,
-  ! moistening, velocity mixing, and precipiation.
-
-  ! print*,'cpd avant convect2 ',cpd
-  IF (ncum>0) THEN
-    CALL convect2(ncum, idcum, len, nd, ndp1, nl, minorig, nk, icb, t, q, qs, &
-      u, v, gz, tv, tp, tvp, clw, h, lv, cpn, p, ph, ft, fq, fu, fv, tnk, &
-      qnk, gznk, plcl, precip, cbmf, iflag, delt, cpd, cpv, cl, rv, rd, lv0, &
-      g, sigs, sigd, elcrit, tlcrit, omtsnow, dtmax, damp, alpha, entp, &
-      coeffs, coeffr, omtrain, cu, ma)
-  END IF
-
-  RETURN
-END SUBROUTINE convect1
+link ../phylmd/convect1.F90
Index: LMDZ6/trunk/libf/phylmdiso/convect2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/convect2.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/convect2.F90	(revision 3940)
@@ -1,1373 +1,1 @@
-
-! $Id: convect2.F90 2346 2015-08-21 15:13:46Z emillour $
-
-SUBROUTINE convect2(ncum, idcum, len, nd, ndp1, nl, minorig, nk1, icb1, t1, &
-    q1, qs1, u1, v1, gz1, tv1, tp1, tvp1, clw1, h1, lv1, cpn1, p1, ph1, ft1, &
-    fq1, fu1, fv1, tnk1, qnk1, gznk1, plcl1, precip1, cbmf1, iflag1, delt, &
-    cpd, cpv, cl, rv, rd, lv0, g, sigs, sigd, elcrit, tlcrit, omtsnow, dtmax, &
-    damp, alpha, entp, coeffs, coeffr, omtrain, cu, ma)
-  ! .............................START PROLOGUE............................
-
-  ! SCCS IDENTIFICATION:  @(#)convect2.f	1.2 05/18/00
-  ! 22:06:22 /h/cm/library/nogaps4/src/sub/fcst/convect2.f_v
-
-  ! CONFIGURATION IDENTIFICATION:  None
-
-  ! MODULE NAME:  convect2
-
-  ! DESCRIPTION:
-
-  ! convect1     The Emanuel Cumulus Convection Scheme - compute tendencies
-
-  ! CONTRACT NUMBER AND TITLE:  None
-
-  ! REFERENCES: Programmers  K. Emanuel (MIT), Timothy F. Hogan, M. Peng
-  ! (NRL)
-
-  ! CLASSIFICATION:  Unclassified
-
-  ! RESTRICTIONS: None
-
-  ! COMPILER DEPENDENCIES: FORTRAN 77, FORTRAN 90
-
-  ! COMPILE OPTIONS: Fortran 77: -Zu -Wf"-ei -o aggress"
-  ! Fortran 90: -O vector3,scalar3,task1,aggress,overindex  -ei -r 2
-
-  ! LIBRARIES OF RESIDENCE: /a/ops/lib/libfcst159.a
-
-  ! USAGE: call convect2(ncum,idcum,len,nd,nl,minorig,
-  ! &                 nk1,icb1,
-  ! &                 t1,q1,qs1,u1,v1,gz1,tv1,tp1,tvp1,clw1,h1,
-  ! &                 lv1,cpn1,p1,ph1,ft1,fq1,fu1,fv1,
-  ! &                 tnk1,qnk1,gznk1,plcl1,
-  ! &                 precip1,cbmf1,iflag1,
-  ! &                 delt,cpd,cpv,cl,rv,rd,lv0,g,
-  ! &                 sigs,sigd,elcrit,tlcrit,omtsnow,dtmax,damp,
-  ! &                 alpha,entp,coeffs,coeffr,omtrain,cu)
-
-  ! PARAMETERS:
-  ! Name            Type         Usage            Description
-  ! ----------      ----------     -------  ----------------------------
-
-  ! ncum          Integer        Input        number of cumulus points
-  ! idcum         Integer        Input        index of cumulus point
-  ! len           Integer        Input        first dimension
-  ! nd            Integer        Input        total vertical dimension
-  ! ndp1          Integer        Input        nd + 1
-  ! nl            Integer        Input        vertical dimension for
-  ! convection
-  ! minorig       Integer        Input        First level where convection is
-  ! allow to begin
-  ! nk1           Integer        Input        First level of convection
-  ! ncb1          Integer        Input        Level of free convection
-  ! t1            Real           Input        temperature
-  ! q1            Real           Input        specific hum
-  ! qs1           Real           Input        sat specific hum
-  ! u1            Real           Input        u-wind
-  ! v1            Real           Input        v-wind
-  ! gz1           Real           Inout        geop
-  ! tv1           Real           Input        virtual temp
-  ! tp1           Real           Input
-  ! clw1          Real           Inout        cloud liquid water
-  ! h1            Real           Inout
-  ! lv1           Real           Inout
-  ! cpn1          Real           Inout
-  ! p1            Real           Input        full level pressure
-  ! ph1           Real           Input        half level pressure
-  ! ft1           Real           Output       temp tend
-  ! fq1           Real           Output       spec hum tend
-  ! fu1           Real           Output       u-wind tend
-  ! fv1           Real           Output       v-wind tend
-  ! precip1       Real           Output       prec
-  ! cbmf1         Real           In/Out       cumulus mass flux
-  ! iflag1        Integer        Output       iflag on latitude strip
-  ! delt          Real           Input        time step
-  ! cpd           Integer        Input        See description below
-  ! cpv           Integer        Input        See description below
-  ! cl            Integer        Input        See description below
-  ! rv            Integer        Input        See description below
-  ! rd            Integer        Input        See description below
-  ! lv0           Integer        Input        See description below
-  ! g             Integer        Input        See description below
-  ! sigs          Integer        Input        See description below
-  ! sigd          Integer        Input        See description below
-  ! elcrit        Integer        Input        See description below
-  ! tlcrit        Integer        Input        See description below
-  ! omtsnow       Integer        Input        See description below
-  ! dtmax         Integer        Input        See description below
-  ! damp          Integer        Input        See description below
-  ! alpha         Integer        Input        See description below
-  ! ent           Integer        Input        See description below
-  ! coeffs        Integer        Input        See description below
-  ! coeffr        Integer        Input        See description below
-  ! omtrain       Integer        Input        See description below
-  ! cu            Integer        Input        See description below
-
-  ! COMMON BLOCKS:
-  ! Block      Name     Type    Usage              Notes
-  ! --------  --------   ----    ------   ------------------------
-
-  ! FILES: None
-
-  ! DATA BASES: None
-
-  ! NON-FILE INPUT/OUTPUT: None
-
-  ! ERROR CONDITIONS: None
-
-  ! ADDITIONAL COMMENTS: None
-
-  ! .................MAINTENANCE SECTION................................
-
-  ! MODULES CALLED:
-  ! Name           Description
-  ! zilch        Zero out an array
-  ! -------     ----------------------
-  ! LOCAL VARIABLES AND
-  ! STRUCTURES:
-  ! Name     Type    Description
-  ! -------  ------  -----------
-  ! See Comments Below
-
-  ! i        Integer loop index
-  ! k        Integer loop index
-
-  ! METHOD:
-
-  ! See Emanuel, K. and M. Zivkovic-Rothman, 2000: Development and evaluation
-  ! of a
-  ! convective scheme for use in climate models.
-
-  ! FILES: None
-
-  ! INCLUDE FILES: None
-
-  ! MAKEFILE: /a/ops/met/nogaps/src/sub/fcst/fcst159lib.mak
-
-  ! ..............................END PROLOGUE.............................
-
-
-  USE dimphy
-  IMPLICIT NONE
-
-  INTEGER kmax2, imax2, kmin2, imin2
-  REAL ftmax2, ftmin2
-  INTEGER kmax, imax, kmin, imin
-  REAL ftmax, ftmin
-
-  INTEGER ncum
-  INTEGER len
-  INTEGER idcum(len)
-  INTEGER nd
-  INTEGER ndp1
-  INTEGER nl
-  INTEGER minorig
-  INTEGER nk1(len)
-  INTEGER icb1(len)
-  REAL t1(len, nd)
-  REAL q1(len, nd)
-  REAL qs1(len, nd)
-  REAL u1(len, nd)
-  REAL v1(len, nd)
-  REAL gz1(len, nd)
-  REAL tv1(len, nd)
-  REAL tp1(len, nd)
-  REAL tvp1(len, nd)
-  REAL clw1(len, nd)
-  REAL h1(len, nd)
-  REAL lv1(len, nd)
-  REAL cpn1(len, nd)
-  REAL p1(len, nd)
-  REAL ph1(len, ndp1)
-  REAL ft1(len, nd)
-  REAL fq1(len, nd)
-  REAL fu1(len, nd)
-  REAL fv1(len, nd)
-  REAL tnk1(len)
-  REAL qnk1(len)
-  REAL gznk1(len)
-  REAL precip1(len)
-  REAL cbmf1(len)
-  REAL plcl1(len)
-  INTEGER iflag1(len)
-  REAL delt
-  REAL cpd
-  REAL cpv
-  REAL cl
-  REAL rv
-  REAL rd
-  REAL lv0
-  REAL g
-  REAL sigs ! SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE
-  REAL sigd ! SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT
-  REAL elcrit ! ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm)
-  REAL tlcrit ! TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-
-  ! CONVERSION THRESHOLD IS ASSUMED TO BE ZERO
-  REAL omtsnow ! OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW
-  REAL dtmax ! DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION
-  ! A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC.
-  REAL damp
-  REAL alpha
-  REAL entp ! ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT FORMULATION
-  REAL coeffs ! COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION OF
-  ! SNOW
-  REAL coeffr ! COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION OF
-  ! RAIN
-  REAL omtrain ! OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN
-  REAL cu ! CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM TRANSPORT
-
-  REAL ma(len, nd)
-
-
-  ! *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
-  ! ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
-  ! ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
-  ! ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
-  ! ***               BETWEEN 0 C AND TLCRIT)                        ***
-  ! ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
-  ! ***                       FORMULATION                            ***
-  ! ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-  ! ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
-  ! ***                        OF CLOUD                              ***
-  ! ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
-  ! ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
-  ! ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-  ! ***                          OF RAIN                             ***
-  ! ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-  ! ***                          OF SNOW                             ***
-  ! ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
-  ! ***                         TRANSPORT                            ***
-  ! ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
-  ! ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
-  ! ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-  ! ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-  ! ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
-  ! ***                   (DAMP MUST BE LESS THAN 1)                 ***
-
-  ! Local arrays.
-
-  REAL work(ncum)
-  REAL t(ncum, klev)
-  REAL q(ncum, klev)
-  REAL qs(ncum, klev)
-  REAL u(ncum, klev)
-  REAL v(ncum, klev)
-  REAL gz(ncum, klev)
-  REAL h(ncum, klev)
-  REAL lv(ncum, klev)
-  REAL cpn(ncum, klev)
-  REAL p(ncum, klev)
-  REAL ph(ncum, klev)
-  REAL ft(ncum, klev)
-  REAL fq(ncum, klev)
-  REAL fu(ncum, klev)
-  REAL fv(ncum, klev)
-  REAL precip(ncum)
-  REAL cbmf(ncum)
-  REAL plcl(ncum)
-  REAL tnk(ncum)
-  REAL qnk(ncum)
-  REAL gznk(ncum)
-  REAL tv(ncum, klev)
-  REAL tp(ncum, klev)
-  REAL tvp(ncum, klev)
-  REAL clw(ncum, klev)
-  ! real det(ncum,klev)
-  REAL dph(ncum, klev)
-  ! real wd(ncum)
-  ! real tprime(ncum)
-  ! real qprime(ncum)
-  REAL ah0(ncum)
-  REAL ep(ncum, klev)
-  REAL sigp(ncum, klev)
-  INTEGER nent(ncum, klev)
-  REAL water(ncum, klev)
-  REAL evap(ncum, klev)
-  REAL mp(ncum, klev)
-  REAL m(ncum, klev)
-  REAL qti
-  REAL wt(ncum, klev)
-  REAL hp(ncum, klev)
-  REAL lvcp(ncum, klev)
-  REAL elij(ncum, klev, klev)
-  REAL ment(ncum, klev, klev)
-  REAL sij(ncum, klev, klev)
-  REAL qent(ncum, klev, klev)
-  REAL uent(ncum, klev, klev)
-  REAL vent(ncum, klev, klev)
-  REAL qp(ncum, klev)
-  REAL up(ncum, klev)
-  REAL vp(ncum, klev)
-  REAL cape(ncum)
-  REAL capem(ncum)
-  REAL frac(ncum)
-  REAL dtpbl(ncum)
-  REAL tvpplcl(ncum)
-  REAL tvaplcl(ncum)
-  REAL dtmin(ncum)
-  REAL w3d(ncum, klev)
-  REAL am(ncum)
-  REAL ents(ncum)
-  REAL uav(ncum)
-  REAL vav(ncum)
-
-  INTEGER iflag(ncum)
-  INTEGER nk(ncum)
-  INTEGER icb(ncum)
-  INTEGER inb(ncum)
-  INTEGER inb1(ncum)
-  INTEGER jtt(ncum)
-
-  INTEGER nn, i, k, n, icbmax, nlp, j
-  INTEGER ij
-  INTEGER nn2, nn3
-  REAL clmcpv
-  REAL clmcpd
-  REAL cpdmcp
-  REAL cpvmcpd
-  REAL eps
-  REAL epsi
-  REAL epsim1
-  REAL tg, qg, s, alv, tc, ahg, denom, es, rg, ginv, rowl
-  REAL delti
-  REAL tca, elacrit
-  REAL by, defrac
-  ! real byp
-  REAL byp(ncum)
-  LOGICAL lcape(ncum)
-  REAL dbo
-  REAL bf2, anum, dei, altem, cwat, stemp
-  REAL alt, qp1, smid, sjmax, sjmin
-  REAL delp, delm
-  REAL awat, coeff, afac, revap, dhdp, fac, qstm, rat
-  REAL qsm, sigt, b6, c6
-  REAL dpinv, cpinv
-  REAL fqold, ftold, fuold, fvold
-  REAL wdtrain(ncum), xxx
-  REAL bsum(ncum, klev)
-  REAL asij(ncum)
-  REAL smin(ncum)
-  REAL scrit(ncum)
-  ! real amp1,ad
-  REAL amp1(ncum), ad(ncum)
-  LOGICAL lwork(ncum)
-  INTEGER num1, num2
-
-  ! print*,'cpd en entree de convect2 ',cpd
-  nlp = nl + 1
-
-  rowl = 1000.0
-  ginv = 1.0/g
-  delti = 1.0/delt
-
-  ! Define some thermodynamic variables.
-
-  clmcpv = cl - cpv
-  clmcpd = cl - cpd
-  cpdmcp = cpd - cpv
-  cpvmcpd = cpv - cpd
-  eps = rd/rv
-  epsi = 1.0/eps
-  epsim1 = epsi - 1.0
-
-  ! Compress the fields.
-
-  DO k = 1, nl + 1
-    nn = 0
-    DO i = 1, len
-      IF (iflag1(i)==0) THEN
-        nn = nn + 1
-        t(nn, k) = t1(i, k)
-        q(nn, k) = q1(i, k)
-        qs(nn, k) = qs1(i, k)
-        u(nn, k) = u1(i, k)
-        v(nn, k) = v1(i, k)
-        gz(nn, k) = gz1(i, k)
-        h(nn, k) = h1(i, k)
-        lv(nn, k) = lv1(i, k)
-        cpn(nn, k) = cpn1(i, k)
-        p(nn, k) = p1(i, k)
-        ph(nn, k) = ph1(i, k)
-        tv(nn, k) = tv1(i, k)
-        tp(nn, k) = tp1(i, k)
-        tvp(nn, k) = tvp1(i, k)
-        clw(nn, k) = clw1(i, k)
-      END IF
-    END DO
-    ! print*,'100 ncum,nn',ncum,nn
-  END DO
-  nn = 0
-  DO i = 1, len
-    IF (iflag1(i)==0) THEN
-      nn = nn + 1
-      cbmf(nn) = cbmf1(i)
-      plcl(nn) = plcl1(i)
-      tnk(nn) = tnk1(i)
-      qnk(nn) = qnk1(i)
-      gznk(nn) = gznk1(i)
-      nk(nn) = nk1(i)
-      icb(nn) = icb1(i)
-      iflag(nn) = iflag1(i)
-    END IF
-  END DO
-  ! print*,'150 ncum,nn',ncum,nn
-
-  ! Initialize the tendencies, det, wd, tprime, qprime.
-
-  DO k = 1, nl
-    DO i = 1, ncum
-      ! det(i,k)=0.0
-      ft(i, k) = 0.0
-      fu(i, k) = 0.0
-      fv(i, k) = 0.0
-      fq(i, k) = 0.0
-      dph(i, k) = ph(i, k) - ph(i, k+1)
-      ep(i, k) = 0.0
-      sigp(i, k) = sigs
-    END DO
-  END DO
-  DO i = 1, ncum
-    ! wd(i)=0.0
-    ! tprime(i)=0.0
-    ! qprime(i)=0.0
-    precip(i) = 0.0
-    ft(i, nl+1) = 0.0
-    fu(i, nl+1) = 0.0
-    fv(i, nl+1) = 0.0
-    fq(i, nl+1) = 0.0
-  END DO
-
-  ! Compute icbmax.
-
-  icbmax = 2
-  DO i = 1, ncum
-    icbmax = max(icbmax, icb(i))
-  END DO
-
-
-  ! =====================================================================
-  ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-  ! =====================================================================
-
-  ! ---       The procedure is to solve the equation.
-  ! cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-
-  ! ***  Calculate certain parcel quantities, including static energy   ***
-
-
-  DO i = 1, ncum
-    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) + qnk(i)*(lv0-clmcpv*(tnk(i)- &
-      273.15)) + gznk(i)
-  END DO
-
-
-  ! ***  Find lifted parcel quantities above cloud base    ***
-
-
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-      IF (k>=(icb(i)+1)) THEN
-        tg = t(i, k)
-        qg = qs(i, k)
-        alv = lv0 - clmcpv*(t(i,k)-273.15)
-
-        ! First iteration.
-
-        s = cpd + alv*alv*qg/(rv*t(i,k)*t(i,k))
-        s = 1./s
-        ahg = cpd*tg + (cl-cpd)*qnk(i)*t(i, k) + alv*qg + gz(i, k)
-        tg = tg + s*(ah0(i)-ahg)
-        tg = max(tg, 35.0)
-        tc = tg - 273.15
-        denom = 243.5 + tc
-        IF (tc>=0.0) THEN
-          es = 6.112*exp(17.67*tc/denom)
-        ELSE
-          es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
-        END IF
-        qg = eps*es/(p(i,k)-es*(1.-eps))
-
-        ! Second iteration.
-
-        s = cpd + alv*alv*qg/(rv*t(i,k)*t(i,k))
-        s = 1./s
-        ahg = cpd*tg + (cl-cpd)*qnk(i)*t(i, k) + alv*qg + gz(i, k)
-        tg = tg + s*(ah0(i)-ahg)
-        tg = max(tg, 35.0)
-        tc = tg - 273.15
-        denom = 243.5 + tc
-        IF (tc>=0.0) THEN
-          es = 6.112*exp(17.67*tc/denom)
-        ELSE
-          es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
-        END IF
-        qg = eps*es/(p(i,k)-es*(1.-eps))
-
-        alv = lv0 - clmcpv*(t(i,k)-273.15)
-        ! print*,'cpd dans convect2 ',cpd
-        ! print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
-        ! print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
-        tp(i, k) = (ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-        ! if (.not.cpd.gt.1000.) then
-        ! print*,'CPD=',cpd
-        ! stop
-        ! endif
-        clw(i, k) = qnk(i) - qg
-        clw(i, k) = max(0.0, clw(i,k))
-        rg = qg/(1.-qnk(i))
-        tvp(i, k) = tp(i, k)*(1.+rg*epsi)
-      END IF
-    END DO
-  END DO
-
-  ! =====================================================================
-  ! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
-  ! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
-  ! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
-  ! =====================================================================
-
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-      IF (k>=(nk(i)+1)) THEN
-        tca = tp(i, k) - 273.15
-        IF (tca>=0.0) THEN
-          elacrit = elcrit
-        ELSE
-          elacrit = elcrit*(1.0-tca/tlcrit)
-        END IF
-        elacrit = max(elacrit, 0.0)
-        ep(i, k) = 1.0 - elacrit/max(clw(i,k), 1.0E-8)
-        ep(i, k) = max(ep(i,k), 0.0)
-        ep(i, k) = min(ep(i,k), 1.0)
-        sigp(i, k) = sigs
-      END IF
-    END DO
-  END DO
-
-  ! =====================================================================
-  ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
-  ! --- VIRTUAL TEMPERATURE
-  ! =====================================================================
-
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-      IF (k>=(icb(i)+1)) THEN
-        tvp(i, k) = tvp(i, k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
-        ! print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
-        ! print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
-      END IF
-    END DO
-  END DO
-  DO i = 1, ncum
-    tvp(i, nlp) = tvp(i, nl) - (gz(i,nlp)-gz(i,nl))/cpd
-  END DO
-
-
-  ! =====================================================================
-  ! --- NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-  ! =====================================================================
-
-  DO i = 1, ncum*nlp
-    nent(i, 1) = 0
-    water(i, 1) = 0.0
-    evap(i, 1) = 0.0
-    mp(i, 1) = 0.0
-    m(i, 1) = 0.0
-    wt(i, 1) = omtsnow
-    hp(i, 1) = h(i, 1)
-    ! if(.not.cpn(i,1).gt.900.) then
-    ! print*,'i,lv(i,1),cpn(i,1)'
-    ! print*, i,lv(i,1),cpn(i,1)
-    ! k=(i-1)/ncum+1
-    ! print*,'i,k',mod(i,ncum),k,'  cpn',cpn(mod(i,ncum),k)
-    ! stop
-    ! endif
-    lvcp(i, 1) = lv(i, 1)/cpn(i, 1)
-  END DO
-
-  DO i = 1, ncum*nlp*nlp
-    elij(i, 1, 1) = 0.0
-    ment(i, 1, 1) = 0.0
-    sij(i, 1, 1) = 0.0
-  END DO
-
-  DO k = 1, nlp
-    DO j = 1, nlp
-      DO i = 1, ncum
-        qent(i, k, j) = q(i, j)
-        uent(i, k, j) = u(i, j)
-        vent(i, k, j) = v(i, j)
-      END DO
-    END DO
-  END DO
-
-  DO i = 1, ncum
-    qp(i, 1) = q(i, 1)
-    up(i, 1) = u(i, 1)
-    vp(i, 1) = v(i, 1)
-  END DO
-  DO k = 2, nlp
-    DO i = 1, ncum
-      qp(i, k) = q(i, k-1)
-      up(i, k) = u(i, k-1)
-      vp(i, k) = v(i, k-1)
-    END DO
-  END DO
-
-  ! =====================================================================
-  ! --- FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S
-  ! --- HIGHEST LEVEL OF NEUTRAL BUOYANCY
-  ! --- AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)
-  ! =====================================================================
-
-  DO i = 1, ncum
-    cape(i) = 0.0
-    capem(i) = 0.0
-    inb(i) = icb(i) + 1
-    inb1(i) = inb(i)
-  END DO
-
-  ! Originial Code
-
-  ! do 530 k=minorig+1,nl-1
-  ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
-  ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-  ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
-  ! inb(i)=k+1
-  ! capem(i)=cape(i)
-  ! endif
-  ! endif
-  ! 520    continue
-  ! 530  continue
-  ! do 540 i=1,ncum
-  ! byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
-  ! cape(i)=capem(i)+byp
-  ! defrac=capem(i)-cape(i)
-  ! defrac=max(defrac,0.001)
-  ! frac(i)=-cape(i)/defrac
-  ! frac(i)=min(frac(i),1.0)
-  ! frac(i)=max(frac(i),0.0)
-  ! 540   continue
-
-  ! K Emanuel fix
-
-  ! call zilch(byp,ncum)
-  ! do 530 k=minorig+1,nl-1
-  ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
-  ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-  ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
-  ! inb(i)=k+1
-  ! capem(i)=cape(i)
-  ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! endif
-  ! endif
-  ! 520    continue
-  ! 530  continue
-  ! do 540 i=1,ncum
-  ! inb(i)=max(inb(i),inb1(i))
-  ! cape(i)=capem(i)+byp(i)
-  ! defrac=capem(i)-cape(i)
-  ! defrac=max(defrac,0.001)
-  ! frac(i)=-cape(i)/defrac
-  ! frac(i)=min(frac(i),1.0)
-  ! frac(i)=max(frac(i),0.0)
-  ! 540   continue
-
-  ! J Teixeira fix
-
-  CALL zilch(byp, ncum)
-  DO i = 1, ncum
-    lcape(i) = .TRUE.
-  END DO
-  DO k = minorig + 1, nl - 1
-    DO i = 1, ncum
-      IF (cape(i)<0.0) lcape(i) = .FALSE.
-      IF ((k>=(icb(i)+1)) .AND. lcape(i)) THEN
-        by = (tvp(i,k)-tv(i,k))*dph(i, k)/p(i, k)
-        byp(i) = (tvp(i,k+1)-tv(i,k+1))*dph(i, k+1)/p(i, k+1)
-        cape(i) = cape(i) + by
-        IF (by>=0.0) inb1(i) = k + 1
-        IF (cape(i)>0.0) THEN
-          inb(i) = k + 1
-          capem(i) = cape(i)
-        END IF
-      END IF
-    END DO
-  END DO
-  DO i = 1, ncum
-    cape(i) = capem(i) + byp(i)
-    defrac = capem(i) - cape(i)
-    defrac = max(defrac, 0.001)
-    frac(i) = -cape(i)/defrac
-    frac(i) = min(frac(i), 1.0)
-    frac(i) = max(frac(i), 0.0)
-  END DO
-
-  ! =====================================================================
-  ! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
-  ! =====================================================================
-
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-      IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
-        hp(i, k) = h(i, nk(i)) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k &
-          )
-      END IF
-    END DO
-  END DO
-
-  ! =====================================================================
-  ! ---  CALCULATE CLOUD BASE MASS FLUX AND RATES OF MIXING, M(I),
-  ! --- AT EACH MODEL LEVEL
-  ! =====================================================================
-
-  ! tvpplcl = parcel temperature lifted adiabatically from level
-  ! icb-1 to the LCL.
-  ! tvaplcl = virtual temperature at the LCL.
-
-  DO i = 1, ncum
-    dtpbl(i) = 0.0
-    tvpplcl(i) = tvp(i, icb(i)-1) - rd*tvp(i, icb(i)-1)*(p(i,icb(i)-1)-plcl(i &
-      ))/(cpn(i,icb(i)-1)*p(i,icb(i)-1))
-    tvaplcl(i) = tv(i, icb(i)) + (tvp(i,icb(i))-tvp(i,icb(i)+1))*(plcl(i)-p(i &
-      ,icb(i)))/(p(i,icb(i))-p(i,icb(i)+1))
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Interpolate difference between lifted parcel and
-  ! --- environmental temperatures to lifted condensation level
-  ! -------------------------------------------------------------------
-
-  ! dtpbl = average of tvp-tv in the PBL (k=nk to icb-1).
-
-  DO k = minorig, icbmax
-    DO i = 1, ncum
-      IF ((k>=nk(i)) .AND. (k<=(icb(i)-1))) THEN
-        dtpbl(i) = dtpbl(i) + (tvp(i,k)-tv(i,k))*dph(i, k)
-      END IF
-    END DO
-  END DO
-  DO i = 1, ncum
-    dtpbl(i) = dtpbl(i)/(ph(i,nk(i))-ph(i,icb(i)))
-    dtmin(i) = tvpplcl(i) - tvaplcl(i) + dtmax + dtpbl(i)
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Adjust cloud base mass flux
-  ! -------------------------------------------------------------------
-
-  DO i = 1, ncum
-    work(i) = cbmf(i)
-    cbmf(i) = max(0.0, (1.0-damp)*cbmf(i)+0.1*alpha*dtmin(i))
-    IF ((work(i)==0.0) .AND. (cbmf(i)==0.0)) THEN
-      iflag(i) = 3
-    END IF
-  END DO
-
-  ! -------------------------------------------------------------------
-  ! --- Calculate rates of mixing,  m(i)
-  ! -------------------------------------------------------------------
-
-  CALL zilch(work, ncum)
-
-  DO j = minorig + 1, nl
-    DO i = 1, ncum
-      IF ((j>=(icb(i)+1)) .AND. (j<=inb(i))) THEN
-        k = min(j, inb1(i))
-        dbo = abs(tv(i,k+1)-tvp(i,k+1)-tv(i,k-1)+tvp(i,k-1)) + &
-          entp*0.04*(ph(i,k)-ph(i,k+1))
-        work(i) = work(i) + dbo
-        m(i, j) = cbmf(i)*dbo
-      END IF
-    END DO
-  END DO
-  DO k = minorig + 1, nl
-    DO i = 1, ncum
-      IF ((k>=(icb(i)+1)) .AND. (k<=inb(i))) THEN
-        m(i, k) = m(i, k)/work(i)
-      END IF
-    END DO
-  END DO
-
-
-  ! =====================================================================
-  ! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
-  ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
-  ! --- FRACTION (sij)
-  ! =====================================================================
-
-
-  DO i = minorig + 1, nl
-    DO j = minorig + 1, nl
-      DO ij = 1, ncum
-        IF ((i>=(icb(ij)+1)) .AND. (j>=icb(ij)) .AND. (i<=inb(ij)) .AND. (j<= &
-            inb(ij))) THEN
-          qti = qnk(ij) - ep(ij, i)*clw(ij, i)
-          bf2 = 1. + lv(ij, j)*lv(ij, j)*qs(ij, j)/(rv*t(ij,j)*t(ij,j)*cpd)
-          anum = h(ij, j) - hp(ij, i) + (cpv-cpd)*t(ij, j)*(qti-q(ij,j))
-          denom = h(ij, i) - hp(ij, i) + (cpd-cpv)*(q(ij,i)-qti)*t(ij, j)
-          dei = denom
-          IF (abs(dei)<0.01) dei = 0.01
-          sij(ij, i, j) = anum/dei
-          sij(ij, i, i) = 1.0
-          altem = sij(ij, i, j)*q(ij, i) + (1.-sij(ij,i,j))*qti - qs(ij, j)
-          altem = altem/bf2
-          cwat = clw(ij, j)*(1.-ep(ij,j))
-          stemp = sij(ij, i, j)
-          IF ((stemp<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
-            anum = anum - lv(ij, j)*(qti-qs(ij,j)-cwat*bf2)
-            denom = denom + lv(ij, j)*(q(ij,i)-qti)
-            IF (abs(denom)<0.01) denom = 0.01
-            sij(ij, i, j) = anum/denom
-            altem = sij(ij, i, j)*q(ij, i) + (1.-sij(ij,i,j))*qti - qs(ij, j)
-            altem = altem - (bf2-1.)*cwat
-          END IF
-          IF (sij(ij,i,j)>0.0 .AND. sij(ij,i,j)<0.9) THEN
-            qent(ij, i, j) = sij(ij, i, j)*q(ij, i) + (1.-sij(ij,i,j))*qti
-            uent(ij, i, j) = sij(ij, i, j)*u(ij, i) + &
-              (1.-sij(ij,i,j))*u(ij, nk(ij))
-            vent(ij, i, j) = sij(ij, i, j)*v(ij, i) + &
-              (1.-sij(ij,i,j))*v(ij, nk(ij))
-            elij(ij, i, j) = altem
-            elij(ij, i, j) = max(0.0, elij(ij,i,j))
-            ment(ij, i, j) = m(ij, i)/(1.-sij(ij,i,j))
-            nent(ij, i) = nent(ij, i) + 1
-          END IF
-          sij(ij, i, j) = max(0.0, sij(ij,i,j))
-          sij(ij, i, j) = min(1.0, sij(ij,i,j))
-        END IF
-      END DO
-    END DO
-
-    ! ***   If no air can entrain at level i assume that updraft detrains
-    ! ***
-    ! ***   at that level and calculate detrained air flux and properties
-    ! ***
-
-    DO ij = 1, ncum
-      IF ((i>=(icb(ij)+1)) .AND. (i<=inb(ij)) .AND. (nent(ij,i)==0)) THEN
-        ment(ij, i, i) = m(ij, i)
-        qent(ij, i, i) = q(ij, nk(ij)) - ep(ij, i)*clw(ij, i)
-        uent(ij, i, i) = u(ij, nk(ij))
-        vent(ij, i, i) = v(ij, nk(ij))
-        elij(ij, i, i) = clw(ij, i)
-        sij(ij, i, i) = 1.0
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, ncum
-    sij(i, inb(i), inb(i)) = 1.0
-  END DO
-
-  ! =====================================================================
-  ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
-  ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
-  ! =====================================================================
-
-
-  CALL zilch(bsum, ncum*nlp)
-  DO ij = 1, ncum
-    lwork(ij) = .FALSE.
-  END DO
-  DO i = minorig + 1, nl
-
-    num1 = 0
-    DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij))) num1 = num1 + 1
-    END DO
-    IF (num1<=0) GO TO 789
-
-    DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij))) THEN
-        lwork(ij) = (nent(ij,i)/=0)
-        qp1 = q(ij, nk(ij)) - ep(ij, i)*clw(ij, i)
-        anum = h(ij, i) - hp(ij, i) - lv(ij, i)*(qp1-qs(ij,i))
-        denom = h(ij, i) - hp(ij, i) + lv(ij, i)*(q(ij,i)-qp1)
-        IF (abs(denom)<0.01) denom = 0.01
-        scrit(ij) = anum/denom
-        alt = qp1 - qs(ij, i) + scrit(ij)*(q(ij,i)-qp1)
-        IF (scrit(ij)<0.0 .OR. alt<0.0) scrit(ij) = 1.0
-        asij(ij) = 0.0
-        smin(ij) = 1.0
-      END IF
-    END DO
-    DO j = minorig, nl
-
-      num2 = 0
-      DO ij = 1, ncum
-        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &
-          ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) num2 = num2 + 1
-      END DO
-      IF (num2<=0) GO TO 783
-
-      DO ij = 1, ncum
-        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &
-            ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) THEN
-          IF (sij(ij,i,j)>0.0 .AND. sij(ij,i,j)<0.9) THEN
-            IF (j>i) THEN
-              smid = min(sij(ij,i,j), scrit(ij))
-              sjmax = smid
-              sjmin = smid
-              IF (smid<smin(ij) .AND. sij(ij,i,j+1)<smid) THEN
-                smin(ij) = smid
-                sjmax = min(sij(ij,i,j+1), sij(ij,i,j), scrit(ij))
-                sjmin = max(sij(ij,i,j-1), sij(ij,i,j))
-                sjmin = min(sjmin, scrit(ij))
-              END IF
-            ELSE
-              sjmax = max(sij(ij,i,j+1), scrit(ij))
-              smid = max(sij(ij,i,j), scrit(ij))
-              sjmin = 0.0
-              IF (j>1) sjmin = sij(ij, i, j-1)
-              sjmin = max(sjmin, scrit(ij))
-            END IF
-            delp = abs(sjmax-smid)
-            delm = abs(sjmin-smid)
-            asij(ij) = asij(ij) + (delp+delm)*(ph(ij,j)-ph(ij,j+1))
-            ment(ij, i, j) = ment(ij, i, j)*(delp+delm)*(ph(ij,j)-ph(ij,j+1))
-          END IF
-        END IF
-      END DO
-783 END DO
-    DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. lwork(ij)) THEN
-        asij(ij) = max(1.0E-21, asij(ij))
-        asij(ij) = 1.0/asij(ij)
-        bsum(ij, i) = 0.0
-      END IF
-    END DO
-    DO j = minorig, nl + 1
-      DO ij = 1, ncum
-        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &
-            ij)) .AND. (j<=inb(ij)) .AND. lwork(ij)) THEN
-          ment(ij, i, j) = ment(ij, i, j)*asij(ij)
-          bsum(ij, i) = bsum(ij, i) + ment(ij, i, j)
-        END IF
-      END DO
-    END DO
-    DO ij = 1, ncum
-      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (bsum(ij, &
-          i)<1.0E-18) .AND. lwork(ij)) THEN
-        nent(ij, i) = 0
-        ment(ij, i, i) = m(ij, i)
-        qent(ij, i, i) = q(ij, nk(ij)) - ep(ij, i)*clw(ij, i)
-        uent(ij, i, i) = u(ij, nk(ij))
-        vent(ij, i, i) = v(ij, nk(ij))
-        elij(ij, i, i) = clw(ij, i)
-        sij(ij, i, i) = 1.0
-      END IF
-    END DO
-789 END DO
-
-  ! =====================================================================
-  ! --- PRECIPITATING DOWNDRAFT CALCULATION
-  ! =====================================================================
-
-  ! ***  Check whether ep(inb)=0, if so, skip precipitating    ***
-  ! ***             downdraft calculation                      ***
-
-
-  ! ***  Integrate liquid water equation to find condensed water   ***
-  ! ***                and condensed water flux                    ***
-
-
-  DO i = 1, ncum
-    jtt(i) = 2
-    IF (ep(i,inb(i))<=0.0001) iflag(i) = 2
-    IF (iflag(i)==0) THEN
-      lwork(i) = .TRUE.
-    ELSE
-      lwork(i) = .FALSE.
-    END IF
-  END DO
-
-  ! ***                    Begin downdraft loop                    ***
-
-
-  CALL zilch(wdtrain, ncum)
-  DO i = nl + 1, 1, -1
-
-    num1 = 0
-    DO ij = 1, ncum
-      IF ((i<=inb(ij)) .AND. lwork(ij)) num1 = num1 + 1
-    END DO
-    IF (num1<=0) GO TO 899
-
-
-    ! ***        Calculate detrained precipitation             ***
-
-    DO ij = 1, ncum
-      IF ((i<=inb(ij)) .AND. (lwork(ij))) THEN
-        wdtrain(ij) = g*ep(ij, i)*m(ij, i)*clw(ij, i)
-      END IF
-    END DO
-
-    IF (i>1) THEN
-      DO j = 1, i - 1
-        DO ij = 1, ncum
-          IF ((i<=inb(ij)) .AND. (lwork(ij))) THEN
-            awat = elij(ij, j, i) - (1.-ep(ij,i))*clw(ij, i)
-            awat = max(0.0, awat)
-            wdtrain(ij) = wdtrain(ij) + g*awat*ment(ij, j, i)
-          END IF
-        END DO
-      END DO
-    END IF
-
-    ! ***    Find rain water and evaporation using provisional   ***
-    ! ***              estimates of qp(i)and qp(i-1)             ***
-
-
-    ! ***  Value of terminal velocity and coeffecient of evaporation for snow
-    ! ***
-
-    DO ij = 1, ncum
-      IF ((i<=inb(ij)) .AND. (lwork(ij))) THEN
-        coeff = coeffs
-        wt(ij, i) = omtsnow
-
-        ! ***  Value of terminal velocity and coeffecient of evaporation for
-        ! rain   ***
-
-        IF (t(ij,i)>273.0) THEN
-          coeff = coeffr
-          wt(ij, i) = omtrain
-        END IF
-        qsm = 0.5*(q(ij,i)+qp(ij,i+1))
-        afac = coeff*ph(ij, i)*(qs(ij,i)-qsm)/(1.0E4+2.0E3*ph(ij,i)*qs(ij,i))
-        afac = max(afac, 0.0)
-        sigt = sigp(ij, i)
-        sigt = max(0.0, sigt)
-        sigt = min(1.0, sigt)
-        b6 = 100.*(ph(ij,i)-ph(ij,i+1))*sigt*afac/wt(ij, i)
-        c6 = (water(ij,i+1)*wt(ij,i+1)+wdtrain(ij)/sigd)/wt(ij, i)
-        revap = 0.5*(-b6+sqrt(b6*b6+4.*c6))
-        evap(ij, i) = sigt*afac*revap
-        water(ij, i) = revap*revap
-
-        ! ***  Calculate precipitating downdraft mass flux under     ***
-        ! ***              hydrostatic approximation                 ***
-
-        IF (i>1) THEN
-          dhdp = (h(ij,i)-h(ij,i-1))/(p(ij,i-1)-p(ij,i))
-          dhdp = max(dhdp, 10.0)
-          mp(ij, i) = 100.*ginv*lv(ij, i)*sigd*evap(ij, i)/dhdp
-          mp(ij, i) = max(mp(ij,i), 0.0)
-
-          ! ***   Add small amount of inertia to downdraft              ***
-
-          fac = 20.0/(ph(ij,i-1)-ph(ij,i))
-          mp(ij, i) = (fac*mp(ij,i+1)+mp(ij,i))/(1.+fac)
-
-          ! ***      Force mp to decrease linearly to zero
-          ! ***
-          ! ***      between about 950 mb and the surface
-          ! ***
-
-          IF (p(ij,i)>(0.949*p(ij,1))) THEN
-            jtt(ij) = max(jtt(ij), i)
-            mp(ij, i) = mp(ij, jtt(ij))*(p(ij,1)-p(ij,i))/ &
-              (p(ij,1)-p(ij,jtt(ij)))
-          END IF
-        END IF
-
-        ! ***       Find mixing ratio of precipitating downdraft     ***
-
-        IF (i/=inb(ij)) THEN
-          IF (i==1) THEN
-            qstm = qs(ij, 1)
-          ELSE
-            qstm = qs(ij, i-1)
-          END IF
-          IF (mp(ij,i)>mp(ij,i+1)) THEN
-            rat = mp(ij, i+1)/mp(ij, i)
-            qp(ij, i) = qp(ij, i+1)*rat + q(ij, i)*(1.0-rat) + &
-              100.*ginv*sigd*(ph(ij,i)-ph(ij,i+1))*(evap(ij,i)/mp(ij,i))
-            up(ij, i) = up(ij, i+1)*rat + u(ij, i)*(1.-rat)
-            vp(ij, i) = vp(ij, i+1)*rat + v(ij, i)*(1.-rat)
-          ELSE
-            IF (mp(ij,i+1)>0.0) THEN
-              qp(ij, i) = (gz(ij,i+1)-gz(ij,i)+qp(ij,i+1)*(lv(ij,i+1)+t(ij, &
-                i+1)*(cl-cpd))+cpd*(t(ij,i+1)-t(ij, &
-                i)))/(lv(ij,i)+t(ij,i)*(cl-cpd))
-              up(ij, i) = up(ij, i+1)
-              vp(ij, i) = vp(ij, i+1)
-            END IF
-          END IF
-          qp(ij, i) = min(qp(ij,i), qstm)
-          qp(ij, i) = max(qp(ij,i), 0.0)
-        END IF
-      END IF
-    END DO
-899 END DO
-
-  ! ***  Calculate surface precipitation in mm/day     ***
-
-  DO i = 1, ncum
-    IF (iflag(i)<=1) THEN
-      ! c            precip(i)=precip(i)+wt(i,1)*sigd*water(i,1)*3600.*24000.
-      ! c     &                /(rowl*g)
-      ! c            precip(i)=precip(i)*delt/86400.
-      precip(i) = wt(i, 1)*sigd*water(i, 1)*86400/g
-    END IF
-  END DO
-
-
-  ! ***  Calculate downdraft velocity scale and surface temperature and  ***
-  ! ***                    water vapor fluctuations                      ***
-
-  ! wd=beta*abs(mp(icb))*0.01*rd*t(icb)/(sigd*p(icb))
-  ! qprime=0.5*(qp(1)-q(1))
-  ! tprime=lv0*qprime/cpd
-
-  ! ***  Calculate tendencies of lowest level potential temperature  ***
-  ! ***                      and mixing ratio                        ***
-
-  DO i = 1, ncum
-    work(i) = 0.01/(ph(i,1)-ph(i,2))
-    am(i) = 0.0
-  END DO
-  DO k = 2, nl
-    DO i = 1, ncum
-      IF ((nk(i)==1) .AND. (k<=inb(i)) .AND. (nk(i)==1)) THEN
-        am(i) = am(i) + m(i, k)
-      END IF
-    END DO
-  END DO
-  DO i = 1, ncum
-    IF ((g*work(i)*am(i))>=delti) iflag(i) = 1
-    ft(i, 1) = ft(i, 1) + g*work(i)*am(i)*(t(i,2)-t(i,1)+(gz(i,2)-gz(i, &
-      1))/cpn(i,1))
-    ft(i, 1) = ft(i, 1) - lvcp(i, 1)*sigd*evap(i, 1)
-    ft(i, 1) = ft(i, 1) + sigd*wt(i, 2)*(cl-cpd)*water(i, 2)*(t(i,2)-t(i,1))* &
-      work(i)/cpn(i, 1)
-    fq(i, 1) = fq(i, 1) + g*mp(i, 2)*(qp(i,2)-q(i,1))*work(i) + &
-      sigd*evap(i, 1)
-    fq(i, 1) = fq(i, 1) + g*am(i)*(q(i,2)-q(i,1))*work(i)
-    fu(i, 1) = fu(i, 1) + g*work(i)*(mp(i,2)*(up(i,2)-u(i,1))+am(i)*(u(i, &
-      2)-u(i,1)))
-    fv(i, 1) = fv(i, 1) + g*work(i)*(mp(i,2)*(vp(i,2)-v(i,1))+am(i)*(v(i, &
-      2)-v(i,1)))
-  END DO
-  DO j = 2, nl
-    DO i = 1, ncum
-      IF (j<=inb(i)) THEN
-        fq(i, 1) = fq(i, 1) + g*work(i)*ment(i, j, 1)*(qent(i,j,1)-q(i,1))
-        fu(i, 1) = fu(i, 1) + g*work(i)*ment(i, j, 1)*(uent(i,j,1)-u(i,1))
-        fv(i, 1) = fv(i, 1) + g*work(i)*ment(i, j, 1)*(vent(i,j,1)-v(i,1))
-      END IF
-    END DO
-  END DO
-
-  ! ***  Calculate tendencies of potential temperature and mixing ratio  ***
-  ! ***               at levels above the lowest level                   ***
-
-  ! ***  First find the net saturated updraft and downdraft mass fluxes  ***
-  ! ***                      through each level                          ***
-
-  DO i = 2, nl + 1
-
-    num1 = 0
-    DO ij = 1, ncum
-      IF (i<=inb(ij)) num1 = num1 + 1
-    END DO
-    IF (num1<=0) GO TO 1500
-
-    CALL zilch(amp1, ncum)
-    CALL zilch(ad, ncum)
-
-    DO k = i + 1, nl + 1
-      DO ij = 1, ncum
-        IF ((i>=nk(ij)) .AND. (i<=inb(ij)) .AND. (k<=(inb(ij)+1))) THEN
-          amp1(ij) = amp1(ij) + m(ij, k)
-        END IF
-      END DO
-    END DO
-
-    DO k = 1, i
-      DO j = i + 1, nl + 1
-        DO ij = 1, ncum
-          IF ((j<=(inb(ij)+1)) .AND. (i<=inb(ij))) THEN
-            amp1(ij) = amp1(ij) + ment(ij, k, j)
-          END IF
-        END DO
-      END DO
-    END DO
-    DO k = 1, i - 1
-      DO j = i, nl + 1
-        DO ij = 1, ncum
-          IF ((i<=inb(ij)) .AND. (j<=inb(ij))) THEN
-            ad(ij) = ad(ij) + ment(ij, j, k)
-          END IF
-        END DO
-      END DO
-    END DO
-
-    DO ij = 1, ncum
-      IF (i<=inb(ij)) THEN
-        dpinv = 0.01/(ph(ij,i)-ph(ij,i+1))
-        cpinv = 1.0/cpn(ij, i)
-
-        ft(ij, i) = ft(ij, i) + g*dpinv*(amp1(ij)*(t(ij,i+1)-t(ij, &
-          i)+(gz(ij,i+1)-gz(ij,i))*cpinv)-ad(ij)*(t(ij,i)-t(ij, &
-          i-1)+(gz(ij,i)-gz(ij,i-1))*cpinv)) - sigd*lvcp(ij, i)*evap(ij, i)
-        ft(ij, i) = ft(ij, i) + g*dpinv*ment(ij, i, i)*(hp(ij,i)-h(ij,i)+t(ij &
-          ,i)*(cpv-cpd)*(q(ij,i)-qent(ij,i,i)))*cpinv
-        ft(ij, i) = ft(ij, i) + sigd*wt(ij, i+1)*(cl-cpd)*water(ij, i+1)*(t( &
-          ij,i+1)-t(ij,i))*dpinv*cpinv
-        fq(ij, i) = fq(ij, i) + g*dpinv*(amp1(ij)*(q(ij,i+1)-q(ij, &
-          i))-ad(ij)*(q(ij,i)-q(ij,i-1)))
-        fu(ij, i) = fu(ij, i) + g*dpinv*(amp1(ij)*(u(ij,i+1)-u(ij, &
-          i))-ad(ij)*(u(ij,i)-u(ij,i-1)))
-        fv(ij, i) = fv(ij, i) + g*dpinv*(amp1(ij)*(v(ij,i+1)-v(ij, &
-          i))-ad(ij)*(v(ij,i)-v(ij,i-1)))
-      END IF
-    END DO
-    DO k = 1, i - 1
-      DO ij = 1, ncum
-        IF (i<=inb(ij)) THEN
-          awat = elij(ij, k, i) - (1.-ep(ij,i))*clw(ij, i)
-          awat = max(awat, 0.0)
-          fq(ij, i) = fq(ij, i) + g*dpinv*ment(ij, k, i)*(qent(ij,k,i)-awat-q &
-            (ij,i))
-          fu(ij, i) = fu(ij, i) + g*dpinv*ment(ij, k, i)*(uent(ij,k,i)-u(ij,i &
-            ))
-          fv(ij, i) = fv(ij, i) + g*dpinv*ment(ij, k, i)*(vent(ij,k,i)-v(ij,i &
-            ))
-        END IF
-      END DO
-    END DO
-    DO k = i, nl + 1
-      DO ij = 1, ncum
-        IF ((i<=inb(ij)) .AND. (k<=inb(ij))) THEN
-          fq(ij, i) = fq(ij, i) + g*dpinv*ment(ij, k, i)*(qent(ij,k,i)-q(ij,i &
-            ))
-          fu(ij, i) = fu(ij, i) + g*dpinv*ment(ij, k, i)*(uent(ij,k,i)-u(ij,i &
-            ))
-          fv(ij, i) = fv(ij, i) + g*dpinv*ment(ij, k, i)*(vent(ij,k,i)-v(ij,i &
-            ))
-        END IF
-      END DO
-    END DO
-    DO ij = 1, ncum
-      IF (i<=inb(ij)) THEN
-        fq(ij, i) = fq(ij, i) + sigd*evap(ij, i) + g*(mp(ij,i+1)*(qp(ij, &
-          i+1)-q(ij,i))-mp(ij,i)*(qp(ij,i)-q(ij,i-1)))*dpinv
-        fu(ij, i) = fu(ij, i) + g*(mp(ij,i+1)*(up(ij,i+1)-u(ij, &
-          i))-mp(ij,i)*(up(ij,i)-u(ij,i-1)))*dpinv
-        fv(ij, i) = fv(ij, i) + g*(mp(ij,i+1)*(vp(ij,i+1)-v(ij, &
-          i))-mp(ij,i)*(vp(ij,i)-v(ij,i-1)))*dpinv
-      END IF
-    END DO
-1500 END DO
-
-  ! *** Adjust tendencies at top of convection layer to reflect  ***
-  ! ***       actual position of the level zero cape             ***
-
-  DO ij = 1, ncum
-    fqold = fq(ij, inb(ij))
-    fq(ij, inb(ij)) = fq(ij, inb(ij))*(1.-frac(ij))
-    fq(ij, inb(ij)-1) = fq(ij, inb(ij)-1) + frac(ij)*fqold*((ph(ij, &
-      inb(ij))-ph(ij,inb(ij)+1))/(ph(ij,inb(ij)-1)-ph(ij, &
-      inb(ij))))*lv(ij, inb(ij))/lv(ij, inb(ij)-1)
-    ftold = ft(ij, inb(ij))
-    ft(ij, inb(ij)) = ft(ij, inb(ij))*(1.-frac(ij))
-    ft(ij, inb(ij)-1) = ft(ij, inb(ij)-1) + frac(ij)*ftold*((ph(ij, &
-      inb(ij))-ph(ij,inb(ij)+1))/(ph(ij,inb(ij)-1)-ph(ij, &
-      inb(ij))))*cpn(ij, inb(ij))/cpn(ij, inb(ij)-1)
-    fuold = fu(ij, inb(ij))
-    fu(ij, inb(ij)) = fu(ij, inb(ij))*(1.-frac(ij))
-    fu(ij, inb(ij)-1) = fu(ij, inb(ij)-1) + frac(ij)*fuold*((ph(ij, &
-      inb(ij))-ph(ij,inb(ij)+1))/(ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
-    fvold = fv(ij, inb(ij))
-    fv(ij, inb(ij)) = fv(ij, inb(ij))*(1.-frac(ij))
-    fv(ij, inb(ij)-1) = fv(ij, inb(ij)-1) + frac(ij)*fvold*((ph(ij, &
-      inb(ij))-ph(ij,inb(ij)+1))/(ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
-  END DO
-
-  ! ***   Very slightly adjust tendencies to force exact   ***
-  ! ***     enthalpy, momentum and tracer conservation     ***
-
-  DO ij = 1, ncum
-    ents(ij) = 0.0
-    uav(ij) = 0.0
-    vav(ij) = 0.0
-    DO i = 1, inb(ij)
-      ents(ij) = ents(ij) + (cpn(ij,i)*ft(ij,i)+lv(ij,i)*fq(ij,i))*(ph(ij,i)- &
-        ph(ij,i+1))
-      uav(ij) = uav(ij) + fu(ij, i)*(ph(ij,i)-ph(ij,i+1))
-      vav(ij) = vav(ij) + fv(ij, i)*(ph(ij,i)-ph(ij,i+1))
-    END DO
-  END DO
-  DO ij = 1, ncum
-    ents(ij) = ents(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
-    uav(ij) = uav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
-    vav(ij) = vav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
-  END DO
-  DO ij = 1, ncum
-    DO i = 1, inb(ij)
-      ft(ij, i) = ft(ij, i) - ents(ij)/cpn(ij, i)
-      fu(ij, i) = (1.-cu)*(fu(ij,i)-uav(ij))
-      fv(ij, i) = (1.-cu)*(fv(ij,i)-vav(ij))
-    END DO
-  END DO
-
-  DO k = 1, nl + 1
-    DO i = 1, ncum
-      IF ((q(i,k)+delt*fq(i,k))<0.0) iflag(i) = 10
-    END DO
-  END DO
-
-
-  DO i = 1, ncum
-    IF (iflag(i)>2) THEN
-      precip(i) = 0.0
-      cbmf(i) = 0.0
-    END IF
-  END DO
-  DO k = 1, nl
-    DO i = 1, ncum
-      IF (iflag(i)>2) THEN
-        ft(i, k) = 0.0
-        fq(i, k) = 0.0
-        fu(i, k) = 0.0
-        fv(i, k) = 0.0
-      END IF
-    END DO
-  END DO
-  DO i = 1, ncum
-    precip1(idcum(i)) = precip(i)
-    cbmf1(idcum(i)) = cbmf(i)
-    iflag1(idcum(i)) = iflag(i)
-  END DO
-  DO k = 1, nl
-    DO i = 1, ncum
-      ft1(idcum(i), k) = ft(i, k)
-      fq1(idcum(i), k) = fq(i, k)
-      fu1(idcum(i), k) = fu(i, k)
-      fv1(idcum(i), k) = fv(i, k)
-    END DO
-  END DO
-
-  DO k = 1, nd
-    DO i = 1, len
-      ma(i, k) = 0.
-    END DO
-  END DO
-  DO k = nl, 1, -1
-    DO i = 1, ncum
-      ma(i, k) = ma(i, k+1) + m(i, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE convect2
-
+link ../phylmd/convect2.F90
Index: LMDZ6/trunk/libf/phylmdiso/convect3.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/convect3.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/convect3.F90	(revision 3940)
@@ -1,1407 +1,1 @@
-
-! $Header$
-
-SUBROUTINE convect3(dtime, epmax, ok_adj, t1, r1, rs, u, v, tra, p, ph, nd, &
-    ndp1, nl, ntra, delt, iflag, ft, fr, fu, fv, ftra, precip, icb, inb, &
-    upwd, dnwd, dnwd0, sig, w0, mike, mke, ma, ments, qents, tps, tls, sigij, &
-    cape, tvp, pbase, buoybase, &  ! ccc     *
-                                   ! DTVPDT1,DTVPDQ1,DPLCLDT,DPLCLDR)
-    dtvpdt1, dtvpdq1, dplcldt, dplcldr, & ! sbl
-    ft2, fr2, fu2, fv2, wd, qcond, qcondc) ! sbl
-
-  ! ***  THE PARAMETER NA SHOULD IN GENERAL EQUAL ND   ***
-
-  ! #################################################################
-  ! Fleur       Introduction des traceurs dans convect3 le 6 juin 200
-  ! #################################################################
-  USE dimphy
-  USE infotrac_phy, ONLY: nbtr
-  IMPLICIT NONE
-  INTEGER na
-  PARAMETER (na=60)
-
-  REAL deltac ! cld
-  PARAMETER (deltac=0.01) ! cld
-
-  INTEGER nent(na)
-  INTEGER nd, ndp1, nl, ntra, iflag, icb, inb
-  REAL dtime, epmax, delt, precip, cape
-  REAL dplcldt, dplcldr
-  REAL t1(nd), r1(nd), rs(nd), u(nd), v(nd), tra(nd, ntra)
-  REAL p(nd), ph(ndp1)
-  REAL ft(nd), fr(nd), fu(nd), fv(nd), ftra(nd, ntra)
-  REAL sig(nd), w0(nd)
-  REAL uent(na, na), vent(na, na), traent(na, na, nbtr), tratm(na)
-  REAL up(na), vp(na), trap(na, nbtr)
-  REAL m(na), mp(na), ment(na, na), qent(na, na), elij(na, na)
-  REAL sij(na, na), tvp(na), tv(na), water(na)
-  REAL rp(na), ep(na), th(na), wt(na), evap(na), clw(na)
-  REAL sigp(na), b(na), tp(na), cpn(na)
-  REAL lv(na), lvcp(na), h(na), hp(na), gz(na)
-  REAL t(na), rr(na)
-
-  REAL ft2(nd), fr2(nd), fu2(nd), fv2(nd) ! added sbl
-  REAL u1(nd), v1(nd) ! added sbl
-
-  REAL buoy(na) !  Lifted parcel buoyancy
-  REAL dtvpdt1(nd), dtvpdq1(nd) ! Derivatives of parcel virtual
-  ! temperature wrt T1 and Q1
-  REAL clw_new(na), qi(na)
-
-  REAL wd, betad ! for gust factor (sb)
-  REAL qcondc(nd) ! interface cld param (sb)
-  REAL qcond(nd), nqcond(na), wa(na), maa(na), siga(na), axc(na) ! cld
-
-  LOGICAL ice_conv, ok_adj
-  PARAMETER (ice_conv=.TRUE.)
-
-  ! ccccccccccccccccccccccccccccccccccccccccccccc
-  ! declaration des variables a sortir
-  ! cccccccccccccccccccccccccccccccccccccccccccc
-  REAL mke(nd)
-  REAL mike(nd)
-  REAL ma(nd)
-  REAL tps(nd) !temperature dans les ascendances non diluees
-  REAL tls(nd) !temperature potentielle
-  REAL ments(nd, nd)
-  REAL qents(nd, nd)
-  REAL sigij(klev, klev)
-  REAL pbase ! pressure at the cloud base level
-  REAL buoybase ! buoyancy at the cloud base level
-  ! ccccccccccccccccccccccccccccccccccccccccccccc
-
-
-  REAL :: cpv,cl,cpvmcl,eps,alv0,rdcp,pbcrit,ptcrit,sigd,spfac
-  REAL :: tau,beta,alpha,dtcrit,dtovsh,ahm,rm,um,vm,dphinv
-  REAL :: a2,x,tvx,tvy,plcl,pden,dpbase,tvpbase,tvbase,tdif
-  REAL :: ath1,ath,delti,deltap,dcape,dlnp,sigold,dtmin,fac,w
-  REAL :: amu,rti,cpd,bf2,anum,denom,dei,altem,cwat,stemp,qp
-  REAL :: scrit,alt,smax,asij,wgh,sjmax,sjmin,smid,delp,delm
-  REAL :: asum,bsum,csum,wflux,tinv,wdtrain,awat,afac,afac1,afac2
-  REAL :: bfac,pr1,pr2,sigt,b6,c6,revap,tevap,delth,amfac,amp2
-  REAL :: xf,tf,af,bf,fac2,ur,sru,d,ampmax,dpinv,am,amde,cpinv
-  REAL :: amp1,ad,rat,ax,bx,cx,dx,ex,dsum
-  INTEGER :: nk,i,j,nopt,jn,k,im,jm,n
-
-  REAL dnwd0(nd) !  precipitation driven unsaturated downdraft flux
-  REAL dnwd(nd), dn1 ! in-cloud saturated downdraft mass flux
-  REAL upwd(nd), up1 ! in-cloud saturated updraft mass flux
-
-  ! ***         ASSIGN VALUES OF THERMODYNAMIC CONSTANTS        ***
-  ! ***             THESE SHOULD BE CONSISTENT WITH             ***
-  ! ***              THOSE USED IN CALLING PROGRAM              ***
-  ! ***     NOTE: THESE ARE ALSO SPECIFIED IN SUBROUTINE TLIFT  ***
-
-  ! sb      CPD=1005.7
-  ! sb      CPV=1870.0
-  ! sb      CL=4190.0
-  ! sb      CPVMCL=CL-CPV
-  ! sb      RV=461.5
-  ! sb      RD=287.04
-  ! sb      EPS=RD/RV
-  ! sb      ALV0=2.501E6
-  ! cccccccccccccccccccccc
-  ! constantes coherentes avec le modele du Centre Europeen
-  ! sb      RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
-  ! sb      RV = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 18.0153
-  ! sb      CPD = 3.5 * RD
-  ! sb      CPV = 4.0 * RV
-  ! sb      CL = 4218.0
-  ! sb      CPVMCL=CL-CPV
-  ! sb      EPS=RD/RV
-  ! sb      ALV0=2.5008E+06
-  ! ccccccccccccccccccccc
-  ! on utilise les constantes thermo du Centre Europeen: (SB)
-
-  include "YOMCST.h"
-
-  cpd = rcpd
-  cpv = rcpv
-  cl = rcw
-  cpvmcl = cl - cpv
-  eps = rd/rv
-  alv0 = rlvtt
-
-  nk = 1 ! origin level of the lifted parcel
-
-  ! ccccccccccccccccccccc
-
-  ! ***  INITIALIZE OUTPUT ARRAYS AND PARAMETERS  ***
-
-  DO i = 1, nd
-    ft(i) = 0.0
-    fr(i) = 0.0
-    fu(i) = 0.0
-    fv(i) = 0.0
-
-    ft2(i) = 0.0
-    fr2(i) = 0.0
-    fu2(i) = 0.0
-    fv2(i) = 0.0
-
-    DO j = 1, ntra
-      ftra(i, j) = 0.0
-    END DO
-
-    qcondc(i) = 0.0 ! cld
-    qcond(i) = 0.0 ! cld
-    nqcond(i) = 0.0 ! cld
-
-    t(i) = t1(i)
-    rr(i) = r1(i)
-    u1(i) = u(i) ! added sbl
-    v1(i) = v(i) ! added sbl
-  END DO
-  DO i = 1, nl
-    rdcp = (rd*(1.-rr(i))+rr(i)*rv)/(cpd*(1.-rr(i))+rr(i)*cpv)
-    th(i) = t(i)*(1000.0/p(i))**rdcp
-  END DO
-
-  ! ************************************************************
-  ! *    CALCUL DES TEMPERATURES POTENTIELLES A SORTIR
-  ! ************************************************************
-  DO i = 1, nd
-    rdcp = (rd*(1.-rr(i))+rr(i)*rv)/(cpd*(1.-rr(i))+rr(i)*cpv)
-
-    tls(i) = t(i)*(1000.0/p(i))**rdcp
-  END DO
-
-
-
-
-  ! ***********************************************************
-
-
-  precip = 0.0
-  wd = 0.0 ! sb
-  iflag = 1
-
-  ! ***                    SPECIFY PARAMETERS                        ***
-  ! ***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE   ***
-  ! ***       PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO         ***
-  ! ***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP.      ***
-  ! ***            EFFICIENCY IS ASSUMED TO BE UNITY                 ***
-  ! ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-  ! ***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE      ***
-  ! ***                        OF CLOUD                              ***
-  ! ***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-  ! ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-  ! ***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY)    ***
-  ! ***           (BETA MUST BE LESS THAN OR EQUAL TO 1)             ***
-  ! ***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE    ***
-  ! ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-  ! ***                     IT MUST BE LESS THAN 0                   ***
-
-  pbcrit = 150.0
-  ptcrit = 500.0
-  sigd = 0.01
-  spfac = 0.15
-  ! sb:
-  ! EPMAX=0.993 ! precip efficiency less than unity
-  ! EPMAX=1. ! precip efficiency less than unity
-
-  ! jyg
-  ! CC      BETA=0.96
-  ! Beta is now expressed as a function of the characteristic time
-  ! of the convective process.
-  ! CC        Old value : TAU = 15000.   !(for dtime = 600.s)
-  ! CC        Other value (inducing little change) :TAU = 8000.
-  tau = 8000.
-  beta = 1. - dtime/tau
-  ! jyg
-  ! CC      ALPHA=1.0
-  alpha = 1.5E-3*dtime/tau
-  ! Increase alpha in order to compensate W decrease
-  alpha = alpha*1.5
-
-  ! jyg (voir CONVECT 3)
-  ! CC      DTCRIT=-0.2
-  dtcrit = -2.
-  ! gf&jyg
-  ! CC     DT pour l'overshoot.
-  dtovsh = -0.2
-
-
-  ! ***        INCREMENT THE COUNTER       ***
-
-  sig(nd) = sig(nd) + 1.0
-  sig(nd) = amin1(sig(nd), 12.1)
-
-  ! ***    IF NOPT IS AN INTEGER OTHER THAN 0, CONVECT     ***
-  ! ***     RETURNS ARRAYS T AND R THAT MAY HAVE BEEN      ***
-  ! ***  ALTERED BY DRY ADIABATIC ADJUSTMENT; OTHERWISE    ***
-  ! ***        THE RETURNED ARRAYS ARE UNALTERED.          ***
-
-  nopt = 0
-  ! !      NOPT=1 ! sbl
-
-  ! ***            PERFORM DRY ADIABATIC ADJUSTMENT            ***
-
-  ! ***  DO NOT BYPASS THIS EVEN IF THE CALLING PROGRAM HAS A  ***
-  ! ***                BOUNDARY LAYER SCHEME !!!               ***
-
-  IF (ok_adj) THEN ! added sbl
-
-    DO i = nl - 1, 1, -1
-      jn = 0
-      DO j = i + 1, nl
-        IF (th(j)<th(i)) jn = j
-      END DO
-      IF (jn==0) GO TO 30
-      ahm = 0.0
-      rm = 0.0
-      um = 0.0
-      vm = 0.0
-      DO k = 1, ntra
-        tratm(k) = 0.0
-      END DO
-      DO j = i, jn
-        ahm = ahm + (cpd*(1.-rr(j))+rr(j)*cpv)*t(j)*(ph(j)-ph(j+1))
-        rm = rm + rr(j)*(ph(j)-ph(j+1))
-        um = um + u(j)*(ph(j)-ph(j+1))
-        vm = vm + v(j)*(ph(j)-ph(j+1))
-        DO k = 1, ntra
-          tratm(k) = tratm(k) + tra(j, k)*(ph(j)-ph(j+1))
-        END DO
-      END DO
-      dphinv = 1./(ph(i)-ph(jn+1))
-      rm = rm*dphinv
-      um = um*dphinv
-      vm = vm*dphinv
-      DO k = 1, ntra
-        tratm(k) = tratm(k)*dphinv
-      END DO
-      a2 = 0.0
-      DO j = i, jn
-        rr(j) = rm
-        u(j) = um
-        v(j) = vm
-        DO k = 1, ntra
-          tra(j, k) = tratm(k)
-        END DO
-        rdcp = (rd*(1.-rr(j))+rr(j)*rv)/(cpd*(1.-rr(j))+rr(j)*cpv)
-        x = (0.001*p(j))**rdcp
-        t(j) = x
-        a2 = a2 + (cpd*(1.-rr(j))+rr(j)*cpv)*x*(ph(j)-ph(j+1))
-      END DO
-      DO j = i, jn
-        th(j) = ahm/a2
-        t(j) = t(j)*th(j)
-      END DO
-30  END DO
-
-  END IF ! added sbl
-
-  ! ***   RESET INPUT ARRAYS IF ok_adj 0   ***
-
-  IF (ok_adj) THEN
-    DO i = 1, nd
-
-      ft2(i) = (t(i)-t1(i))/delt ! sbl
-      fr2(i) = (rr(i)-r1(i))/delt ! sbl
-      fu2(i) = (u(i)-u1(i))/delt ! sbl
-      fv2(i) = (v(i)-v1(i))/delt ! sbl
-
-      ! !            T1(I)=T(I)      ! commente sbl
-      ! !            R1(I)=RR(I)     ! commente sbl
-    END DO
-  END IF
-
-  ! *** CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY AND STATIC ENERGY
-
-  gz(1) = 0.0
-  cpn(1) = cpd*(1.-rr(1)) + rr(1)*cpv
-  h(1) = t(1)*cpn(1)
-  DO i = 2, nl
-    tvx = t(i)*(1.+rr(i)/eps-rr(i))
-    tvy = t(i-1)*(1.+rr(i-1)/eps-rr(i-1))
-    gz(i) = gz(i-1) + 0.5*rd*(tvx+tvy)*(p(i-1)-p(i))/ph(i)
-    cpn(i) = cpd*(1.-rr(i)) + cpv*rr(i)
-    h(i) = t(i)*cpn(i) + gz(i)
-  END DO
-
-  ! ***  CALCULATE LIFTED CONDENSATION LEVEL OF AIR AT LOWEST MODEL LEVEL ***
-  ! ***       (WITHIN 0.2% OF FORMULA OF BOLTON, MON. WEA. REV.,1980)     ***
-
-  IF (t(1)<250.0 .OR. rr(1)<=0.0) THEN
-    iflag = 0
-    ! sb3d         print*,'je suis passe par 366'
-    RETURN
-  END IF
-
-  ! jyg1 Utilisation de la subroutine CLIFT
-  ! C      RH=RR(1)/RS(1)
-  ! C      CHI=T(1)/(1669.0-122.0*RH-T(1))
-  ! C      PLCL=P(1)*(RH**CHI)
-  CALL clift(p(1), t(1), rr(1), rs(1), plcl, dplcldt, dplcldr)
-  ! jyg2
-  ! sb3d      PRINT *,' em_plcl,p1,t1,r1,rs1,rh '
-  ! sb3d     $        ,PLCL,P(1),T(1),RR(1),RS(1),RH
-
-  IF (plcl<200.0 .OR. plcl>=2000.0) THEN
-    iflag = 2
-    RETURN
-  END IF
-  ! jyg1
-  ! Essais de modification de ICB
-
-  ! ***  CALCULATE FIRST LEVEL ABOVE LCL (=ICB)  ***
-
-  ! C      ICB=NL-1
-  ! C      DO 50 I=2,NL-1
-  ! C         IF(P(I).LT.PLCL)THEN
-  ! C            ICB=MIN(ICB,I)   ! ICB sup ou egal a 2
-  ! C         END IF
-  ! C   50 CONTINUE
-  ! C      IF(ICB.EQ.(NL-1))THEN
-  ! C         IFLAG=3
-  ! C         RETURN
-  ! C      END IF
-
-  ! *** CALCULATE LAYER CONTAINING LCL (=ICB)   ***
-
-  icb = nl - 1
-  ! sb      DO 50 I=2,NL-1
-  DO i = 3, nl - 1 ! modif sb pour que ICB soit sup/egal a 2
-    ! la modification consiste a comparer PLCL a PH et non a P:
-    ! ICB est defini par :  PH(ICB)<PLCL<PH(ICB-!)
-    IF (ph(i)<plcl) THEN
-      icb = min(icb, i)
-    END IF
-  END DO
-  IF (icb==(nl-1)) THEN
-    iflag = 3
-    RETURN
-  END IF
-  icb = icb - 1 ! ICB sup ou egal a 2
-  ! jyg2
-
-
-
-  ! *** SUBROUTINE TLIFT CALCULATES PART OF THE LIFTED PARCEL VIRTUAL
-  ! ***
-  ! ***  TEMPERATURE, THE ACTUAL TEMPERATURE AND THE ADIABATIC
-  ! ***
-  ! ***                   LIQUID WATER CONTENT
-  ! ***
-
-
-  ! jyg1
-  ! make sure that "Cloud base" seen by TLIFT is actually the
-  ! fisrt level where adiabatic ascent is saturated
-  IF (plcl>p(icb)) THEN
-    ! sb        CALL TLIFT(P,T,RR,RS,GZ,PLCL,ICB,TVP,TP,CLW,ND,NL)
-    CALL tlift(p, t, rr, rs, gz, plcl, icb, nk, tvp, tp, clw, nd, nl, &
-      dtvpdt1, dtvpdq1)
-  ELSE
-    ! sb        CALL TLIFT(P,T,RR,RS,GZ,PLCL,ICB+1,TVP,TP,CLW,ND,NL)
-    CALL tlift(p, t, rr, rs, gz, plcl, icb+1, nk, tvp, tp, clw, nd, nl, &
-      dtvpdt1, dtvpdq1)
-  END IF
-  ! jyg2
-
-  ! *****************************************************************************
-  ! ***     SORTIE DE LA TEMPERATURE DE L ASCENDANCE NON DILUE
-  ! *****************************************************************************
-  DO i = 1, nd
-    tps(i) = tp(i)
-  END DO
-
-
-  ! *****************************************************************************
-
-
-  ! ***  SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF   ***
-  ! ***          PRECIPITATION FALLING OUTSIDE OF CLOUD           ***
-  ! ***      THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)     ***
-
-  DO i = 1, nl
-    pden = ptcrit - pbcrit
-
-    ! jyg
-    ! cc         EP(I)=(P(ICB)-P(I)-PBCRIT)/PDEN
-    ! sb         EP(I)=(PLCL-P(I)-PBCRIT)/PDEN
-    ep(i) = (plcl-p(i)-pbcrit)/pden*epmax ! sb
-
-    ep(i) = amax1(ep(i), 0.0)
-    ! sb         EP(I)=AMIN1(EP(I),1.0)
-    ep(i) = amin1(ep(i), epmax) ! sb
-    sigp(i) = spfac
-
-    ! ***       CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL     ***
-    ! ***                    VIRTUAL TEMPERATURE                    ***
-
-    tv(i) = t(i)*(1.+rr(i)/eps-rr(i))
-    ! cd1
-    ! . Keep all liquid water in lifted parcel (-> adiabatic CAPE)
-
-    ! cc    TVP(I)=TVP(I)-TP(I)*(RR(1)-EP(I)*CLW(I))
-    ! !!! sb         TVP(I)=TVP(I)-TP(I)*RR(1) ! calcule dans tlift
-    ! cd2
-
-    ! ***       Calculate first estimate of buoyancy
-
-    buoy(i) = tvp(i) - tv(i)
-  END DO
-
-  ! ***   Set Cloud Base Buoyancy at (Plcl+DPbase) level buoyancy
-
-  dpbase = -40. !That is 400m above LCL
-  pbase = plcl + dpbase
-  tvpbase = tvp(icb)*(pbase-p(icb+1))/(p(icb)-p(icb+1)) + &
-    tvp(icb+1)*(p(icb)-pbase)/(p(icb)-p(icb+1))
-  tvbase = tv(icb)*(pbase-p(icb+1))/(p(icb)-p(icb+1)) + &
-    tv(icb+1)*(p(icb)-pbase)/(p(icb)-p(icb+1))
-
-  ! test sb:
-  ! @      write(*,*) '++++++++++++++++++++++++++++++++++++++++'
-  ! @      write(*,*) 'plcl,dpbas,tvpbas,tvbas,tvp(icb),tvp(icb1)
-  ! @     :             ,tv(icb),tv(icb1)'
-  ! @      write(*,*) plcl,dpbase,tvpbase,tvbase,tvp(icb)
-  ! @     L          ,tvp(icb+1),tv(icb),tv(icb+1)
-  ! @      write(*,*) '++++++++++++++++++++++++++++++++++++++++'
-  ! fin test sb
-  buoybase = tvpbase - tvbase
-
-  ! C       Set buoyancy = BUOYBASE for all levels below BASE.
-  ! C       For safety, set : BUOY(ICB) = BUOYBASE
-  DO i = icb, nl
-    IF (p(i)>=pbase) THEN
-      buoy(i) = buoybase
-    END IF
-  END DO
-  buoy(icb) = buoybase
-
-  ! sb3d      print *,'buoybase,tvp_tv,tvpbase,tvbase,pbase,plcl'
-  ! sb3d     $,        buoybase,tvp(icb)-tv(icb),tvpbase,tvbase,pbase,plcl
-  ! sb3d      print *,'TVP ',(tvp(i),i=1,nl)
-  ! sb3d      print *,'TV ',(tv(i),i=1,nl)
-  ! sb3d      print *, 'P ',(p(i),i=1,nl)
-  ! sb3d      print *,'ICB ',icb
-  ! test sb:
-  ! @      write(*,*) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'
-  ! @      write(*,*) 'icb,icbs,inb,buoybase:'
-  ! @      write(*,*) icb,icb+1,inb,buoybase
-  ! @      write(*,*) 'k,tvp,tv,tp,buoy,ep: '
-  ! @      do k=1,nl
-  ! @      write(*,*) k,tvp(k),tv(k),tp(k),buoy(k),ep(k)
-  ! @      enddo
-  ! @      write(*,*) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'
-  ! fin test sb
-
-
-
-  ! ***   MAKE SURE THAT COLUMN IS DRY ADIABATIC BETWEEN THE SURFACE  ***
-  ! ***    AND CLOUD BASE, AND THAT LIFTED AIR IS POSITIVELY BUOYANT  ***
-  ! ***                         AT CLOUD BASE                         ***
-  ! ***       IF NOT, RETURN TO CALLING PROGRAM AFTER RESETTING       ***
-  ! ***                        SIG(I) AND W0(I)                       ***
-
-  ! jyg
-  ! CC      TDIF=TVP(ICB)-TV(ICB)
-  tdif = buoy(icb)
-  ath1 = th(1)
-  ! jyg
-  ! CC      ATH=TH(ICB-1)-1.0
-  ath = th(icb-1) - 5.0
-  ! ATH=0.                          ! ajout sb
-  ! IF (ICB.GT.1) ATH=TH(ICB-1)-5.0 ! modif sb
-  IF (tdif<dtcrit .OR. ath>ath1) THEN
-    DO i = 1, nl
-      sig(i) = beta*sig(i) - 2.*alpha*tdif*tdif
-      sig(i) = amax1(sig(i), 0.0)
-      w0(i) = beta*w0(i)
-    END DO
-    iflag = 0
-    RETURN
-  END IF
-
-
-
-  ! ***  IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
-  ! ***
-  ! ***        NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-  ! ***
-
-  DO i = 1, nl
-    hp(i) = h(i)
-    wt(i) = 0.001
-    rp(i) = rr(i)
-    up(i) = u(i)
-    vp(i) = v(i)
-    DO j = 1, ntra
-      trap(i, j) = tra(i, j)
-    END DO
-    nent(i) = 0
-    water(i) = 0.0
-    evap(i) = 0.0
-    b(i) = 0.0
-    mp(i) = 0.0
-    m(i) = 0.0
-    lv(i) = alv0 - cpvmcl*(t(i)-273.15)
-    lvcp(i) = lv(i)/cpn(i)
-    DO j = 1, nl
-      qent(i, j) = rr(j)
-      elij(i, j) = 0.0
-      ment(i, j) = 0.0
-      sij(i, j) = 0.0
-      uent(i, j) = u(j)
-      vent(i, j) = v(j)
-      DO k = 1, ntra
-        traent(i, j, k) = tra(j, k)
-      END DO
-    END DO
-  END DO
-
-  delti = 1.0/delt
-
-  ! ***  FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S       ***
-  ! ***                LEVEL OF NEUTRAL BUOYANCY                   ***
-
-  inb = nl - 1
-  DO i = icb, nl - 1
-    ! jyg
-    ! CC         IF((TVP(I)-TV(I)).LT.DTCRIT)THEN
-    IF (buoy(i)<dtovsh) THEN
-      inb = min(inb, i)
-    END IF
-  END DO
-
-
-
-
-
-  ! ***          RESET SIG(I) AND W0(I) FOR I>INB AND I<ICB       ***
-
-  IF (inb<(nl-1)) THEN
-    DO i = inb + 1, nl - 1
-      ! jyg
-      ! CC            SIG(I)=BETA*SIG(I)-2.0E-4*ALPHA*(TV(INB)-TVP(INB))*
-      ! CC     1              ABS(TV(INB)-TVP(INB))
-      sig(i) = beta*sig(i) + 2.*alpha*buoy(inb)*abs(buoy(inb))
-      sig(i) = amax1(sig(i), 0.0)
-      w0(i) = beta*w0(i)
-    END DO
-  END IF
-  DO i = 1, icb
-    ! jyg
-    ! CC         SIG(I)=BETA*SIG(I)-2.0E-4*ALPHA*(TV(ICB)-TVP(ICB))*
-    ! CC     1           (TV(ICB)-TVP(ICB))
-    sig(i) = beta*sig(i) - 2.*alpha*buoy(icb)*buoy(icb)
-    sig(i) = amax1(sig(i), 0.0)
-    w0(i) = beta*w0(i)
-  END DO
-
-  ! ***    RESET FRACTIONAL AREAS OF UPDRAFTS AND W0 AT INITIAL TIME    ***
-  ! ***           AND AFTER 10 TIME STEPS OF NO CONVECTION              ***
-
-
-  IF (sig(nd)<1.5 .OR. sig(nd)>12.0) THEN
-    DO i = 1, nl - 1
-      sig(i) = 0.0
-      w0(i) = 0.0
-    END DO
-  END IF
-
-  ! ***   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL   ***
-
-  DO i = icb, inb
-    hp(i) = h(1) + (lv(i)+(cpd-cpv)*t(i))*ep(i)*clw(i)
-  END DO
-
-  ! ***  CALCULATE CONVECTIVE AVAILABLE POTENTIAL ENERGY (CAPE),  ***
-  ! ***     VERTICAL VELOCITY (W), FRACTIONAL AREA COVERED BY     ***
-  ! ***     UNDILUTE UPDRAFT (SIG),  AND UPDRAFT MASS FLUX (M)    ***
-
-  cape = 0.0
-
-  DO i = icb + 1, inb
-    ! jyg1
-    ! CC         CAPE=CAPE+RD*(TVP(I-1)-TV(I-1))*(PH(I-1)-PH(I))/P(I-1)
-    ! CC         DCAPE=RD*BUOY(I-1)*(PH(I-1)-PH(I))/P(I-1)
-    ! CC         DLNP=(PH(I-1)-PH(I))/P(I-1)
-    ! The interval on which CAPE is computed starts at PBASE :
-    deltap = min(pbase, ph(i-1)) - min(pbase, ph(i))
-    cape = cape + rd*buoy(i-1)*deltap/p(i-1)
-    dcape = rd*buoy(i-1)*deltap/p(i-1)
-    dlnp = deltap/p(i-1)
-    ! jyg2
-    ! sb3d         print *,'buoy,dlnp,dcape,cape',buoy(i-1),dlnp,dcape,cape
-    ! test sb:
-    ! @       write(*,*) '############################################'
-    ! @         write(*,*) 'cape,rrd,buoy,deltap,p,pbase,ph:'
-    ! @     :     ,cape,rd,buoy(i-1),deltap,p(i-1),pbase,ph(i)
-    ! @       write(*,*) '############################################'
-
-    ! fin test sb
-    cape = amax1(0.0, cape)
-
-    sigold = sig(i)
-    dtmin = 100.0
-    DO j = icb, i - 1
-      ! jyg
-      ! CC            DTMIN=AMIN1(DTMIN,(TVP(J)-TV(J)))
-      dtmin = amin1(dtmin, buoy(j))
-    END DO
-    ! sb3d     print *, 'DTMIN, BETA, ALPHA, SIG = ',DTMIN,BETA,ALPHA,SIG(I)
-    sig(i) = beta*sig(i) + alpha*dtmin*abs(dtmin)
-    sig(i) = amax1(sig(i), 0.0)
-    sig(i) = amin1(sig(i), 0.01)
-    fac = amin1(((dtcrit-dtmin)/dtcrit), 1.0)
-    ! jyg
-    ! C    Essais de reduction de la vitesse
-    ! C         FAC = FAC*.5
-
-    w = (1.-beta)*fac*sqrt(cape) + beta*w0(i)
-    amu = 0.5*(sig(i)+sigold)*w
-    m(i) = amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
-
-    ! --------- test sb:
-    ! write(*,*) '############################################'
-    ! write(*,*) 'k,amu,buoy(k-1),deltap,w,beta,fac,cape,w0(k)'
-    ! write(*,*) i,amu,buoy(i-1),deltap
-    ! :           ,w,beta,fac,cape,w0(i)
-    ! write(*,*) '############################################'
-    ! ---------
-
-    w0(i) = w
-  END DO
-  w0(icb) = 0.5*w0(icb+1)
-  m(icb) = 0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
-  sig(icb) = sig(icb+1)
-  sig(icb-1) = sig(icb)
-  ! jyg1
-  ! sb3d      print *, 'Cloud base, c. top, CAPE',ICB,INB,cape
-  ! sb3d      print *, 'SIG ',(sig(i),i=1,inb)
-  ! sb3d      print *, 'W ',(w0(i),i=1,inb)
-  ! sb3d      print *, 'M ',(m(i), i=1,inb)
-  ! sb3d      print *, 'Dt1 ',(tvp(i)-tv(i),i=1,inb)
-  ! sb3d      print *, 'Dt_vrai ',(buoy(i),i=1,inb)
-  ! jyg2
-
-  ! ***  CALCULATE ENTRAINED AIR MASS FLUX (MENT), TOTAL WATER MIXING  ***
-  ! ***     RATIO (QENT), TOTAL CONDENSED WATER (ELIJ), AND MIXING     ***
-  ! ***                        FRACTION (SIJ)                          ***
-
-
-
-  DO i = icb, inb
-    rti = rr(1) - ep(i)*clw(i)
-    DO j = icb - 1, inb
-      bf2 = 1. + lv(j)*lv(j)*rs(j)/(rv*t(j)*t(j)*cpd)
-      anum = h(j) - hp(i) + (cpv-cpd)*t(j)*(rti-rr(j))
-      denom = h(i) - hp(i) + (cpd-cpv)*(rr(i)-rti)*t(j)
-      dei = denom
-      IF (abs(dei)<0.01) dei = 0.01
-      sij(i, j) = anum/dei
-      sij(i, i) = 1.0
-      altem = sij(i, j)*rr(i) + (1.-sij(i,j))*rti - rs(j)
-      altem = altem/bf2
-      cwat = clw(j)*(1.-ep(j))
-      stemp = sij(i, j)
-      IF ((stemp<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
-        anum = anum - lv(j)*(rti-rs(j)-cwat*bf2)
-        denom = denom + lv(j)*(rr(i)-rti)
-        IF (abs(denom)<0.01) denom = 0.01
-        sij(i, j) = anum/denom
-        altem = sij(i, j)*rr(i) + (1.-sij(i,j))*rti - rs(j)
-        altem = altem - (bf2-1.)*cwat
-      END IF
-
-
-      IF (sij(i,j)>0.0 .AND. sij(i,j)<0.95) THEN
-        qent(i, j) = sij(i, j)*rr(i) + (1.-sij(i,j))*rti
-        uent(i, j) = sij(i, j)*u(i) + (1.-sij(i,j))*u(nk)
-        vent(i, j) = sij(i, j)*v(i) + (1.-sij(i,j))*v(nk)
-        DO k = 1, ntra
-          traent(i, j, k) = sij(i, j)*tra(i, k) + (1.-sij(i,j))*tra(nk, k)
-        END DO
-        elij(i, j) = altem
-        elij(i, j) = amax1(0.0, elij(i,j))
-        ment(i, j) = m(i)/(1.-sij(i,j))
-        nent(i) = nent(i) + 1
-      END IF
-      sij(i, j) = amax1(0.0, sij(i,j))
-      sij(i, j) = amin1(1.0, sij(i,j))
-    END DO
-
-    ! ***   IF NO AIR CAN ENTRAIN AT LEVEL I ASSUME THAT UPDRAFT DETRAINS
-    ! ***
-    ! ***   AT THAT LEVEL AND CALCULATE DETRAINED AIR FLUX AND PROPERTIES
-    ! ***
-
-    IF (nent(i)==0) THEN
-      ment(i, i) = m(i)
-      qent(i, i) = rr(nk) - ep(i)*clw(i)
-      uent(i, i) = u(nk)
-      vent(i, i) = v(nk)
-      DO j = 1, ntra
-        traent(i, i, j) = tra(nk, j)
-      END DO
-      elij(i, i) = clw(i)
-      sij(i, i) = 1.0
-    END IF
-
-    DO j = icb - 1, inb
-      sigij(i, j) = sij(i, j)
-    END DO
-
-  END DO
-
-  ! ***  NORMALIZE ENTRAINED AIR MASS FLUXES TO REPRESENT EQUAL  ***
-  ! ***              PROBABILITIES OF MIXING                     ***
-
-
-  DO i = icb, inb
-    IF (nent(i)/=0) THEN
-      qp = rr(1) - ep(i)*clw(i)
-      anum = h(i) - hp(i) - lv(i)*(qp-rs(i)) + (cpv-cpd)*t(i)*(qp-rr(i))
-      denom = h(i) - hp(i) + lv(i)*(rr(i)-qp) + (cpd-cpv)*t(i)*(rr(i)-qp)
-      IF (abs(denom)<0.01) denom = 0.01
-      scrit = anum/denom
-      alt = qp - rs(i) + scrit*(rr(i)-qp)
-      IF (scrit<=0.0 .OR. alt<=0.0) scrit = 1.0
-      smax = 0.0
-      asij = 0.0
-      DO j = inb, icb - 1, -1
-        IF (sij(i,j)>1.0E-16 .AND. sij(i,j)<0.95) THEN
-          wgh = 1.0
-          IF (j>i) THEN
-            sjmax = amax1(sij(i,j+1), smax)
-            sjmax = amin1(sjmax, scrit)
-            smax = amax1(sij(i,j), smax)
-            sjmin = amax1(sij(i,j-1), smax)
-            sjmin = amin1(sjmin, scrit)
-            IF (sij(i,j)<(smax-1.0E-16)) wgh = 0.0
-            smid = amin1(sij(i,j), scrit)
-          ELSE
-            sjmax = amax1(sij(i,j+1), scrit)
-            smid = amax1(sij(i,j), scrit)
-            sjmin = 0.0
-            IF (j>1) sjmin = sij(i, j-1)
-            sjmin = amax1(sjmin, scrit)
-          END IF
-          delp = abs(sjmax-smid)
-          delm = abs(sjmin-smid)
-          asij = asij + wgh*(delp+delm)
-          ment(i, j) = ment(i, j)*(delp+delm)*wgh
-        END IF
-      END DO
-      asij = amax1(1.0E-16, asij)
-      asij = 1.0/asij
-      DO j = icb - 1, inb
-        ment(i, j) = ment(i, j)*asij
-      END DO
-      asum = 0.0
-      bsum = 0.0
-      DO j = icb - 1, inb
-        asum = asum + ment(i, j)
-        ment(i, j) = ment(i, j)*sig(j)
-        bsum = bsum + ment(i, j)
-      END DO
-      bsum = amax1(bsum, 1.0E-16)
-      bsum = 1.0/bsum
-      DO j = icb - 1, inb
-        ment(i, j) = ment(i, j)*asum*bsum
-      END DO
-      csum = 0.0
-      DO j = icb - 1, inb
-        csum = csum + ment(i, j)
-      END DO
-
-      IF (csum<m(i)) THEN
-        nent(i) = 0
-        ment(i, i) = m(i)
-        qent(i, i) = rr(1) - ep(i)*clw(i)
-        uent(i, i) = u(nk)
-        vent(i, i) = v(nk)
-        DO j = 1, ntra
-          traent(i, i, j) = tra(nk, j)
-        END DO
-        elij(i, i) = clw(i)
-        sij(i, i) = 1.0
-      END IF
-    END IF
-  END DO
-
-
-
-  ! **************************************************************
-  ! *       CALCUL DES MENTS(I,J) ET DES QENTS(I,J)
-  ! *************************************************************
-
-  DO im = 1, nd
-    DO jm = 1, nd
-
-      qents(im, jm) = qent(im, jm)
-      ments(im, jm) = ment(im, jm)
-    END DO
-  END DO
-
-  ! **********************************************************
-  ! --- test sb:
-  ! @       write(*,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
-  ! @       write(*,*) 'inb,m(inb),ment(inb,inb),sigij(inb,inb):'
-  ! @       write(*,*) inb,m(inb),ment(inb,inb),sigij(inb,inb)
-  ! @       write(*,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
-  ! ---
-
-
-
-
-
-  ! ***  CHECK WHETHER EP(INB)=0, IF SO, SKIP PRECIPITATING    ***
-  ! ***             DOWNDRAFT CALCULATION                      ***
-
-  IF (ep(inb)<0.0001) GO TO 405
-
-  ! ***  INTEGRATE LIQUID WATER EQUATION TO FIND CONDENSED WATER   ***
-  ! ***                AND CONDENSED WATER FLUX                    ***
-
-  wflux = 0.0
-  tinv = 1./3.
-
-  ! ***                    BEGIN DOWNDRAFT LOOP                    ***
-
-  DO i = inb, 1, -1
-
-    ! ***              CALCULATE DETRAINED PRECIPITATION             ***
-
-
-
-    wdtrain = 10.0*ep(i)*m(i)*clw(i)
-    IF (i>1) THEN
-      DO j = 1, i - 1
-        awat = elij(j, i) - (1.-ep(i))*clw(i)
-        awat = amax1(awat, 0.0)
-        wdtrain = wdtrain + 10.0*awat*ment(j, i)
-      END DO
-    END IF
-
-    ! ***    FIND RAIN WATER AND EVAPORATION USING PROVISIONAL   ***
-    ! ***              ESTIMATES OF RP(I)AND RP(I-1)             ***
-
-
-
-    wt(i) = 45.0
-    IF (i<inb) THEN
-      rp(i) = rp(i+1) + (cpd*(t(i+1)-t(i))+gz(i+1)-gz(i))/lv(i)
-      rp(i) = 0.5*(rp(i)+rr(i))
-    END IF
-    rp(i) = amax1(rp(i), 0.0)
-    rp(i) = amin1(rp(i), rs(i))
-    rp(inb) = rr(inb)
-    IF (i==1) THEN
-      afac = p(1)*(rs(1)-rp(1))/(1.0E4+2000.0*p(1)*rs(1))
-    ELSE
-      rp(i-1) = rp(i) + (cpd*(t(i)-t(i-1))+gz(i)-gz(i-1))/lv(i)
-      rp(i-1) = 0.5*(rp(i-1)+rr(i-1))
-      rp(i-1) = amin1(rp(i-1), rs(i-1))
-      rp(i-1) = amax1(rp(i-1), 0.0)
-      afac1 = p(i)*(rs(i)-rp(i))/(1.0E4+2000.0*p(i)*rs(i))
-      afac2 = p(i-1)*(rs(i-1)-rp(i-1))/(1.0E4+2000.0*p(i-1)*rs(i-1))
-      afac = 0.5*(afac1+afac2)
-    END IF
-    IF (i==inb) afac = 0.0
-    afac = amax1(afac, 0.0)
-    bfac = 1./(sigd*wt(i))
-
-    ! jyg1
-    ! CC        SIGT=1.0
-    ! CC        IF(I.GE.ICB)SIGT=SIGP(I)
-    ! Prise en compte de la variation progressive de SIGT dans
-    ! les couches ICB et ICB-1:
-    ! Pour PLCL<PH(I+1), PR1=0 & PR2=1
-    ! Pour PLCL>PH(I),   PR1=1 & PR2=0
-    ! Pour PH(I+1)<PLCL<PH(I), PR1 est la proportion a cheval
-    ! sur le nuage, et PR2 est la proportion sous la base du
-    ! nuage.
-    pr1 = (plcl-ph(i+1))/(ph(i)-ph(i+1))
-    pr1 = max(0., min(1.,pr1))
-    pr2 = (ph(i)-plcl)/(ph(i)-ph(i+1))
-    pr2 = max(0., min(1.,pr2))
-    sigt = sigp(i)*pr1 + pr2
-    ! sb3d         print *,'i,sigt,pr1,pr2', i,sigt,pr1,pr2
-    ! jyg2
-
-    b6 = bfac*50.*sigd*(ph(i)-ph(i+1))*sigt*afac
-    c6 = water(i+1) + bfac*wdtrain - 50.*sigd*bfac*(ph(i)-ph(i+1))*evap(i+1)
-    IF (c6>0.0) THEN
-      revap = 0.5*(-b6+sqrt(b6*b6+4.*c6))
-      evap(i) = sigt*afac*revap
-      water(i) = revap*revap
-    ELSE
-      evap(i) = -evap(i+1) + 0.02*(wdtrain+sigd*wt(i)*water(i+1))/(sigd*(ph(i &
-        )-ph(i+1)))
-    END IF
-
-
-
-    ! ***  CALCULATE PRECIPITATING DOWNDRAFT MASS FLUX UNDER     ***
-    ! ***              HYDROSTATIC APPROXIMATION                 ***
-
-    IF (i==1) GO TO 360
-    tevap = amax1(0.0, evap(i))
-    delth = amax1(0.001, (th(i)-th(i-1)))
-    mp(i) = 10.*lvcp(i)*sigd*tevap*(p(i-1)-p(i))/delth
-
-    ! ***           IF HYDROSTATIC ASSUMPTION FAILS,             ***
-    ! ***   SOLVE CUBIC DIFFERENCE EQUATION FOR DOWNDRAFT THETA  ***
-    ! ***  AND MASS FLUX FROM TWO SIMULTANEOUS DIFFERENTIAL EQNS ***
-
-    amfac = sigd*sigd*70.0*ph(i)*(p(i-1)-p(i))*(th(i)-th(i-1))/(tv(i)*th(i))
-    amp2 = abs(mp(i+1)*mp(i+1)-mp(i)*mp(i))
-    IF (amp2>(0.1*amfac)) THEN
-      xf = 100.0*sigd*sigd*sigd*(ph(i)-ph(i+1))
-      tf = b(i) - 5.0*(th(i)-th(i-1))*t(i)/(lvcp(i)*sigd*th(i))
-      af = xf*tf + mp(i+1)*mp(i+1)*tinv
-      bf = 2.*(tinv*mp(i+1))**3 + tinv*mp(i+1)*xf*tf + &
-        50.*(p(i-1)-p(i))*xf*tevap
-      fac2 = 1.0
-      IF (bf<0.0) fac2 = -1.0
-      bf = abs(bf)
-      ur = 0.25*bf*bf - af*af*af*tinv*tinv*tinv
-      IF (ur>=0.0) THEN
-        sru = sqrt(ur)
-        fac = 1.0
-        IF ((0.5*bf-sru)<0.0) fac = -1.0
-        mp(i) = mp(i+1)*tinv + (0.5*bf+sru)**tinv + &
-          fac*(abs(0.5*bf-sru))**tinv
-      ELSE
-        d = atan(2.*sqrt(-ur)/(bf+1.0E-28))
-        IF (fac2<0.0) d = 3.14159 - d
-        mp(i) = mp(i+1)*tinv + 2.*sqrt(af*tinv)*cos(d*tinv)
-      END IF
-      mp(i) = amax1(0.0, mp(i))
-      b(i-1) = b(i) + 100.0*(p(i-1)-p(i))*tevap/(mp(i)+sigd*0.1) - &
-        10.0*(th(i)-th(i-1))*t(i)/(lvcp(i)*sigd*th(i))
-      b(i-1) = amax1(b(i-1), 0.0)
-    END IF
-
-
-
-    ! ***         LIMIT MAGNITUDE OF MP(I) TO MEET CFL CONDITION      ***
-
-    ampmax = 2.0*(ph(i)-ph(i+1))*delti
-    amp2 = 2.0*(ph(i-1)-ph(i))*delti
-    ampmax = amin1(ampmax, amp2)
-    mp(i) = amin1(mp(i), ampmax)
-
-    ! ***      FORCE MP TO DECREASE LINEARLY TO ZERO                 ***
-    ! ***       BETWEEN CLOUD BASE AND THE SURFACE                   ***
-
-    IF (p(i)>p(icb)) THEN
-      mp(i) = mp(icb)*(p(1)-p(i))/(p(1)-p(icb))
-    END IF
-360 CONTINUE
-
-    ! ***       FIND MIXING RATIO OF PRECIPITATING DOWNDRAFT     ***
-
-    IF (i==inb) GO TO 400
-    rp(i) = rr(i)
-    IF (mp(i)>mp(i+1)) THEN
-      rp(i) = rp(i+1)*mp(i+1) + rr(i)*(mp(i)-mp(i+1)) + &
-        5.*sigd*(ph(i)-ph(i+1))*(evap(i+1)+evap(i))
-      rp(i) = rp(i)/mp(i)
-      up(i) = up(i+1)*mp(i+1) + u(i)*(mp(i)-mp(i+1))
-      up(i) = up(i)/mp(i)
-      vp(i) = vp(i+1)*mp(i+1) + v(i)*(mp(i)-mp(i+1))
-      vp(i) = vp(i)/mp(i)
-      DO j = 1, ntra
-        trap(i, j) = trap(i+1, j)*mp(i+1) + trap(i, j)*(mp(i)-mp(i+1))
-        trap(i, j) = trap(i, j)/mp(i)
-      END DO
-    ELSE
-      IF (mp(i+1)>1.0E-16) THEN
-        rp(i) = rp(i+1) + 5.0*sigd*(ph(i)-ph(i+1))*(evap(i+1)+evap(i))/mp(i+1 &
-          )
-        up(i) = up(i+1)
-        vp(i) = vp(i+1)
-        DO j = 1, ntra
-          trap(i, j) = trap(i+1, j)
-        END DO
-      END IF
-    END IF
-    rp(i) = amin1(rp(i), rs(i))
-    rp(i) = amax1(rp(i), 0.0)
-400 END DO
-
-  ! ***  CALCULATE SURFACE PRECIPITATION IN MM/DAY     ***
-
-  precip = wt(1)*sigd*water(1)*8640.0
-
-  ! sb  ***  Calculate downdraft velocity scale and surface temperature and
-  ! ***
-  ! sb  ***                    water vapor fluctuations
-  ! ***
-  ! sb		(inspire de convect 4.3)
-
-  ! BETAD=10.0
-  betad = 5.0
-  wd = betad*abs(mp(icb))*0.01*rd*t(icb)/(sigd*p(icb))
-
-405 CONTINUE
-
-  ! ***  CALCULATE TENDENCIES OF LOWEST LEVEL POTENTIAL TEMPERATURE  ***
-  ! ***                      AND MIXING RATIO                        ***
-
-  dpinv = 1.0/(ph(1)-ph(2))
-  am = 0.0
-  DO k = 2, inb
-    am = am + m(k)
-  END DO
-  IF ((0.1*dpinv*am)>=delti) iflag = 4
-  ft(1) = 0.1*dpinv*am*(t(2)-t(1)+(gz(2)-gz(1))/cpn(1))
-  ft(1) = ft(1) - 0.5*lvcp(1)*sigd*(evap(1)+evap(2))
-  ft(1) = ft(1) - 0.09*sigd*mp(2)*t(1)*b(1)*dpinv
-  ft(1) = ft(1) + 0.01*sigd*wt(1)*(cl-cpd)*water(2)*(t(2)-t(1))*dpinv/cpn(1)
-  fr(1) = 0.1*mp(2)*(rp(2)-rr(1))* & ! correction bug conservation eau
-  ! 1    DPINV+SIGD*0.5*(EVAP(1)+EVAP(2))
-    dpinv + sigd*0.5*(evap(1)+evap(2))
-  ! IM cf. SBL
-  ! 1    DPINV+SIGD*EVAP(1)
-  fr(1) = fr(1) + 0.1*am*(rr(2)-rr(1))*dpinv
-  fu(1) = fu(1) + 0.1*dpinv*(mp(2)*(up(2)-u(1))+am*(u(2)-u(1)))
-  fv(1) = fv(1) + 0.1*dpinv*(mp(2)*(vp(2)-v(1))+am*(v(2)-v(1)))
-  DO j = 1, ntra
-    ftra(1, j) = ftra(1, j) + 0.1*dpinv*(mp(2)*(trap(2,j)-tra(1, &
-      j))+am*(tra(2,j)-tra(1,j)))
-  END DO
-  amde = 0.0
-  DO j = 2, inb
-    fr(1) = fr(1) + 0.1*dpinv*ment(j, 1)*(qent(j,1)-rr(1))
-    fu(1) = fu(1) + 0.1*dpinv*ment(j, 1)*(uent(j,1)-u(1))
-    fv(1) = fv(1) + 0.1*dpinv*ment(j, 1)*(vent(j,1)-v(1))
-    DO k = 1, ntra
-      ftra(1, k) = ftra(1, k) + 0.1*dpinv*ment(j, 1)*(traent(j,1,k)-tra(1,k))
-    END DO
-  END DO
-
-  ! ***  CALCULATE TENDENCIES OF POTENTIAL TEMPERATURE AND MIXING RATIO  ***
-  ! ***               AT LEVELS ABOVE THE LOWEST LEVEL                   ***
-
-  ! ***  FIRST FIND THE NET SATURATED UPDRAFT AND DOWNDRAFT MASS FLUXES  ***
-  ! ***                      THROUGH EACH LEVEL                          ***
-
-
-
-  DO i = 2, inb
-    dpinv = 1.0/(ph(i)-ph(i+1))
-    cpinv = 1.0/cpn(i)
-    amp1 = 0.0
-    DO k = i + 1, inb + 1
-      amp1 = amp1 + m(k)
-    END DO
-    DO k = 1, i
-      DO j = i + 1, inb + 1
-        amp1 = amp1 + ment(k, j)
-      END DO
-    END DO
-    IF ((0.1*dpinv*amp1)>=delti) iflag = 4
-    ad = 0.0
-    DO k = 1, i - 1
-      DO j = i, inb
-        ad = ad + ment(j, k)
-      END DO
-    END DO
-    ft(i) = 0.1*dpinv*(amp1*(t(i+1)-t(i)+(gz(i+1)-gz(i))*cpinv)-ad*(t(i)-t(i- &
-      1)+(gz(i)-gz(i-1))*cpinv)) - 0.5*sigd*lvcp(i)*(evap(i)+evap(i+1))
-    rat = cpn(i-1)*cpinv
-    ft(i) = ft(i) - 0.09*sigd*(mp(i+1)*t(i)*b(i)-mp(i)*t(i-1)*rat*b(i-1))* &
-      dpinv
-    ft(i) = ft(i) + 0.1*dpinv*ment(i, i)*(hp(i)-h(i)+t(i)*(cpv-cpd)*(rr(i)- &
-      qent(i,i)))*cpinv
-    ft(i) = ft(i) + 0.01*sigd*wt(i)*(cl-cpd)*water(i+1)*(t(i+1)-t(i))*dpinv* &
-      cpinv
-    fr(i) = 0.1*dpinv*(amp1*(rr(i+1)-rr(i))-ad*(rr(i)-rr(i-1)))
-    fu(i) = fu(i) + 0.1*dpinv*(amp1*(u(i+1)-u(i))-ad*(u(i)-u(i-1)))
-    fv(i) = fv(i) + 0.1*dpinv*(amp1*(v(i+1)-v(i))-ad*(v(i)-v(i-1)))
-    DO k = 1, ntra
-      ftra(i, k) = ftra(i, k) + 0.1*dpinv*(amp1*(tra(i+1,k)-tra(i, &
-        k))-ad*(tra(i,k)-tra(i-1,k)))
-    END DO
-    DO k = 1, i - 1
-      awat = elij(k, i) - (1.-ep(i))*clw(i)
-      awat = amax1(awat, 0.0)
-      fr(i) = fr(i) + 0.1*dpinv*ment(k, i)*(qent(k,i)-awat-rr(i))
-      fu(i) = fu(i) + 0.1*dpinv*ment(k, i)*(uent(k,i)-u(i))
-      fv(i) = fv(i) + 0.1*dpinv*ment(k, i)*(vent(k,i)-v(i))
-      ! (saturated updrafts resulting from mixing)      ! cld
-      qcond(i) = qcond(i) + (elij(k,i)-awat) ! cld
-      nqcond(i) = nqcond(i) + 1. ! cld
-      DO j = 1, ntra
-        ftra(i, j) = ftra(i, j) + 0.1*dpinv*ment(k, i)*(traent(k,i,j)-tra(i,j &
-          ))
-      END DO
-    END DO
-    DO k = i, inb
-      fr(i) = fr(i) + 0.1*dpinv*ment(k, i)*(qent(k,i)-rr(i))
-      fu(i) = fu(i) + 0.1*dpinv*ment(k, i)*(uent(k,i)-u(i))
-      fv(i) = fv(i) + 0.1*dpinv*ment(k, i)*(vent(k,i)-v(i))
-      DO j = 1, ntra
-        ftra(i, j) = ftra(i, j) + 0.1*dpinv*ment(k, i)*(traent(k,i,j)-tra(i,j &
-          ))
-      END DO
-    END DO
-    fr(i) = fr(i) + 0.5*sigd*(evap(i)+evap(i+1)) + 0.1*(mp(i+1)*(rp(i+ &
-      1)-rr(i))-mp(i)*(rp(i)-rr(i-1)))*dpinv
-    fu(i) = fu(i) + 0.1*(mp(i+1)*(up(i+1)-u(i))-mp(i)*(up(i)-u(i-1)))*dpinv
-    fv(i) = fv(i) + 0.1*(mp(i+1)*(vp(i+1)-v(i))-mp(i)*(vp(i)-v(i-1)))*dpinv
-    DO j = 1, ntra
-      ftra(i, j) = ftra(i, j) + 0.1*dpinv*(mp(i+1)*(trap(i+1,j)-tra(i, &
-        j))-mp(i)*(trap(i,j)-trap(i-1,j)))
-    END DO
-    ! (saturated downdrafts resulting from mixing)    ! cld
-    DO k = i + 1, inb ! cld
-      qcond(i) = qcond(i) + elij(k, i) ! cld
-      nqcond(i) = nqcond(i) + 1. ! cld
-    END DO ! cld
-    ! (particular case: no detraining level is found) ! cld
-    IF (nent(i)==0) THEN ! cld
-      qcond(i) = qcond(i) + (1-ep(i))*clw(i) ! cld
-      nqcond(i) = nqcond(i) + 1. ! cld
-    END IF ! cld
-    IF (nqcond(i)/=0.) THEN ! cld
-      qcond(i) = qcond(i)/nqcond(i) ! cld
-    END IF ! cld
-  END DO
-
-
-
-
-  ! ***   MOVE THE DETRAINMENT AT LEVEL INB DOWN TO LEVEL INB-1   ***
-  ! ***        IN SUCH A WAY AS TO PRESERVE THE VERTICALLY        ***
-  ! ***          INTEGRATED ENTHALPY AND WATER TENDENCIES         ***
-
-  ! test sb:
-  ! @      write(*,*) '--------------------------------------------'
-  ! @      write(*,*) 'inb,ft,hp,h,t,rr,qent,ment,water,waterp,wt,mp,b'
-  ! @      write(*,*) inb,ft(inb),hp(inb),h(inb)
-  ! @     :   ,t(inb),rr(inb),qent(inb,inb)
-  ! @     :   ,ment(inb,inb),water(inb)
-  ! @     :   ,water(inb+1),wt(inb),mp(inb),b(inb)
-  ! @      write(*,*) '--------------------------------------------'
-  ! fin test sb:
-
-  ax = 0.1*ment(inb, inb)*(hp(inb)-h(inb)+t(inb)*(cpv-cpd)*(rr(inb)-qent(inb, &
-    inb)))/(cpn(inb)*(ph(inb)-ph(inb+1)))
-  ft(inb) = ft(inb) - ax
-  ft(inb-1) = ft(inb-1) + ax*cpn(inb)*(ph(inb)-ph(inb+1))/(cpn(inb-1)*(ph(inb &
-    -1)-ph(inb)))
-  bx = 0.1*ment(inb, inb)*(qent(inb,inb)-rr(inb))/(ph(inb)-ph(inb+1))
-  fr(inb) = fr(inb) - bx
-  fr(inb-1) = fr(inb-1) + bx*(ph(inb)-ph(inb+1))/(ph(inb-1)-ph(inb))
-  cx = 0.1*ment(inb, inb)*(uent(inb,inb)-u(inb))/(ph(inb)-ph(inb+1))
-  fu(inb) = fu(inb) - cx
-  fu(inb-1) = fu(inb-1) + cx*(ph(inb)-ph(inb+1))/(ph(inb-1)-ph(inb))
-  dx = 0.1*ment(inb, inb)*(vent(inb,inb)-v(inb))/(ph(inb)-ph(inb+1))
-  fv(inb) = fv(inb) - dx
-  fv(inb-1) = fv(inb-1) + dx*(ph(inb)-ph(inb+1))/(ph(inb-1)-ph(inb))
-  DO j = 1, ntra
-    ex = 0.1*ment(inb, inb)*(traent(inb,inb,j)-tra(inb,j))/ &
-      (ph(inb)-ph(inb+1))
-    ftra(inb, j) = ftra(inb, j) - ex
-    ftra(inb-1, j) = ftra(inb-1, j) + ex*(ph(inb)-ph(inb+1))/(ph(inb-1)-ph( &
-      inb))
-  END DO
-
-  ! ***    HOMOGINIZE TENDENCIES BELOW CLOUD BASE    ***
-
-  asum = 0.0
-  bsum = 0.0
-  csum = 0.0
-  dsum = 0.0
-  DO i = 1, icb - 1
-    asum = asum + ft(i)*(ph(i)-ph(i+1))
-    bsum = bsum + fr(i)*(lv(i)+(cl-cpd)*(t(i)-t(1)))*(ph(i)-ph(i+1))
-    csum = csum + (lv(i)+(cl-cpd)*(t(i)-t(1)))*(ph(i)-ph(i+1))
-    dsum = dsum + t(i)*(ph(i)-ph(i+1))/th(i)
-  END DO
-  DO i = 1, icb - 1
-    ft(i) = asum*t(i)/(th(i)*dsum)
-    fr(i) = bsum/csum
-  END DO
-
-  ! ***           RESET COUNTER AND RETURN           ***
-
-  sig(nd) = 2.0
-
-
-  DO i = 1, nd
-    upwd(i) = 0.0
-    dnwd(i) = 0.0
-    ! sb       dnwd0(i) = - mp(i)
-  END DO
-
-  DO i = 1, nl
-    dnwd0(i) = -mp(i)
-  END DO
-  DO i = nl + 1, nd
-    dnwd0(i) = 0.
-  END DO
-
-  DO i = icb, inb
-    upwd(i) = 0.0
-    dnwd(i) = 0.0
-
-    DO k = i, inb
-      up1 = 0.0
-      dn1 = 0.0
-      DO n = 1, i - 1
-        up1 = up1 + ment(n, k)
-        dn1 = dn1 - ment(k, n)
-      END DO
-      upwd(i) = upwd(i) + m(k) + up1
-      dnwd(i) = dnwd(i) + dn1
-    END DO
-  END DO
-
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  ! DETERMINATION DE LA VARIATION DE FLUX ASCENDANT ENTRE
-  ! DEUX NIVEAU NON DILUE Mike
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-  ! sb      do i=1,ND
-  ! sb      Mike(i)=M(i)
-  ! sb      enddo
-
-  DO i = 1, nl
-    mike(i) = m(i)
-  END DO
-  DO i = nl + 1, nd
-    mike(i) = 0.
-  END DO
-
-  DO i = 1, nd
-    ma(i) = 0
-  END DO
-
-  ! sb      do i=1,nd
-  ! sb      do j=i,nd
-  ! sb      Ma(i)=Ma(i)+M(j)
-  ! sb      enddo
-  ! sb      enddo
-
-  DO i = 1, nl
-    DO j = i, nl
-      ma(i) = ma(i) + m(j)
-    END DO
-  END DO
-
-  DO i = nl + 1, nd
-    ma(i) = 0.
-  END DO
-
-  DO i = 1, icb - 1
-    ma(i) = 0
-  END DO
-
-
-
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  ! ICB REPRESENTE DE NIVEAU OU SE TROUVE LA
-  ! BASE DU NUAGE , ET INB LE TOP DU NUAGE
-  ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-  DO i = 1, nd
-    mke(i) = upwd(i) + dnwd(i)
-  END DO
-
-
-  ! *** Diagnose the in-cloud mixing ratio   ***              ! cld
-  ! ***           of condensed water         ***              ! cld
-  ! ! cld
-  DO i = 1, nd ! cld
-    maa(i) = 0.0 ! cld
-    wa(i) = 0.0 ! cld
-    siga(i) = 0.0 ! cld
-  END DO ! cld
-  DO i = nk, inb ! cld
-    DO k = i + 1, inb + 1 ! cld
-      maa(i) = maa(i) + m(k) ! cld
-    END DO ! cld
-  END DO ! cld
-  DO i = icb, inb - 1 ! cld
-    axc(i) = 0. ! cld
-    DO j = icb, i ! cld
-      axc(i) = axc(i) + rd*(tvp(j)-tv(j))*(ph(j)-ph(j+1))/p(j) ! cld
-    END DO ! cld
-    IF (axc(i)>0.0) THEN ! cld
-      wa(i) = sqrt(2.*axc(i)) ! cld
-    END IF ! cld
-  END DO ! cld
-  DO i = 1, nl ! cld
-    IF (wa(i)>0.0) &               ! cld
-      siga(i) = maa(i)/wa(i)*rd*tvp(i)/p(i)/100./deltac ! cld
-    siga(i) = min(siga(i), 1.0) ! cld
-    qcondc(i) = siga(i)*clw(i)*(1.-ep(i)) & ! cld
-      +(1.-siga(i))*qcond(i) ! cld
-  END DO ! cld
-
-
-  ! @$$cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  ! @$$         call writeg1d(1,klev,ma,'ma  ','ma  ')
-  ! @$$          call writeg1d(1,klev,upwd,'upwd  ','upwd  ')
-  ! @$$          call writeg1d(1,klev,dnwd,'dnwd  ','dnwd  ')
-  ! @$$          call writeg1d(1,klev,dnwd0,'dnwd0  ','dnwd0  ')
-  ! @$$          call writeg1d(1,klev,tvp,'tvp  ','tvp  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,3),'tra3  ','tra3  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,4),'tra4  ','tra4  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,5),'tra5  ','tra5  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,6),'tra6  ','tra6  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,7),'tra7  ','tra7  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,8),'tra8  ','tra8  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,9),'tra9  ','tra9  ')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,10),'tra10','tra10')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,11),'tra11','tra11')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,12),'tra12','tra12')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,13),'tra13','tra13')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,14),'tra14','tra14')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,15),'tra15','tra15')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,16),'tra16','tra16')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,17),'tra17','tra17')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,18),'tra18','tra18')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,19),'tra19','tra19')
-  ! @$$          call writeg1d(1,klev,tra(1:klev,20),'tra20','tra20 ')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,1),'trp1','trp1')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,2),'trp2','trp2')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,3),'trp3','trp3')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,4),'trp4','trp4')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,5),'trp5','trp5')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,10),'trp10','trp10')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,12),'trp12','trp12')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,15),'trp15','trp15')
-  ! @$$          call writeg1d(1,klev,trap(1:klev,20),'trp20','trp20')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,1),'ftr1  ','ftr1  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,2),'ftr2  ','ftr2  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,3),'ftr3  ','ftr3  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,4),'ftr4  ','ftr4  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,5),'ftr5  ','ftr5  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,6),'ftr6  ','ftr6  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,7),'ftr7  ','ftr7  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,8),'ftr8  ','ftr8  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,9),'ftr9  ','ftr9  ')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,10),'ftr10','ftr10')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,11),'ftr11','ftr11')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,12),'ftr12','ftr12')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,13),'ftr13','ftr13')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,14),'ftr14','ftr14')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,15),'ftr15','ftr15')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,16),'ftr16','ftr16')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,17),'ftr17','ftr17')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,18),'ftr18','ftr18')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,19),'ftr19','ftr19')
-  ! @$$          call writeg1d(1,klev,ftra(1:klev,20),'ftr20','ftr20 ')
-  ! @$$          call writeg1d(1,klev,mp,'mp  ','mp ')
-  ! @$$          call writeg1d(1,klev,Mke,'Mke  ','Mke ')
-
-
-
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-  RETURN
-END SUBROUTINE convect3
-! ---------------------------------------------------------------------------
+link ../phylmd/convect3.F90
Index: LMDZ6/trunk/libf/phylmdiso/cpl_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cpl_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cpl_mod.F90	(revision 3940)
@@ -1,1553 +1,1 @@
-!
-MODULE cpl_mod
-!
-! This module excahanges and transforms all fields that should be recieved or sent to 
-! coupler. The transformation of the fields are done from the grid 1D-array in phylmd 
-! to the regular 2D grid accepted by the coupler. Cumulation of the fields for each 
-! timestep is done in here. 
-!
-! Each type of surface that recevie fields from the coupler have a subroutine named 
-! cpl_receive_XXX_fields and each surface that have fields to be sent to the coupler 
-! have a subroutine named cpl_send_XXX_fields.
-!
-!*************************************************************************************
-
-! Use statements
-!*************************************************************************************
-  USE dimphy, ONLY : klon
-  USE mod_phys_lmdz_para
-  USE ioipsl
-  USE iophy
-
-! The module oasis is always used. Without the cpp key CPP_COUPLE only the parameters 
-! in the module are compiled and not the subroutines.
-  USE oasis
-  USE write_field_phy
-  USE time_phylmdz_mod, ONLY: day_step_phy
-  
-! Global attributes
-!*************************************************************************************
-  IMPLICIT NONE
-  PRIVATE
-
-  ! All subroutine are public except cpl_send_all
-  PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, &
-       cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, &
-       cpl_send_landice_fields, gath2cpl
-  
-
-! Declaration of module variables
-!*************************************************************************************
-! variable for coupling period
-  INTEGER, SAVE :: nexca
-  !$OMP THREADPRIVATE(nexca)
-
-! variables for cumulating fields during a coupling periode :
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_sols, cpl_nsol, cpl_rain
-  !$OMP THREADPRIVATE(cpl_sols,cpl_nsol,cpl_rain)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_snow, cpl_evap, cpl_tsol
-  !$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy
-  !$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_windsp
-  !$OMP THREADPRIVATE(cpl_windsp)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_sens_rain, cpl_sens_snow
-  !$OMP THREADPRIVATE(cpl_sens_rain, cpl_sens_snow)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_taumod
-  !$OMP THREADPRIVATE(cpl_taumod)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_atm_co2
-  !$OMP THREADPRIVATE(cpl_atm_co2)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D
-  !$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D)
-
-! variables read from coupler :
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sst     ! sea surface temperature
-  !$OMP THREADPRIVATE(read_sst)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sit     ! sea ice temperature
-  !$OMP THREADPRIVATE(read_sit)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sic     ! sea ice fraction
-  !$OMP THREADPRIVATE(read_sic)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_alb_sic ! albedo at sea ice
-  !$OMP THREADPRIVATE(read_alb_sic)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_u0, read_v0 ! ocean surface current
-  !$OMP THREADPRIVATE(read_u0,read_v0)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_co2     ! ocean co2 flux 
-  !$OMP THREADPRIVATE(read_co2)
-  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: unity
-  !$OMP THREADPRIVATE(unity)
-  INTEGER, SAVE                             :: nidct, nidcs
-  !$OMP THREADPRIVATE(nidct,nidcs)
-
-! variables to be sent to the coupler
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sols2D, cpl_nsol2D, cpl_rain2D
-  !$OMP THREADPRIVATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D
-  !$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D
-  !$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D
-  !$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taumod2D
-  !$OMP THREADPRIVATE(cpl_taumod2D)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_windsp2D
-  !$OMP THREADPRIVATE(cpl_windsp2D)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: cpl_sens_rain2D, cpl_sens_snow2D
-  !$OMP THREADPRIVATE(cpl_sens_rain2D, cpl_sens_snow2D)
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_atm_co22D
-  !$OMP THREADPRIVATE(cpl_atm_co22D)
-
-!!!!!!!!!! variable for calving
-  INTEGER, PARAMETER :: nb_zone_calving = 3
-  REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving 
-  !$OMP THREADPRIVATE(area_calving)
-  REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D 
-  !$OMP THREADPRIVATE(cell_area2D)
-  INTEGER, SAVE :: ind_calving(nb_zone_calving) 
-  !$OMP THREADPRIVATE(ind_calving)
-
-  LOGICAL,SAVE :: cpl_old_calving
-  !$OMP THREADPRIVATE(cpl_old_calving)
-  
-CONTAINS
-!
-!************************************************************************************
-!
-  SUBROUTINE cpl_init(dtime, rlon, rlat)
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
-    USE surface_data
-    USE indice_sol_mod
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo, klon_glo, grid_type, unstructured, regular_lonlat
-    USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy
-    USE print_control_mod, ONLY: lunout
-    USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area
-    USE ioipsl_getin_p_mod, ONLY: getin_p
-
-! Input arguments
-!*************************************************************************************
-    REAL, INTENT(IN)                  :: dtime
-    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
-
-! Local variables
-!*************************************************************************************
-    INTEGER                           :: error, sum_error, ig, i
-    INTEGER                           :: jf, nhoridct
-    INTEGER                           :: nhoridcs
-    INTEGER                           :: idtime
-    INTEGER                           :: idayref
-    INTEGER                           :: npas ! only for OASIS2
-    REAL                              :: zjulian
-    REAL, DIMENSION(nbp_lon,nbp_lat)  :: zx_lon, zx_lat
-    CHARACTER(len = 20)               :: modname = 'cpl_init'
-    CHARACTER(len = 80)               :: abort_message
-    CHARACTER(len=80)                 :: clintocplnam, clfromcplnam
-    REAL, DIMENSION(klon_mpi)         :: rlon_mpi, rlat_mpi, cell_area_mpi
-    INTEGER, DIMENSION(klon_mpi)           :: ind_cell_glo_mpi
-    REAL, DIMENSION(nbp_lon,jj_nb)         :: lon2D, lat2D
-    INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving)
-    REAL :: pos
-
-!***************************************
-! Use old calving or not (default new calving method)
-! New calving method should be used with DYNAMICO and when using new coupling
-! weights.
-    cpl_old_calving=.FALSE.
-    CALL getin_p("cpl_old_calving",cpl_old_calving)
-
-
-!*************************************************************************************
-! Calculate coupling period
-!
-!*************************************************************************************
-     
-    npas = itaufin_phy
-!    nexca = 86400 / dtime
-    nexca = t_coupl / dtime
-    WRITE(lunout,*)' ##### Ocean couple #####'
-    WRITE(lunout,*)' Valeurs des pas de temps'
-    WRITE(lunout,*)' npas = ', npas
-    WRITE(lunout,*)' nexca = ', nexca
-    
-!*************************************************************************************
-! Allocate variables
-!
-!*************************************************************************************
-    error = 0
-    sum_error = 0
-
-    ALLOCATE(unity(klon), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_sols(klon,2), stat = error) 
-    sum_error = sum_error + error
-    ALLOCATE(cpl_nsol(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_rain(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_snow(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_evap(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_tsol(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_fder(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_albe(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_taux(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_tauy(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_windsp(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_taumod(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_sens_rain(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_sens_snow(klon,2), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_rriv2D(nbp_lon,jj_nb), stat=error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_rcoa2D(nbp_lon,jj_nb), stat=error)
-    sum_error = sum_error + error
-    ALLOCATE(cpl_rlic2D(nbp_lon,jj_nb), stat=error)
-    sum_error = sum_error + error
-    ALLOCATE(read_sst(nbp_lon, jj_nb), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(read_sic(nbp_lon, jj_nb), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(read_sit(nbp_lon, jj_nb), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(read_alb_sic(nbp_lon, jj_nb), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(read_u0(nbp_lon, jj_nb), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(read_v0(nbp_lon, jj_nb), stat = error)
-    sum_error = sum_error + error
-
-    IF (carbon_cycle_cpl) THEN
-       ALLOCATE(read_co2(nbp_lon, jj_nb), stat = error)
-       sum_error = sum_error + error
-       ALLOCATE(cpl_atm_co2(klon,2), stat = error)
-       sum_error = sum_error + error
-
-! Allocate variable in carbon_cycle_mod
-       IF (.NOT.ALLOCATED(fco2_ocn_day)) ALLOCATE(fco2_ocn_day(klon), stat = error)
-       sum_error = sum_error + error
-    ENDIF
-
-! calving initialization
-    ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error)
-    sum_error = sum_error + error
-    ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error)    
-    sum_error = sum_error + error
-
-
-    CALL gather_omp(longitude_deg,rlon_mpi)
-    CALL gather_omp(latitude_deg,rlat_mpi)
-    CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
-    CALL gather_omp(cell_area,cell_area_mpi)
-      
-    IF (is_omp_master) THEN
-      CALL Grid1DTo2D_mpi(rlon_mpi,lon2D)
-      CALL Grid1DTo2D_mpi(rlat_mpi,lat2D)
-      CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D)
-      mask_calving(:,:,:) = 0 
-      WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1
-      WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1
-      WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1
-    
-    
-      DO i=1,nb_zone_calving
-        area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:)
-        pos=1
-        IF (i>1) pos = 1 + ((nbp_lon*nbp_lat-1)*(i-1))/(nb_zone_calving-1)
-      
-        ind_calving(i)=0
-        IF (grid_type==unstructured) THEN
-
-          DO ig=1,klon_mpi
-            IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig
-          ENDDO
-
-        ELSE IF (grid_type==regular_lonlat) THEN
-          IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN
-            ind_calving(i)=pos-(jj_begin-1)*nbp_lon
-          ENDIF
-        ENDIF
-     
-      ENDDO
-    ENDIF
-    
-           
-    IF (sum_error /= 0) THEN
-       abort_message='Pb allocation variables couplees'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-!*************************************************************************************
-! Initialize the allocated varaibles
-!
-!*************************************************************************************
-    DO ig = 1, klon
-       unity(ig) = ig
-    ENDDO
-
-!*************************************************************************************
-! Initialize coupling
-!
-!*************************************************************************************
-    idtime = INT(dtime)
-#ifdef CPP_COUPLE
-    CALL inicma
-#endif
-
-!*************************************************************************************
-! initialize NetCDF output
-!
-!*************************************************************************************
-    IF (is_sequential) THEN
-       idayref = day_ini
-       CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-       CALL grid1dTo2d_glo(rlon,zx_lon)
-       DO i = 1, nbp_lon
-          zx_lon(i,1) = rlon(i+1)
-          zx_lon(i,nbp_lat) = rlon(i+1)
-       ENDDO
-       CALL grid1dTo2d_glo(rlat,zx_lat)
-       clintocplnam="cpl_atm_tauflx"
-       CALL histbeg(clintocplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),&
-            1,nbp_lon,1,nbp_lat, itau_phy,zjulian,dtime,nhoridct,nidct) 
-! no vertical axis
-       CALL histdef(nidct, 'tauxe','tauxe', &
-            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
-       CALL histdef(nidct, 'tauyn','tauyn', &
-            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
-       CALL histdef(nidct, 'tmp_lon','tmp_lon', &
-            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
-       CALL histdef(nidct, 'tmp_lat','tmp_lat', &
-            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
-       DO jf=1,maxsend
-         IF (infosend(i)%action) THEN
-             CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , &
-                "-",nbp_lon,nbp_lat,nhoridct,1,1,1,-99,32,"inst",dtime,dtime)
-         ENDIF
-       ENDDO
-       CALL histend(nidct)
-       CALL histsync(nidct)
-       
-       clfromcplnam="cpl_atm_sst"
-       CALL histbeg(clfromcplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),1,nbp_lon,1,nbp_lat, &
-            0,zjulian,dtime,nhoridcs,nidcs) 
-! no vertical axis
-       DO jf=1,maxrecv
-         IF (inforecv(i)%action) THEN
-             CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , &
-                "-",nbp_lon,nbp_lat,nhoridcs,1,1,1,-99,32,"inst",dtime,dtime)
-         ENDIF
-       ENDDO
-       CALL histend(nidcs)
-       CALL histsync(nidcs)
-
-    ENDIF    ! is_sequential
-    
-
-!*************************************************************************************
-! compatibility test
-!
-!*************************************************************************************
-    IF (carbon_cycle_cpl .AND. version_ocean=='opa8') THEN
-       abort_message='carbon_cycle_cpl does not work with opa8'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-  END SUBROUTINE cpl_init
-  
-!
-!*************************************************************************************
-!
- 
-  SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified)
-! This subroutine receives from coupler for both ocean and seaice
-! 4 fields : read_sst, read_sic, read_sit and read_alb_sic. 
-! The new sea-ice-land-landice fraction is returned. The others fields 
-! are stored in this module.
-    USE surface_data
-    USE geometry_mod, ONLY : longitude_deg, latitude_deg
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-    USE indice_sol_mod
-    USE time_phylmdz_mod, ONLY: start_time, itau_phy
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-    INCLUDE "YOMCST.h"
-
-! Arguments
-!************************************************************************************
-    INTEGER, INTENT(IN)                        :: itime
-    REAL, INTENT(IN)                           :: dtime
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf
-    LOGICAL, INTENT(OUT)                       :: is_modified
-
-! Local variables
-!************************************************************************************
-    INTEGER                                 :: j, i, time_sec
-    INTEGER                                 :: itau_w
-    INTEGER, DIMENSION(nbp_lon*nbp_lat)     :: ndexcs
-    CHARACTER(len = 20)                     :: modname = 'cpl_receive_frac'
-    CHARACTER(len = 80)                     :: abort_message
-    REAL, DIMENSION(klon)                   :: read_sic1D
-    REAL, DIMENSION(nbp_lon,jj_nb,maxrecv)      :: tab_read_flds
-    REAL, DIMENSION(klon,nbsrf)             :: pctsrf_old
-    REAL, DIMENSION(klon_mpi)               :: rlon_mpi, rlat_mpi
-    REAL, DIMENSION(nbp_lon,jj_nb)             :: tmp_lon, tmp_lat
-    REAL, DIMENSION(nbp_lon,jj_nb)             :: tmp_r0
-
-!*************************************************************************************
-! Start calculation
-! Get fields from coupler
-!
-!*************************************************************************************
-
-    is_modified=.FALSE.
-
-! Check if right moment to receive from coupler
-    IF (MOD(itime, nexca) == 1) THEN
-       is_modified=.TRUE.
- 
-       time_sec=(itime-1)*dtime
-#ifdef CPP_COUPLE
-!$OMP MASTER
-    CALL fromcpl(time_sec, tab_read_flds)
-!$OMP END MASTER
-#endif
-    
-! NetCDF output of received fields
-       IF (is_sequential) THEN
-          ndexcs(:) = 0
-          itau_w = itau_phy + itime + start_time * day_step_phy
-          DO i = 1, maxrecv
-            IF (inforecv(i)%action) THEN
-                CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),nbp_lon*(nbp_lat),ndexcs)
-            ENDIF
-          ENDDO
-       ENDIF
-
-
-! Save each field in a 2D array. 
-!$OMP MASTER
-       read_sst(:,:)     = tab_read_flds(:,:,idr_sisutw)  ! Sea surface temperature
-       read_sic(:,:)     = tab_read_flds(:,:,idr_icecov)  ! Sea ice concentration
-       read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw)  ! Albedo at sea ice
-       read_sit(:,:)     = tab_read_flds(:,:,idr_icetem)  ! Sea ice temperature
-!$OMP END MASTER
-
-       IF (cpl_current) THEN
-
-! Transform the longitudes and latitudes on 2D arrays
-          CALL gather_omp(longitude_deg,rlon_mpi)
-          CALL gather_omp(latitude_deg,rlat_mpi)
-!$OMP MASTER
-          CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
-          CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
-
-! Transform the currents from cartesian to spheric coordinates
-! tmp_r0 should be zero
-          CALL geo2atm(nbp_lon, jj_nb, tab_read_flds(:,:,idr_curenx), &
-             tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), &
-               tmp_lon, tmp_lat, &
-               read_u0(:,:), read_v0(:,:), tmp_r0(:,:))
-!$OMP END MASTER
-
-      ELSE
-          read_u0(:,:) = 0.
-          read_v0(:,:) = 0.
-      ENDIF
-
-       IF (carbon_cycle_cpl) THEN
-!$OMP MASTER
-           read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux
-!$OMP END MASTER
-       ENDIF
-
-!*************************************************************************************
-!  Transform seaice fraction (read_sic : ocean-seaice mask) into global 
-!  fraction (pctsrf : ocean-seaice-land-landice mask)
-!
-!*************************************************************************************
-       CALL cpl2gath(read_sic, read_sic1D, klon, unity)
-
-       pctsrf_old(:,:) = pctsrf(:,:)
-       DO i = 1, klon
-          ! treatment only of points with ocean and/or seaice
-          ! old land-ocean mask can not be changed
-          IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN
-             pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
-                  * read_sic1D(i)
-             pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
-                  - pctsrf(i,is_sic)
-          ENDIF
-       ENDDO
-
-    ENDIF ! if time to receive
-
-  END SUBROUTINE cpl_receive_frac
-
-!
-!*************************************************************************************
-!
-
-  SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, v0_new)
-!
-! This routine returns the field for the ocean that has been read from the coupler
-! (done earlier with cpl_receive_frac). The field is the temperature.
-! The temperature is transformed into 1D array with valid points from index 1 to knon.
-!
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
-    USE indice_sol_mod
-
-! Input arguments
-!*************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-
-! Output arguments
-!*************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)      :: u0_new
-    REAL, DIMENSION(klon), INTENT(OUT)      :: v0_new
-
-! Local variables
-!*************************************************************************************
-    INTEGER                  :: i
-    INTEGER, DIMENSION(klon) :: index
-    REAL, DIMENSION(klon)    :: sic_new
-
-!*************************************************************************************
-! Transform read_sst into compressed 1D variable tsurf_new
-!
-!*************************************************************************************
-    CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
-    CALL cpl2gath(read_sic, sic_new, knon, knindex)
-    CALL cpl2gath(read_u0, u0_new, knon, knindex)
-    CALL cpl2gath(read_v0, v0_new, knon, knindex)
-
-!*************************************************************************************
-! Transform read_co2 into uncompressed 1D variable fco2_ocn_day added directly in 
-! the module carbon_cycle_mod
-!
-!*************************************************************************************
-    IF (carbon_cycle_cpl) THEN
-       DO i=1,klon
-          index(i)=i
-       ENDDO
-       CALL cpl2gath(read_co2, fco2_ocn_day, klon, index)
-    ENDIF
-
-!*************************************************************************************
-! The fields received from the coupler have to be weighted with the fraction of ocean 
-! in relation to the total sea-ice+ocean
-!
-!*************************************************************************************
-    DO i=1, knon
-       tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i))
-    ENDDO
-
-  END SUBROUTINE cpl_receive_ocean_fields
-
-!
-!*************************************************************************************
-!
-
-  SUBROUTINE cpl_receive_seaice_fields(knon, knindex, &
-       tsurf_new, alb_new, u0_new, v0_new)
-!
-! This routine returns the fields for the seaice that have been read from the coupler
-! (done earlier with cpl_receive_frac). These fields are the temperature and 
-! albedo at sea ice surface and fraction of sea ice.
-! The fields are transformed into 1D arrays with valid points from index 1 to knon. 
-!
-
-! Input arguments
-!*************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-
-! Output arguments
-!*************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)      :: alb_new
-    REAL, DIMENSION(klon), INTENT(OUT)      :: u0_new
-    REAL, DIMENSION(klon), INTENT(OUT)      :: v0_new
-
-! Local variables
-!*************************************************************************************
-    INTEGER               :: i
-    REAL, DIMENSION(klon) :: sic_new
-
-!*************************************************************************************
-! Transform fields read from coupler from 2D into compressed 1D variables
-!
-!*************************************************************************************
-    CALL cpl2gath(read_sit, tsurf_new, knon, knindex)
-    CALL cpl2gath(read_alb_sic, alb_new, knon, knindex)
-    CALL cpl2gath(read_sic, sic_new, knon, knindex)
-    CALL cpl2gath(read_u0, u0_new, knon, knindex)
-    CALL cpl2gath(read_v0, v0_new, knon, knindex)
-
-!*************************************************************************************
-! The fields received from the coupler have to be weighted with the sea-ice 
-! concentration (in relation to the total sea-ice + ocean).
-!
-!*************************************************************************************
-    DO i= 1, knon
-       tsurf_new(i) = tsurf_new(i) / sic_new(i)
-       alb_new(i)   = alb_new(i)   / sic_new(i)
-    ENDDO
-
-  END SUBROUTINE cpl_receive_seaice_fields
-
-!
-!*************************************************************************************
-!
-
-  SUBROUTINE cpl_send_ocean_fields(itime, knon, knindex, &
-       swdown, lwdown, fluxlat, fluxsens, &
-       precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp,&
-       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-!
-! This subroutine cumulates some fields for each time-step during a coupling 
-! period. At last time-step in a coupling period the fields are transformed to the 
-! grid accepted by the coupler. No sending to the coupler will be done from here 
-! (it is done in cpl_send_seaice_fields).
-!
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
-    USE indice_sol_mod
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-! Input arguments
-!*************************************************************************************
-    INTEGER, INTENT(IN)                     :: itime
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    REAL, DIMENSION(klon), INTENT(IN)       :: swdown, lwdown 
-    REAL, DIMENSION(klon), INTENT(IN)       :: fluxlat, fluxsens
-    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)       :: evap, tsurf, fder, albsol
-    REAL, DIMENSION(klon), INTENT(IN)       :: taux, tauy, windsp
-    REAL, DIMENSION(klon), INTENT(IN)       :: sens_prec_liq, sens_prec_sol
-    REAL, DIMENSION(klon), INTENT(IN)       :: lat_prec_liq, lat_prec_sol
-
-! Local variables
-!*************************************************************************************
-    INTEGER                                 :: cpl_index, ig 
-    INTEGER                                 :: error, sum_error
-    CHARACTER(len = 25)                     :: modname = 'cpl_send_ocean_fields'
-    CHARACTER(len = 80)                     :: abort_message
-
-!*************************************************************************************
-! Start calculation
-! The ocean points are saved with second array index=1
-!
-!*************************************************************************************
-    cpl_index = 1
-
-!*************************************************************************************
-! Reset fields to zero in the beginning of a new coupling period 
-!
-!*************************************************************************************
-    IF (MOD(itime, nexca) == 1) THEN
-       cpl_sols(1:knon,cpl_index) = 0.0
-       cpl_nsol(1:knon,cpl_index) = 0.0
-       cpl_rain(1:knon,cpl_index) = 0.0
-       cpl_snow(1:knon,cpl_index) = 0.0
-       cpl_evap(1:knon,cpl_index) = 0.0
-       cpl_tsol(1:knon,cpl_index) = 0.0
-       cpl_fder(1:knon,cpl_index) = 0.0
-       cpl_albe(1:knon,cpl_index) = 0.0
-       cpl_taux(1:knon,cpl_index) = 0.0
-       cpl_tauy(1:knon,cpl_index) = 0.0
-       cpl_windsp(1:knon,cpl_index) = 0.0
-       cpl_sens_rain(1:knon,cpl_index) = 0.0
-       cpl_sens_snow(1:knon,cpl_index) = 0.0
-       cpl_taumod(1:knon,cpl_index) = 0.0
-       IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0
-    ENDIF
-       
-!*************************************************************************************
-! Cumulate at each time-step
-!
-!*************************************************************************************    
-    DO ig = 1, knon
-       cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
-            swdown(ig)      / REAL(nexca)
-       cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
-            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
-       cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
-            precip_rain(ig) / REAL(nexca)
-       cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
-            precip_snow(ig) / REAL(nexca)
-       cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
-            evap(ig)        / REAL(nexca)
-       cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
-            tsurf(ig)       / REAL(nexca)
-       cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
-            fder(ig)        / REAL(nexca)
-       cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
-            albsol(ig)      / REAL(nexca)
-       cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
-            taux(ig)        / REAL(nexca)
-       cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
-            tauy(ig)        / REAL(nexca)      
-       cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + &
-            windsp(ig)      / REAL(nexca)
-       cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
-            sens_prec_liq(ig)      / REAL(nexca)
-       cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
-            sens_prec_sol(ig)      / REAL(nexca)
-       cpl_taumod(ig,cpl_index) =   cpl_taumod(ig,cpl_index) + &
-          SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL (nexca)
-
-       IF (carbon_cycle_cpl) THEN
-          cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + &
-               co2_send(knindex(ig))/ REAL(nexca) 
-!!---OB: this is correct but why knindex ??
-       ENDIF
-     ENDDO
-
-!*************************************************************************************
-! If the time-step corresponds to the end of coupling period the 
-! fields are transformed to the 2D grid. 
-! No sending to the coupler (it is done from cpl_send_seaice_fields).
-!
-!*************************************************************************************
-    IF (MOD(itime, nexca) == 0) THEN
-
-       IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
-          sum_error = 0
-          ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          
-          IF (carbon_cycle_cpl) THEN
-             ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
-             sum_error = sum_error + error
-          ENDIF
-
-          IF (sum_error /= 0) THEN
-             abort_message='Pb allocation variables couplees pour l''ecriture'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       
-
-       CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
-            knon, knindex)
-
-! cpl_tsol2D(:,:,:) not used!
-       CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
-            knon, knindex)
-
-! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)!
-       CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), &
-            knon, knindex)
-
-! cpl_albe2D(:,:,:) not used!
-       CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_windsp(:,cpl_index), cpl_windsp2D(:,:), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
-            knon, knindex)
-
-       IF (carbon_cycle_cpl) &
-            CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex)
-   ENDIF
-
-  END SUBROUTINE cpl_send_ocean_fields
-
-!
-!*************************************************************************************
-!
-
-  SUBROUTINE cpl_send_seaice_fields(itime, dtime, knon, knindex, &
-       pctsrf, lafin, rlon, rlat, &
-       swdown, lwdown, fluxlat, fluxsens, &
-       precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy,&
-       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-!
-! This subroutine cumulates some fields for each time-step during a coupling 
-! period. At last time-step in a coupling period the fields are transformed to the 
-! grid accepted by the coupler. All fields for all types of surfaces are sent to
-! the coupler.
-!
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-    USE indice_sol_mod
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-! Input arguments
-!*************************************************************************************
-    INTEGER, INTENT(IN)                     :: itime
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    REAL, INTENT(IN)                        :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)       :: swdown, lwdown 
-    REAL, DIMENSION(klon), INTENT(IN)       :: fluxlat, fluxsens
-    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)       :: evap, tsurf, fder
-    REAL, DIMENSION(klon), INTENT(IN)       :: albsol, taux, tauy
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)       :: sens_prec_liq, sens_prec_sol
-    REAL, DIMENSION(klon), INTENT(IN)       :: lat_prec_liq, lat_prec_sol
-    LOGICAL, INTENT(IN)                     :: lafin
-
-! Local variables
-!*************************************************************************************
-    INTEGER                                 :: cpl_index, ig 
-    INTEGER                                 :: error, sum_error
-    CHARACTER(len = 25)                     :: modname = 'cpl_send_seaice_fields'
-    CHARACTER(len = 80)                     :: abort_message
-    REAL, DIMENSION(klon)                   :: cpl_fder_tmp
-
-!*************************************************************************************
-! Start calulation
-! The sea-ice points are saved with second array index=2
-!
-!*************************************************************************************
-    cpl_index = 2
-
-!*************************************************************************************
-! Reset fields to zero in the beginning of a new coupling period 
-!
-!*************************************************************************************
-    IF (MOD(itime, nexca) == 1) THEN
-       cpl_sols(1:knon,cpl_index) = 0.0
-       cpl_nsol(1:knon,cpl_index) = 0.0
-       cpl_rain(1:knon,cpl_index) = 0.0
-       cpl_snow(1:knon,cpl_index) = 0.0
-       cpl_evap(1:knon,cpl_index) = 0.0
-       cpl_tsol(1:knon,cpl_index) = 0.0
-       cpl_fder(1:knon,cpl_index) = 0.0
-       cpl_albe(1:knon,cpl_index) = 0.0
-       cpl_taux(1:knon,cpl_index) = 0.0
-       cpl_tauy(1:knon,cpl_index) = 0.0
-       cpl_sens_rain(1:knon,cpl_index) = 0.0
-       cpl_sens_snow(1:knon,cpl_index) = 0.0
-       cpl_taumod(1:knon,cpl_index) = 0.0
-    ENDIF
-       
-!*************************************************************************************
-! Cumulate at each time-step
-!
-!*************************************************************************************    
-    DO ig = 1, knon
-       cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
-            swdown(ig)      / REAL(nexca)
-       cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
-            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
-       cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
-            precip_rain(ig) / REAL(nexca)
-       cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
-            precip_snow(ig) / REAL(nexca)
-       cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
-            evap(ig)        / REAL(nexca)
-       cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
-            tsurf(ig)       / REAL(nexca)
-       cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
-            fder(ig)        / REAL(nexca)
-       cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
-            albsol(ig)      / REAL(nexca)
-       cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
-            taux(ig)        / REAL(nexca)
-       cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
-            tauy(ig)        / REAL(nexca)     
-       cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
-            sens_prec_liq(ig)      / REAL(nexca)
-       cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
-            sens_prec_sol(ig)      / REAL(nexca)
-       cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
-            SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL(nexca) 
-    ENDDO
-
-!*************************************************************************************
-! If the time-step corresponds to the end of coupling period the 
-! fields are transformed to the 2D grid and all fields are sent to coupler.
-!
-!*************************************************************************************
-    IF (MOD(itime, nexca) == 0) THEN
-       IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
-          sum_error = 0
-          ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-          ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
-          sum_error = sum_error + error
-
-          IF (carbon_cycle_cpl) THEN
-             ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
-             sum_error = sum_error + error
-          ENDIF
-
-          IF (sum_error /= 0) THEN
-             abort_message='Pb allocation variables couplees pour l''ecriture'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-
-       CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
-            knon, knindex)
-
-! cpl_tsol2D(:,:,:) not used!
-       CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
-            knon, knindex)
-
-       ! Set default value and decompress before gath2cpl
-       cpl_fder_tmp(:) = -20.
-       DO ig = 1, knon
-          cpl_fder_tmp(knindex(ig))=cpl_fder(ig,cpl_index)
-       ENDDO
-       CALL gath2cpl(cpl_fder_tmp(:), cpl_fder2D(:,:,cpl_index), &
-            klon, unity)
-
-! cpl_albe2D(:,:,:) not used!
-       CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
-            knon, knindex)
-
-       CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
-            knon, knindex)
-
-       ! Send all fields
-       CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
-    ENDIF
-
-  END SUBROUTINE cpl_send_seaice_fields
-
-!
-!*************************************************************************************
-!
-
-  SUBROUTINE cpl_send_land_fields(itime, knon, knindex, rriv_in, rcoa_in)
-!
-! This subroutine cumulates some fields for each time-step during a coupling 
-! period. At last time-step in a coupling period the fields are transformed to the 
-! grid accepted by the coupler. No sending to the coupler will be done from here 
-! (it is done in cpl_send_seaice_fields).
-!
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-! Input arguments
-!*************************************************************************************
-    INTEGER, INTENT(IN)                       :: itime
-    INTEGER, INTENT(IN)                       :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-    REAL, DIMENSION(klon), INTENT(IN)         :: rriv_in
-    REAL, DIMENSION(klon), INTENT(IN)         :: rcoa_in
-
-! Local variables
-!*************************************************************************************
-    REAL, DIMENSION(nbp_lon,jj_nb)             :: rriv2D
-    REAL, DIMENSION(nbp_lon,jj_nb)             :: rcoa2D
-
-!*************************************************************************************
-! Rearrange fields in 2D variables 
-! First initialize to zero to avoid unvalid points causing problems
-!
-!*************************************************************************************
-!$OMP MASTER
-    rriv2D(:,:) = 0.0
-    rcoa2D(:,:) = 0.0
-!$OMP END MASTER
-    CALL gath2cpl(rriv_in, rriv2D, knon, knindex)
-    CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex)
-
-!*************************************************************************************
-! Reset cumulated fields to zero in the beginning of a new coupling period 
-!
-!*************************************************************************************
-    IF (MOD(itime, nexca) == 1) THEN
-!$OMP MASTER
-       cpl_rriv2D(:,:) = 0.0
-       cpl_rcoa2D(:,:) = 0.0
-!$OMP END MASTER
-    ENDIF
-
-!*************************************************************************************
-! Cumulate : Following fields should be cumulated at each time-step
-!
-!*************************************************************************************    
-!$OMP MASTER
-    cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca)
-    cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca)
-!$OMP END MASTER
-
-  END SUBROUTINE cpl_send_land_fields
-
-!
-!*************************************************************************************
-!
-
-  SUBROUTINE cpl_send_landice_fields(itime, knon, knindex, rlic_in)
-! This subroutine cumulates the field for melting ice for each time-step 
-! during a coupling period. This routine will not send to coupler. Sending 
-! will be done in cpl_send_seaice_fields.
-!
-
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-! Input varibales
-!*************************************************************************************
-    INTEGER, INTENT(IN)                       :: itime
-    INTEGER, INTENT(IN)                       :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-    REAL, DIMENSION(klon), INTENT(IN)         :: rlic_in
-
-! Local varibales
-!*************************************************************************************
-    REAL, DIMENSION(nbp_lon,jj_nb)             :: rlic2D
-
-!*************************************************************************************
-! Rearrange field in a 2D variable 
-! First initialize to zero to avoid unvalid points causing problems
-!
-!*************************************************************************************
-!$OMP MASTER
-    rlic2D(:,:) = 0.0
-!$OMP END MASTER
-    CALL gath2cpl(rlic_in, rlic2D, knon, knindex)
-
-!*************************************************************************************
-! Reset field to zero in the beginning of a new coupling period 
-!
-!*************************************************************************************
-    IF (MOD(itime, nexca) == 1) THEN
-!$OMP MASTER
-       cpl_rlic2D(:,:) = 0.0
-!$OMP END MASTER
-    ENDIF
-
-!*************************************************************************************
-! Cumulate : Melting ice should be cumulated at each time-step
-!
-!*************************************************************************************    
-!$OMP MASTER
-    cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca)
-!$OMP END MASTER
-
-  END SUBROUTINE cpl_send_landice_fields
-
-!
-!*************************************************************************************
-!
-
-  SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
-! This routine will send fields for all different surfaces to the coupler.
-! This subroutine should be executed after calculations by the last surface(sea-ice),
-! all calculations at the different surfaces have to be done before. 
-!    
-    USE surface_data
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-    USE indice_sol_mod
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-    USE time_phylmdz_mod, ONLY: start_time, itau_phy
-! Some includes
-!    
-! Input arguments
-!*************************************************************************************
-    INTEGER, INTENT(IN)                                  :: itime
-    REAL, INTENT(IN)                                     :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)                    :: rlon, rlat
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)              :: pctsrf
-    LOGICAL, INTENT(IN)                                  :: lafin
-    
-! Local variables
-!*************************************************************************************
-    INTEGER                                              :: error, sum_error, i,j,k
-    INTEGER                                              :: itau_w
-    INTEGER                                              :: time_sec
-    INTEGER, DIMENSION(nbp_lon*(nbp_lat))                      :: ndexct
-    REAL                                                 :: Up, Down
-    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_lon, tmp_lat
-    REAL, DIMENSION(nbp_lon, jj_nb, 4)                       :: pctsrf2D
-    REAL, DIMENSION(nbp_lon, jj_nb)                          :: deno
-    CHARACTER(len = 20)                                  :: modname = 'cpl_send_all'
-    CHARACTER(len = 80)                                  :: abort_message
-   
-! Variables with fields to coupler
-    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_taux
-    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_tauy
-    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_calv
-! Table with all fields to send to coupler
-    REAL, DIMENSION(nbp_lon, jj_nb, maxsend)                 :: tab_flds
-    REAL, DIMENSION(klon_mpi)                                :: rlon_mpi, rlat_mpi
-    REAL  :: calving(nb_zone_calving)
-    REAL  :: calving_glo(nb_zone_calving)
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-    INTEGER, DIMENSION(MPI_STATUS_SIZE)                  :: status
-#endif
-
-! End definitions
-!*************************************************************************************
-    
-
-
-!*************************************************************************************
-! All fields are stored in a table tab_flds(:,:,:)
-! First store the fields which are already on the right format
-!
-!*************************************************************************************
-!$OMP MASTER
-    tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:)
-    tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2)
-    tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2)
-    tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2)
-    tab_flds(:,:,ids_qraioc) = cpl_sens_rain2D(:,:,1)
-    tab_flds(:,:,ids_qsnooc) = cpl_sens_snow2D(:,:,1)
-    tab_flds(:,:,ids_qraiic) = cpl_sens_rain2D(:,:,2)
-    tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2)
-    
-    IF (version_ocean=='nemo') THEN
-       tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:))
-       IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
-    ELSE IF (version_ocean=='opa8') THEN
-       tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1)
-       tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1)
-       tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
-       tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1)
-       tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:)
-       tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:)
-    ENDIF
-
-!*************************************************************************************
-! Transform the fraction of sub-surfaces from 1D to 2D array
-!
-!*************************************************************************************
-    pctsrf2D(:,:,:) = 0.
-!$OMP END MASTER
-    CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity)
-    CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity)
-    CALL gath2cpl(pctsrf(:,is_lic), pctsrf2D(:,:,is_lic), klon, unity)
-
-!*************************************************************************************
-! Calculate the average calving per latitude
-! Store calving in tab_flds(:,:,19)
-! 
-!*************************************************************************************      
-    IF (is_omp_root) THEN
-
-      IF (cpl_old_calving) THEN   ! use old calving
-
-        DO j = 1, jj_nb
-           tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:nbp_lon,j), &
-                pctsrf2D(1:nbp_lon,j,is_lic)) / REAL(nbp_lon)
-        ENDDO
-    
-    
-        IF (is_parallel) THEN
-           IF (.NOT. is_north_pole_dyn) THEN
-#ifdef CPP_MPI
-              CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
-              CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
-#endif
-           ENDIF
-       
-           IF (.NOT. is_south_pole_dyn) THEN
-#ifdef CPP_MPI
-              CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
-              CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
-#endif
-           ENDIF
-         
-           IF (.NOT. is_north_pole_dyn .AND. ii_begin /=1) THEN
-              Up=Up+tmp_calv(nbp_lon,1)
-              tmp_calv(:,1)=Up
-           ENDIF
-           
-           IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN
-              Down=Down+tmp_calv(1,jj_nb)
-              tmp_calv(:,jj_nb)=Down
-           ENDIF
-        ENDIF
-        tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
-
-      ELSE
-         ! cpl_old_calving=FALSE
-         ! To be used with new method for calculation of coupling weights
-         DO k=1,nb_zone_calving
-            calving(k)=0
-            DO j = 1, jj_nb
-               calving(k)= calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic))
-            ENDDO
-         ENDDO
-         
-#ifdef CPP_MPI
-         CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
-#endif
-         
-         tab_flds(:,:,ids_calvin) = 0
-         DO k=1,nb_zone_calving
-            IF (ind_calving(k)>0 ) THEN
-               j=(ind_calving(k)-1)/nbp_lon + 1
-               i=MOD(ind_calving(k)-1,nbp_lon)+1
-               tab_flds(i,j,ids_calvin) = calving_glo(k)
-            ENDIF
-         ENDDO
-         
-      ENDIF
-      
-!*************************************************************************************
-! Calculate total flux for snow, rain and wind with weighted addition using the 
-! fractions of ocean and seaice.
-!
-!*************************************************************************************    
-       ! fraction oce+seaice
-       deno =  pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic) 
-
-       IF (version_ocean=='nemo') THEN
-          tab_flds(:,:,ids_shftot)  = 0.0
-          tab_flds(:,:,ids_nsftot) = 0.0
-          tab_flds(:,:,ids_totrai) = 0.0
-          tab_flds(:,:,ids_totsno) = 0.0
-          tab_flds(:,:,ids_toteva) = 0.0
-          tab_flds(:,:,ids_taumod) = 0.0
-  
-          tmp_taux(:,:)    = 0.0
-          tmp_tauy(:,:)    = 0.0
-          ! For all valid grid cells containing some fraction of ocean or sea-ice
-          WHERE ( deno(:,:) /= 0 )
-             tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-
-             tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_evap2D(:,:,2)  * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             
-         ENDWHERE
-
-          tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2) 
-          
-       ELSE IF (version_ocean=='opa8') THEN
-          ! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16)
-          tab_flds(:,:,ids_totrai) = 0.0
-          tab_flds(:,:,ids_totsno) = 0.0
-          tmp_taux(:,:)    = 0.0
-          tmp_tauy(:,:)    = 0.0
-          ! For all valid grid cells containing some fraction of ocean or sea-ice
-          WHERE ( deno(:,:) /= 0 )
-             tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             
-             tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
-                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
-          ENDWHERE
-       ENDIF
-
-    ENDIF ! is_omp_root
-  
-!*************************************************************************************
-! Transform the wind components from local atmospheric 2D coordinates to geocentric 
-! 3D coordinates. 
-! Store the resulting wind components in tab_flds(:,:,1:6)
-!*************************************************************************************
-
-! Transform the longitudes and latitudes on 2D arrays
-    
-    CALL gather_omp(rlon,rlon_mpi)
-    CALL gather_omp(rlat,rlat_mpi)
-!$OMP MASTER
-    CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
-    CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
-!$OMP END MASTER    
-
-    IF (is_sequential) THEN
-       IF (is_north_pole_dyn) tmp_lon(:,1)     = tmp_lon(:,2)
-       IF (is_south_pole_dyn) tmp_lon(:,nbp_lat) = tmp_lon(:,nbp_lat-1)
-    ENDIF
-      
-! NetCDF output of the wind before transformation of coordinate system
-    IF (is_sequential) THEN
-       ndexct(:) = 0
-       itau_w = itau_phy + itime + start_time * day_step_phy
-       CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,nbp_lon*(nbp_lat),ndexct)
-       CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,nbp_lon*(nbp_lat),ndexct)
-       CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,nbp_lon*(nbp_lat),ndexct)
-       CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,nbp_lon*(nbp_lat),ndexct)
-    ENDIF
-
-! Transform the wind from spherical atmospheric 2D coordinates to geocentric
-! cartesian 3D coordinates 
-!$OMP MASTER
-    CALL atm2geo (nbp_lon, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
-         tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) )
-    
-    tab_flds(:,:,ids_tauxxv)  = tab_flds(:,:,ids_tauxxu)
-    tab_flds(:,:,ids_tauyyv)  = tab_flds(:,:,ids_tauyyu)
-    tab_flds(:,:,ids_tauzzv)  = tab_flds(:,:,ids_tauzzu)
-!$OMP END MASTER
-
-!*************************************************************************************
-! NetCDF output of all fields just before sending to coupler.
-!
-!*************************************************************************************
-    IF (is_sequential) THEN
-        DO j=1,maxsend
-          IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, &
-             tab_flds(:,:,j),nbp_lon*(nbp_lat),ndexct)
-        ENDDO
-    ENDIF
-!*************************************************************************************
-! Send the table of all fields
-!
-!*************************************************************************************
-    time_sec=(itime-1)*dtime
-#ifdef CPP_COUPLE
-!$OMP MASTER
-    CALL intocpl(time_sec, lafin, tab_flds(:,:,:))
-!$OMP END MASTER
-#endif
-
-!*************************************************************************************
-! Finish with some dellocate
-!
-!*************************************************************************************  
-    sum_error=0
-    DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error )
-    sum_error = sum_error + error
-    DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error )
-    sum_error = sum_error + error
-    DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error )
-    sum_error = sum_error + error
-    DEALLOCATE(cpl_sens_rain2D, cpl_sens_snow2D, stat=error)
-    sum_error = sum_error + error
-
-    
-    IF (carbon_cycle_cpl) THEN
-       DEALLOCATE(cpl_atm_co22D, stat=error )
-       sum_error = sum_error + error
-    ENDIF
-
-    IF (sum_error /= 0) THEN
-       abort_message='Pb in deallocation of cpl_xxxx2D coupling variables'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    
-  END SUBROUTINE cpl_send_all
-!
-!*************************************************************************************
-!
-  SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
-  USE mod_phys_lmdz_para
-! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille 
-! 'gathered' (la grille physiq comprime).
-!
-! 
-! input:         
-!   champ_in     champ sur la grille 2D
-!   knon         nombre de points dans le domaine a traiter
-!   knindex      index des points de la surface a traiter
-!
-! output:
-!   champ_out    champ sur la grille 'gatherd'
-!
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-! Input
-    INTEGER, INTENT(IN)                       :: knon
-    REAL, DIMENSION(nbp_lon,jj_nb), INTENT(IN)    :: champ_in
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-
-! Output
-    REAL, DIMENSION(klon_mpi), INTENT(OUT)        :: champ_out
-
-! Local
-    INTEGER                                   :: i, ig
-    REAL, DIMENSION(klon_mpi)                 :: temp_mpi
-    REAL, DIMENSION(klon)                     :: temp_omp
-
-!*************************************************************************************
-!
-    
-
-! Transform from 2 dimensions (nbp_lon,jj_nb) to 1 dimension (klon)
-!$OMP MASTER 
-    CALL Grid2Dto1D_mpi(champ_in,temp_mpi)
-!$OMP END MASTER
-
-    CALL scatter_omp(temp_mpi,temp_omp)
-    
-! Compress from klon to knon
-    DO i = 1, knon
-       ig = knindex(i)
-       champ_out(i) = temp_omp(ig)
-    ENDDO
-
-  END SUBROUTINE cpl2gath
-!
-!*************************************************************************************
-!
-  SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex)
-  USE mod_phys_lmdz_para
-! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
-! au coupleur.
-!
-! input:         
-!   champ_in     champ sur la grille gathere        
-!   knon         nombre de points dans le domaine a traiter
-!   knindex      index des points de la surface a traiter
-!
-! output:
-!   champ_out    champ sur la grille 2D
-!
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-    
-! Input arguments
-!*************************************************************************************
-    INTEGER, INTENT(IN)                    :: knon
-    REAL, DIMENSION(klon), INTENT(IN)      :: champ_in
-    INTEGER, DIMENSION(klon), INTENT(IN)   :: knindex
-
-! Output arguments
-!*************************************************************************************
-    REAL, DIMENSION(nbp_lon,jj_nb), INTENT(OUT) :: champ_out
-
-! Local variables
-!*************************************************************************************
-    INTEGER                                :: i, ig
-    REAL, DIMENSION(klon)                  :: temp_omp
-    REAL, DIMENSION(klon_mpi)              :: temp_mpi
-!*************************************************************************************
-
-! Decompress from knon to klon
-    temp_omp = 0.
-    DO i = 1, knon
-       ig = knindex(i)
-       temp_omp(ig) = champ_in(i)
-    ENDDO
-
-! Transform from 1 dimension (klon) to 2 dimensions (nbp_lon,jj_nb)
-    CALL gather_omp(temp_omp,temp_mpi)
-
-!$OMP MASTER    
-    CALL Grid1Dto2D_mpi(temp_mpi,champ_out)
-    
-    IF (is_north_pole_dyn) champ_out(:,1)=temp_mpi(1)
-    IF (is_south_pole_dyn) champ_out(:,jj_nb)=temp_mpi(klon)
-!$OMP END MASTER
-    
-  END SUBROUTINE gath2cpl
-!
-!*************************************************************************************
-!
-END MODULE cpl_mod
-
+link ../phylmd/cpl_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/create_etat0_limit_unstruct.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/create_etat0_limit_unstruct.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/create_etat0_limit_unstruct.F90	(revision 3940)
@@ -1,121 +1,1 @@
-MODULE etat0_limit_unstruct_mod
-
-  LOGICAL, SAVE  :: create_etat0_limit
-!$OMP THREADPRIVATE(create_etat0_limit) 
-
-
-
-
-CONTAINS
-  
-  SUBROUTINE init_etat0_limit_unstruct
-#ifdef CPP_XIOS
-  USE xios, ONLY: xios_set_axis_attr, xios_set_fieldgroup_attr, &
-                  xios_set_filegroup_attr, xios_set_file_attr
-  USE mod_phys_lmdz_para, ONLY: is_omp_master
-  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
-  USE ioipsl, ONLY : ioget_year_len
-  USE ioipsl_getin_p_mod, ONLY: getin_p
-  USE time_phylmdz_mod, ONLY : annee_ref
-  USE create_etat0_unstruct_mod, ONLY: init_create_etat0_unstruct
-  IMPLICIT NONE
-  
-    INTEGER :: iflag_phys,i
-    INTEGER :: ndays
-    REAL,ALLOCATABLE :: value(:)
-    
-      IF (grid_type==unstructured) THEN
-        CALL getin_p("iflag_phys",iflag_phys)
-        
-        CALL getin_p('create_etat0_limit',create_etat0_limit)
-        
-        ndays=ioget_year_len(annee_ref)
-        ALLOCATE(value(ndays))
-        DO i=1,ndays
-          value(i)=i-1
-        ENDDO
-        
-        IF (is_omp_master) CALL xios_set_axis_attr("time_year",n_glo=ndays,value=value) 
-        
-        IF (create_etat0_limit) THEN
-          IF (iflag_phys<100) THEN
-            IF (is_omp_master) CALL xios_set_fieldgroup_attr("etat0_limit_read",read_access=.TRUE.,enabled=.TRUE.)
-            IF (is_omp_master) CALL xios_set_filegroup_attr("etat0_limit_read",enabled=.TRUE.)
-          ENDIF
-          IF (is_omp_master) CALL xios_set_file_attr("limit_write",enabled=.TRUE.)
-          CALL init_create_etat0_unstruct
-        ENDIF
-      
-      ENDIF  
-
-#endif
-  END SUBROUTINE init_etat0_limit_unstruct
-  
-  SUBROUTINE create_etat0_limit_unstruct
-#ifdef CPP_XIOS
-  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
-  USE create_etat0_unstruct_mod, ONLY: create_etat0_unstruct
-  USE create_limit_unstruct_mod, ONLY: create_limit_unstruct
-  USE phyaqua_mod, ONLY: iniaqua
-  USE phys_cal_mod, only: year_len
-  USE mod_phys_lmdz_para, ONLY: is_omp_master
-  USE ioipsl_getin_p_mod, ONLY: getin_p
-  USE dimphy, ONLY: klon
-  USE xios, ONLY: xios_context_finalize, xios_set_current_context, &
-                  xios_finalize
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-      INTEGER :: iflag_phys
-      INTEGER :: ierr
-      CHARACTER (LEN=20) :: modname='create_etat0_limit_unstruct'
-      CHARACTER (LEN=80) :: abort_message
-     
-      IF (grid_type==unstructured) THEN
-  
-        CALL getin_p("iflag_phys",iflag_phys)
-
-        IF (iflag_phys<100) THEN
-          IF ( create_etat0_limit) THEN
-              CALL create_etat0_unstruct
-              CALL create_limit_unstruct
-              IF (is_omp_master)  THEN
-                CALL xios_context_finalize()
-                CALL xios_set_current_context("icosagcm")   ! very bad, need to find an other solution
-                CALL xios_context_finalize()
-                CALL xios_finalize()
-#ifdef CPP_MPI    
-                CALL MPI_Finalize(ierr)
-#endif
-                abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' 
-                CALL abort_physic(modname,abort_message,0)
-                STOP 0
-              ENDIF
-!$OMP BARRIER
-              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine'
-              CALL abort_physic(modname,abort_message,0)
-          ENDIF 
-        ELSE
-          IF (create_etat0_limit) THEN 
-            CALL iniaqua(klon,year_len,iflag_phys)
-              IF (is_omp_master)  THEN
-                CALL xios_context_finalize()
-                CALL xios_set_current_context("icosagcm")   ! very bad, need to find an other solution
-                CALL xios_context_finalize()
-                CALL xios_finalize()
-#ifdef CPP_MPI
-                CALL MPI_Finalize(ierr)
-#endif
-              ENDIF
-!$OMP BARRIER
-              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' 
-              CALL abort_physic(modname,abort_message,0)
-              STOP 0
-          ENDIF
-        ENDIF
-      ENDIF
-        
-#endif
-  END SUBROUTINE create_etat0_limit_unstruct
-  
-END MODULE etat0_limit_unstruct_mod
-
+link ../phylmd/create_etat0_limit_unstruct.F90
Index: LMDZ6/trunk/libf/phylmdiso/create_etat0_unstruct.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/create_etat0_unstruct.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/create_etat0_unstruct.F90	(revision 3940)
@@ -1,261 +1,1 @@
-MODULE create_etat0_unstruct_mod
-
-
-
-
-
-
-CONTAINS
-  
-  SUBROUTINE init_create_etat0_unstruct
-#ifdef CPP_XIOS
-  USE xios
-  USE netcdf
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-  INTEGER :: file_id, iret
-  
-   ! for coupling activate ocean fraction reading from file "ocean_fraction.nc"
-    IF (is_omp_master) THEN
-
-      IF (NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="frac_ocean_read")
-        iret=NF90_CLOSE(file_id)
-      ELSE IF (NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="land_water")
-        iret=NF90_CLOSE(file_id)
-      ELSE IF (NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="land_water")
-        iret=NF90_CLOSE(file_id)
-      ELSE IF (NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="land_water")
-        iret=NF90_CLOSE(file_id)
-      ENDIF
-
-    ENDIF
-
-#endif
-  
-  END SUBROUTINE init_create_etat0_unstruct
-  
- 
-  SUBROUTINE create_etat0_unstruct
-  USE dimphy
-#ifdef CPP_XIOS
-  USE xios
-  USE infotrac_phy
-  USE fonte_neige_mod
-  USE pbl_surface_mod
-  USE phys_state_var_mod
-  USE indice_sol_mod
-  USE mod_phys_lmdz_para
-  USE print_control_mod, ONLY: lunout
-  USE geometry_mod
-  USE ioipsl_getin_p_mod, ONLY: getin_p
-
-  IMPLICIT NONE
-  INCLUDE 'dimsoil.h'
-
-    LOGICAL :: no_ter_antartique   ! If true, no land points are allowed at Antartic
-    REAL,    DIMENSION(klon)                 :: tsol
-    REAL,    DIMENSION(klon)                 :: sn
-    REAL,    DIMENSION(klon)                 :: rugmer
-    REAL,    DIMENSION(klon)                 :: run_off_lic_0
-    REAL,    DIMENSION(klon)                 :: lic
-    REAL,    DIMENSION(klon)                 :: fder
-
-    REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf
-    REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
-    
-    REAL,    DIMENSION(klon_mpi)             :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
-    REAL,    DIMENSION(klon_mpi)             :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi
-    REAL,    DIMENSION(klon_mpi)             :: cell_area_mpi
-    REAL,    DIMENSION(klon_mpi,nbsrf)       :: pctsrf_mpi
-
-    INTEGER :: ji,j,i
- 
-    IF (is_omp_master) THEN
-      CALL xios_recv_field("ts",tsol_mpi)
-      CALL xios_recv_field("qs",qsol_mpi)
-      CALL xios_recv_field("mask",zmasq_mpi)
-      CALL xios_recv_field("landice",lic_mpi)
-      CALL xios_recv_field("zmea",zmea_mpi)
-      CALL xios_recv_field("zstd",zstd_mpi)
-      CALL xios_recv_field("zsig",zsig_mpi)
-      CALL xios_recv_field("zgam",zgam_mpi)
-      CALL xios_recv_field("zthe",zthe_mpi)
-    ENDIF
-    CALL scatter_omp(tsol_mpi,tsol)
-    CALL scatter_omp(qsol_mpi,qsol)
-    CALL scatter_omp(zmasq_mpi,zmasq)
-    CALL scatter_omp(lic_mpi,lic)
-    CALL scatter_omp(zmea_mpi,zmea)
-    CALL scatter_omp(zstd_mpi,zstd)
-    CALL scatter_omp(zsig_mpi,zsig)
-    CALL scatter_omp(zgam_mpi,zgam)
-    CALL scatter_omp(zthe_mpi,zthe)
-
-    radsol(:)   = 0.0
-    rugmer(:) = 0.001
-    sn(:)     = 0
-
-    WHERE(qsol(:)<0) qsol(:)=0 
-        
-    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
-    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
-
-    pctsrf(:,:) = 0
-    pctsrf(:,is_lic)=lic
-    WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0. 
-    WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
-
-    pctsrf(:,is_ter)=zmasq(:)
-
-!--- Adequation with soil/sea mask
-    DO ji=1,klon
-      IF(zmasq(ji)>EPSFRA) THEN 
-        IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
-          pctsrf(ji,is_lic)=zmasq(ji)
-          pctsrf(ji,is_ter)=0.
-        ELSE
-          pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
-          IF(pctsrf(ji,is_ter)<EPSFRA) THEN
-            pctsrf(ji,is_ter)=0.
-            pctsrf(ji,is_lic)=zmasq(ji)
-          END IF 
-        END IF 
-      END IF 
-    END DO 
-
-
-  !--- Option no_ter_antartique removes all land fractions souther than 60S.
-  !--- Land ice is set instead of the land fractions on these latitudes.
-  !--- The ocean and sea-ice fractions are not changed.
-  no_ter_antartique=.FALSE.
-  CALL getin_p('no_ter_antartique',no_ter_antartique)
-  WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
-  IF (no_ter_antartique) THEN
-     ! Remove all land fractions souther than 60S and set land-ice instead
-     WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
-     WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
-     DO ji=1, klon
-        IF (latitude_deg(ji)<-60.0) THEN
-           pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
-           pctsrf(ji,is_ter) = 0
-        END IF
-     END DO
-  END IF
-    
-! sub-surface ocean and sea ice (sea ice set to zero for start)
-!*******************************************************************************
-    pctsrf(:,is_oce)=(1.-zmasq(:))
-    WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
-    
-    zval(:)=max(0.,zmea-2*zstd(:))
-    zpic(:)=zmea+2*zstd(:)
-    
-!! WARNING    DON'T FORGET FOR LATER
-!!ym  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
-!! 
-    
-! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
-!*******************************************************************************
-    DO i=1,nbsrf
-     ftsol(:,i) = tsol
-    END DO
-  
-    DO i=1,nbsrf
-     snsrf(:,i) = sn
-    END DO
-!albedo SB >>>
-!ym error : the sub surface dimension is the third not second
-!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
-!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
-    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
-    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
-
-!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
-!ym probably the uninitialized value was 0 for standard (regular grid) case
-    falb_dif(:,:,:)=0
-
-!albedo SB <<<
-    fevap(:,:) = 0.
-    DO i=1,nbsrf
-     qsolsrf(:,i)=150.
-    END DO
- 
-    DO i=1,nbsrf 
-      DO j=1,nsoilmx
-        tsoil(:,j,i) = tsol
-      END DO
-    END DO
- 
-    rain_fall = 0.; snow_fall = 0.
-    solsw = 165.;   sollw = -53.
-!ym warning missing init for sollwdown => set to 0
-  sollwdown  = 0.
-    
-    
-    t_ancien = 273.15
-    u_ancien=0
-    v_ancien=0
-    q_ancien = 0.
-    agesno = 0.
-
-    z0m(:,is_oce) = rugmer(:)
-
-   z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
-   z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
-
-   z0m(:,is_sic) = 0.001
-   z0h(:,:)=z0m(:,:)
-
-    fder = 0.0
-    clwcon = 0.0
-    rnebcon = 0.0
-    ratqs = 0.0
-    run_off_lic_0 = 0.0 
-    rugoro = 0.0
-
-! Before phyredem calling, surface modules and values to be saved in startphy.nc
-! are initialized
-!*******************************************************************************
-    pbl_tke(:,:,:) = 1.e-8 
-    zmax0(:) = 40.
-    f0(:) = 1.e-5
-    sig1(:,:) = 0.
-    w01(:,:) = 0.
-    wake_deltat(:,:) = 0.
-    wake_deltaq(:,:) = 0.
-    wake_s(:) = 0.
-    wake_cstar(:) = 0.
-    wake_fip(:) = 0.
-    wake_pe = 0.
-    fm_therm = 0.
-    entr_therm = 0.
-    detr_therm = 0.
-    ale_bl = 0.
-    ale_bl_trig =0. 
-    alp_bl =0.
-    CALL fonte_neige_init(run_off_lic_0)
-    CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
-
-    CALL gather_omp(cell_area,cell_area_mpi)
-    CALL gather_omp(pctsrf,pctsrf_mpi)
-    IF (is_omp_master) THEN
-      CALL xios_send_field("area_ce0l",cell_area_mpi)
-      CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
-      CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
-    ENDIF
-    
-    CALL phyredem( "startphy.nc" )
-
-#endif
-  END SUBROUTINE create_etat0_unstruct
-
-
-END MODULE create_etat0_unstruct_mod
+link ../phylmd/create_etat0_unstruct.F90
Index: LMDZ6/trunk/libf/phylmdiso/create_limit_unstruct.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/create_limit_unstruct.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/create_limit_unstruct.F90	(revision 3940)
@@ -1,319 +1,1 @@
-MODULE create_limit_unstruct_mod
-    PRIVATE
-    INTEGER, PARAMETER                             :: lmdep=12
-
-    PUBLIC create_limit_unstruct
-
-CONTAINS
-
-
-  SUBROUTINE create_limit_unstruct
-  USE dimphy
-#ifdef CPP_XIOS
-  USE xios
-  USE ioipsl,             ONLY : ioget_year_len
-  USE time_phylmdz_mod, ONLY : annee_ref
-  USE indice_sol_mod
-  USE phys_state_var_mod
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    INCLUDE "iniprint.h"
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sic
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sst
-    REAL,    DIMENSION(klon,lmdep)                 :: rugos
-    REAL,    DIMENSION(klon,lmdep)                 :: albedo
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sic_mpi
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sst_mpi
-    REAL,    DIMENSION(klon_mpi,lmdep)             :: rugos_mpi
-    REAL,    DIMENSION(klon_mpi,lmdep)             :: albedo_mpi
-    INTEGER                                        :: ndays
-    REAL                                           :: fi_ice(klon)
-    REAL, ALLOCATABLE                              :: sic_year(:,:)
-    REAL, ALLOCATABLE                              :: sst_year(:,:)
-    REAL, ALLOCATABLE                              :: rugos_year(:,:)
-    REAL, ALLOCATABLE                              :: albedo_year(:,:)
-    REAL, ALLOCATABLE                              :: pctsrf_t(:,:,:)
-    REAL, ALLOCATABLE                              :: phy_bil(:,:)
-    REAL, ALLOCATABLE                              :: sst_year_mpi(:,:)
-    REAL, ALLOCATABLE                              :: rugos_year_mpi(:,:)
-    REAL, ALLOCATABLE                              :: albedo_year_mpi(:,:)
-    REAL, ALLOCATABLE                              :: pctsrf_t_mpi(:,:,:)
-    REAL, ALLOCATABLE                              :: phy_bil_mpi(:,:)
-    INTEGER :: l,k
-    INTEGER :: nbad
-    INTEGER :: sic_time_axis_size 
-    INTEGER :: sst_time_axis_size
-    CHARACTER(LEN=99)                  :: mess            ! error message
-    
-     
-    ndays=ioget_year_len(annee_ref)
-    
-    IF (is_omp_master) CALL xios_get_axis_attr("time_sic",n_glo=sic_time_axis_size)
-    CALL bcast_omp(sic_time_axis_size)
-    ALLOCATE(sic_mpi(klon_mpi,sic_time_axis_size))
-    ALLOCATE(sic(klon,sic_time_axis_size))
-    
-    
-    IF (is_omp_master) CALL xios_get_axis_attr("time_sst",n_glo=sst_time_axis_size)
-    CALL bcast_omp(sst_time_axis_size)
-    ALLOCATE(sst_mpi(klon_mpi,sst_time_axis_size))
-    ALLOCATE(sst(klon,sst_time_axis_size))
-    
-    IF (is_omp_master) THEN
-      CALL xios_recv_field("sic_limit",sic_mpi)
-      CALL xios_recv_field("sst_limit",sst_mpi)
-      CALL xios_recv_field("rugos_limit",rugos_mpi)
-      CALL xios_recv_field("albedo_limit",albedo_mpi)
-    ENDIF
-    CALL scatter_omp(sic_mpi,sic)
-    CALL scatter_omp(sst_mpi,sst)
-    CALL scatter_omp(rugos_mpi,rugos)
-    CALL scatter_omp(albedo_mpi,albedo)
-    
-    ALLOCATE(sic_year(klon,ndays))
-    ALLOCATE(sst_year(klon,ndays))
-    ALLOCATE(rugos_year(klon,ndays))
-    ALLOCATE(albedo_year(klon,ndays))
-    ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
-    ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0
-
-
-! sic
-    IF (sic_time_axis_size==lmdep) THEN
-      CALL time_interpolation(ndays,sic,'gregorian',sic_year)
-    ELSE IF (sic_time_axis_size==ndays) THEN
-      sic_year=sic
-    ELSE
-      WRITE(mess,*) 'sic time axis is nor montly, nor daily. sic time interpolation ',&
-                    'is requiered but is not currently managed'
-      CALL abort_physic('create_limit_unstruct',TRIM(mess),1)
-    ENDIF
-    
-    sic_year(:,:)=sic_year(:,:)/100.  ! convert percent to fraction
-    WHERE(sic_year(:,:)>1.0) sic_year(:,:)=1.0    ! Some fractions have some time large negative values
-    WHERE(sic_year(:,:)<0.0) sic_year(:,:)=0.0    ! probably better to apply alse this filter before horizontal interpolation
-    
-! sst
-    IF (sst_time_axis_size==lmdep) THEN
-      CALL time_interpolation(ndays,sst,'gregorian',sst_year)
-    ELSE IF (sst_time_axis_size==ndays) THEN
-      sst_year=sst
-    ELSE
-      WRITE(mess,*)'sic time axis is nor montly, nor daily. sic time interpolation ',&
-                   'is requiered but is not currently managed'
-      CALL abort_physic('create_limit_unstruct',TRIM(mess),1)
-    ENDIF
-    WHERE(sst_year(:,:)<271.38) sst_year(:,:)=271.38
-
-
-! rugos    
-    DO l=1, lmdep
-      WHERE(NINT(zmasq(:))/=1) rugos(:,l)=0.001
-    ENDDO
-    CALL time_interpolation(ndays,rugos,'360d',rugos_year)
-
-! albedo    
-    CALL time_interpolation(ndays,albedo,'360d',albedo_year)
-
-
-    DO k=1,ndays
-      fi_ice=sic_year(:,k)
-      WHERE(fi_ice>=1.0  ) fi_ice=1.0
-      WHERE(fi_ice<EPSFRA) fi_ice=0.0
-      pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
-      pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
-
-!!     IF (icefile==trim(fcpldsic)) THEN           ! SIC=pICE*(1-LIC-TER)
-!!        pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter))
-!!     ELSE IF (icefile==trim(fhistsic)) THEN      ! SIC=pICE
-!!        pctsrf_t(:,is_sic,k)=fi_ice(:)
-!!     ELSE ! icefile==famipsic                    ! SIC=pICE-LIC
-        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
-!     END IF
-      WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
-      WHERE(1.0-zmasq<EPSFRA)
-        pctsrf_t(:,is_sic,k)=0.0
-        pctsrf_t(:,is_oce,k)=0.0
-      ELSEWHERE
-        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
-          pctsrf_t(:,is_sic,k)=1.0-zmasq
-          pctsrf_t(:,is_oce,k)=0.0
-        ELSEWHERE
-          pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
-          WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
-             pctsrf_t(:,is_oce,k)=0.0
-             pctsrf_t(:,is_sic,k)=1.0-zmasq
-          END WHERE
-        END WHERE
-      END WHERE
-      nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
-      IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
-      nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)
-      IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
-    END DO
-    
-    ALLOCATE(sst_year_mpi(klon_mpi,ndays))
-    ALLOCATE(rugos_year_mpi(klon_mpi,ndays))
-    ALLOCATE(albedo_year_mpi(klon_mpi,ndays))
-    ALLOCATE(pctsrf_t_mpi(klon_mpi,nbsrf,ndays))
-    ALLOCATE(phy_bil_mpi(klon_mpi,ndays))
-    
-    CALL gather_omp(pctsrf_t   , pctsrf_t_mpi)
-    CALL gather_omp(sst_year   , sst_year_mpi)
-    CALL gather_omp(phy_bil    , phy_bil_mpi)
-    CALL gather_omp(albedo_year, albedo_year_mpi)
-    CALL gather_omp(rugos_year , rugos_year_mpi)
-
-    IF (is_omp_master) THEN
-      CALL xios_send_field("foce_limout",pctsrf_t_mpi(:,is_oce,:))
-      CALL xios_send_field("fsic_limout",pctsrf_t_mpi(:,is_sic,:))
-      CALL xios_send_field("fter_limout",pctsrf_t_mpi(:,is_ter,:))
-      CALL xios_send_field("flic_limout",pctsrf_t_mpi(:,is_lic,:))
-      CALL xios_send_field("sst_limout", sst_year_mpi)
-      CALL xios_send_field("bils_limout",phy_bil_mpi)
-      CALL xios_send_field("alb_limout", albedo_year_mpi) 
-      CALL xios_send_field("rug_limout", rugos_year_mpi) 
-    ENDIF
-#endif
-  END SUBROUTINE create_limit_unstruct
-  
-  
-  SUBROUTINE time_interpolation(ndays,field_in,calendar,field_out)
-  USE pchsp_95_m, only: pchsp_95
-  USE pchfe_95_m, only: pchfe_95
-  USE arth_m, only: arth
-  USE dimphy, ONLY : klon
-  USE ioipsl,             ONLY : ioget_year_len
-  USE time_phylmdz_mod, ONLY : annee_ref
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-   INCLUDE "iniprint.h"
-
-   INTEGER,         INTENT(IN)  :: ndays
-   REAL,            INTENT(IN)  :: field_in(klon,lmdep)
-   CHARACTER(LEN=*),INTENT(IN)  :: calendar
-   REAL,            INTENT(OUT) :: field_out(klon,ndays)
- 
-   INTEGER :: ndays_in
-   REAL    :: timeyear(lmdep)   
-   REAL    :: yder(lmdep)   
-   INTEGER :: ij,ierr, n_extrap
-   LOGICAL :: skip
-
-   CHARACTER (len = 50)         :: modname = 'create_limit_unstruct.time_interpolation'
-   CHARACTER (len = 80)         :: abort_message
-
-  
-   IF (is_omp_master) ndays_in=year_len(annee_ref, calendar)
-   CALL bcast_omp(ndays_in)
-   IF (is_omp_master) timeyear=mid_months(annee_ref, calendar, lmdep)
-   CALL bcast_omp(timeyear)
-    
-   n_extrap = 0
-   skip=.FALSE.
-   DO ij=1,klon
-     yder = pchsp_95(timeyear, field_in(ij, :), ibeg=2, iend=2, vc_beg=0., vc_end=0.)
-     CALL pchfe_95(timeyear, field_in(ij, :), yder, skip, arth(0., real(ndays_in) / ndays, ndays), field_out(ij, :), ierr)
-     if (ierr < 0) then
-        abort_message='error in pchfe_95'
-        CALL abort_physic(modname,abort_message,1)
-     endif
-     n_extrap = n_extrap + ierr
-   END DO
-   
-   IF (n_extrap /= 0) then
-     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
-   ENDIF 
-  
-  
-  END SUBROUTINE time_interpolation
-  !-------------------------------------------------------------------------------
-  !
-  FUNCTION year_len(y,cal_in)
-  !
-  !-------------------------------------------------------------------------------
-    USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_year_len
-    IMPLICIT NONE
-  !-------------------------------------------------------------------------------
-  ! Arguments:
-    INTEGER                       :: year_len
-    INTEGER,           INTENT(IN) :: y
-    CHARACTER(LEN=*),  INTENT(IN) :: cal_in
-  !-------------------------------------------------------------------------------
-  ! Local variables:
-    CHARACTER(LEN=20)             :: cal_out              ! calendar (for outputs)
-  !-------------------------------------------------------------------------------
-  !--- Getting the input calendar to reset at the end of the function
-    CALL ioget_calendar(cal_out)
-  
-  !--- Unlocking calendar and setting it to wanted one
-    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
-  
-  !--- Getting the number of days in this year
-    year_len=ioget_year_len(y)
-  
-  !--- Back to original calendar
-    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
-  
-  END FUNCTION year_len
-  !
-  !-------------------------------------------------------------------------------
-  
-  
-  !-------------------------------------------------------------------------------
-  !
-  FUNCTION mid_months(y,cal_in,nm)
-  !
-  !-------------------------------------------------------------------------------
-    USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_mon_len
-    IMPLICIT NONE
-  !-------------------------------------------------------------------------------
-  ! Arguments:
-    INTEGER,                INTENT(IN) :: y               ! year
-    CHARACTER(LEN=*),       INTENT(IN) :: cal_in          ! calendar
-    INTEGER,                INTENT(IN) :: nm              ! months/year number
-    REAL,    DIMENSION(nm)             :: mid_months      ! mid-month times
-  !-------------------------------------------------------------------------------
-  ! Local variables:
-    CHARACTER(LEN=99)                  :: mess            ! error message
-    CHARACTER(LEN=20)                  :: cal_out         ! calendar (for outputs)
-    INTEGER, DIMENSION(nm)             :: mnth            ! months lengths (days)
-    INTEGER                            :: m               ! months counter
-    INTEGER                            :: nd              ! number of days
-    INTEGER                            :: k
-  !-------------------------------------------------------------------------------
-    nd=year_len(y,cal_in)
-  
-    IF(nm==12) THEN
-  
-    !--- Getting the input calendar to reset at the end of the function
-      CALL ioget_calendar(cal_out)
-  
-    !--- Unlocking calendar and setting it to wanted one
-      CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
-  
-    !--- Getting the length of each month
-      DO m=1,nm; mnth(m)=ioget_mon_len(y,m); END DO
-  
-    !--- Back to original calendar
-      CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
-  
-    ELSE IF(MODULO(nd,nm)/=0) THEN
-      WRITE(mess,'(a,i3,a,i3,a)')'Unconsistent calendar: ',nd,' days/year, but ',&
-        nm,' months/year. Months number should divide days number.'
-      CALL abort_physic('mid_months',TRIM(mess),1)
-  
-    ELSE
-      mnth=(/(m,m=1,nm,nd/nm)/)
-    END IF
-  
-  !--- Mid-months times
-    mid_months(1)=0.5*REAL(mnth(1))
-    DO k=2,nm
-      mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
-    END DO
-  
-  END FUNCTION mid_months
-  
-
-END MODULE create_limit_unstruct_mod
+link ../phylmd/create_limit_unstruct.F90
Index: LMDZ6/trunk/libf/phylmdiso/ctstar.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ctstar.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ctstar.F90	(revision 3940)
@@ -1,128 +1,1 @@
-SUBROUTINE CTSTAR(KPROMA,KSTART,KPROF,PTB,PRESBH,PRESBF,POROG,PTSTAR,PT0)
-
-!**** *CTSTAR* - COMPUTES STANDARD SURFACE TEMPERATURE
-!                              AND SURFACE TEMPERATURE.
-
-!     PURPOSE.
-!     --------
-
-!           COMPUTES THE STANDARD SURFACE TEMPERATURE AND THE SURFACE
-!           TEMPERATURE TO BE USED FOR EXTRAPOLATIONS OF TEMPERATURE
-!           AND GEOPOTENTIEL.
-
-!**   INTERFACE.
-!     ----------
-!        *CALL* *CTSTAR(..)*
-
-!        EXPLICIT ARGUMENTS
-!        --------------------
-
-!        KPROMA         - HORIZONTAL DIMENSIONS.             (INPUT)
-!        KSTART         - START OF WORK                      (INPUT)
-!        KPROF          - DEPTH OF WORK                      (INPUT)
-
-!        PTB(KPROMA)    - TEMPERATURE AT NFLEVG-1             (INPUT)
-!        PRESBH(KPROMA) - LOWEST MODEL HALF LEVEL PRESSURES  (INPUT)
-
-!        PRESBF(KPROMA) - PRESSURE AT NFLEVG-1                (INPUT)
-!        POROG(KPROMA)  - MODEL ORGRAPHY                     (INPUT)
-
-
-!        PTSTAR(KPROMA) - SURFACE TEMPERATURE                (OUTPUT)
-
-!        PT0(KPROMA)    - STANDARD SURFACE TEMPERATURE       (OUTPUT)
-
-!        IMPLICIT ARGUMENTS :    CONSTANTS FROM YOMSTA,YOMCST.
-!        --------------------
-
-!     METHOD.
-!     -------
-!        SEE DOCUMENTATION
-
-!     EXTERNALS.   NONE.
-!     ----------
-
-!     REFERENCE.
-!     ----------
-!        ECMWF Research Department documentation of the IFS
-
-!     AUTHOR.
-!     -------
-!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*
-
-!     MODIFICATIONS.
-!     --------------
-!        ORIGINAL : 89-05-02
-
-!      Modification : 93-06-01 M.Hamrud (Comment only, now T from NFLEVG-1)
-!        M.Hamrud      01-Oct-2003 CY28 Cleaning
-
-!     ------------------------------------------------------------------
-
-!USE PARKIND1 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/parkind1.F90.php#parkind1>  ,ONLY : JPIM     ,JPRB
-!USE YOMHOOK 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/yomhook.F90.php#yomhook>   ,ONLY : LHOOK,   DR_HOOK
-
-!USE YOMCST, ONLY : RG, RD 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomcst.F90.php#yomcst>   , ONLY :  RG
-
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>       ,RD
-!USE YOMSTA 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomsta.F90.php#yomsta>   , ONLY : RDTDZ1
-
-IMPLICIT NONE
-
-include "YOMCST.h"
-!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
-!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
-!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
-INTEGER,INTENT(IN)    :: KPROMA
-INTEGER,INTENT(IN)    :: KSTART
-INTEGER,INTENT(IN)    :: KPROF
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PTB(KPROMA)
-REAL   ,INTENT(IN)    :: PTB(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBH(KPROMA)
-REAL   ,INTENT(IN)    :: PRESBH(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBF(KPROMA)
-REAL   ,INTENT(IN)    :: PRESBF(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA)
-REAL   ,INTENT(IN)    :: POROG(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTSTAR(KPROMA)
-REAL   ,INTENT(OUT)   :: PTSTAR(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PT0(KPROMA)
-REAL   ,INTENT(OUT)   :: PT0(KPROMA)
-!IM INTEGER(KIND=JPIM) :: JL
-INTEGER :: JL
-
-!IM REAL(KIND=JPRB) :: ZALPHA, ZDTDZSG
-REAL :: ZALPHA, ZDTDZSG
-!IM REAL(KIND=JPRB) :: ZHOOK_HANDLE
-REAL :: ZHOOK_HANDLE
-!IM beg
-REAL, PARAMETER                  :: RDTDZ1=-0.0065 !or USE YOMSTA
-!IM end
-
-!     ------------------------------------------------------------------
-
-!*       1.    COMPUTES SURFACE TEMPERATURE
-!*             THEN STANDARD SURFACE TEMPERATURE.
-
-!IF (LHOOK) CALL DR_HOOK('CTSTAR',0,ZHOOK_HANDLE)
-ZDTDZSG=-RDTDZ1/RG 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
-ZALPHA=ZDTDZSG*RD
-DO JL=KSTART,KPROF
-
-   !IM PTSTAR(JL)=PTB(JL)*(1.0_JPRB+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0_JPRB))
-   PTSTAR(JL)=PTB(JL)*(1.0+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0))
-   PT0(JL)=PTSTAR(JL)+ZDTDZSG*POROG(JL)
-!  print*,'cstar JL ptb zalpha PRESBH PRESBF ptstar' &
-!  ,JL,PTB(JL),ZALPHA,PRESBH(JL),PRESBF(JL),PTSTAR(JL)
-ENDDO
-
-
-!     ------------------------------------------------------------------
-
-!IF (LHOOK) CALL DR_HOOK('CTSTAR',1,ZHOOK_HANDLE)
-END SUBROUTINE CTSTAR
+link ../phylmd/ctstar.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv30param.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv30param.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv30param.h	(revision 3940)
@@ -1,30 +1,1 @@
-!
-! $Header$
-!
-!------------------------------------------------------------
-! Parameters for convectL, iflag_con=30:
-! (includes - microphysical parameters, 
-!			- parameters that control the rate of approach 
-!               to quasi-equilibrium)
-!			- noff & minorig (previously in input of convect1)
-!------------------------------------------------------------
-
-      integer noff, minorig, nl, nlp, nlm
-      real sigd, spfac
-!IM cf. FH : pour compatibilite avec conema3 TEMPORAIRE   real pbcrit, ptcrit, epmax
-      real pbcrit, ptcrit
-      real omtrain
-      real dtovsh, dpbase, dttrig
-      real dtcrit, tau, beta, alpha
-      real delta
-      real betad
-
-      COMMON /cv30param/  noff, minorig, nl, nlp, nlm &
-                      ,  sigd, spfac &
-!IM cf. FH : pour compatibilite avec conema3 TEMPORAIRE  :                ,pbcrit, ptcrit, epmax
-                      ,pbcrit, ptcrit &
-                      ,omtrain &
-                      ,dtovsh, dpbase, dttrig &
-                      ,dtcrit, tau, beta, alpha, delta, betad
-
-!$OMP THREADPRIVATE(/cv30param/)
+link ../phylmd/cv30param.h
Index: LMDZ6/trunk/libf/phylmdiso/cv3_buoy.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3_buoy.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3_buoy.F90	(revision 3940)
@@ -1,155 +1,1 @@
-SUBROUTINE cv3_buoy(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, ale, cin, &
-    tv, tvp, buoy)
-  ! **************************************************************
-  ! *
-  ! CV3_BUOY                                                    *
-  ! Buoyancy corrections to account for ALE             *
-  ! *
-  ! written by   : MOREAU Cecile, 07/08/2003, 15.55.48          *
-  ! modified by :                                               *
-  ! **************************************************************
-
-  IMPLICIT NONE
-
-  include "cvthermo.h"
-  include "cv3param.h"
-  include "YOMCST2.h"
-
-  ! input:
-  INTEGER ncum, nd, nloc
-  INTEGER icb(nloc), inb(nloc)
-  REAL pbase(nloc), plcl(nloc)
-  REAL p(nloc, nd), ph(nloc, nd+1)
-  REAL ale(nloc), cin(nloc)
-  REAL tv(nloc, nd), tvp(nloc, nd)
-
-  ! output:
-  REAL buoy(nloc, nd)
-
-  ! local variables:
-  INTEGER il, k
-  INTEGER kmx(nloc)
-  REAL bll(nloc), bmx(nloc)
-  REAL gamma(nloc)
-  LOGICAL ok(nloc)
-
-  REAL dgamma
-  REAL buoymin
-  PARAMETER (dgamma=2.E-03) !dgamma gamma
-  PARAMETER (buoymin=2.)
-
-  LOGICAL fixed_bll
-  SAVE fixed_bll
-  DATA fixed_bll/.TRUE./
-  !$OMP THREADPRIVATE(fixed_bll)
-
-
-  ! print *,' Ale+cin ',ale(1)+cin(1)
-  ! --------------------------------------------------------------
-  ! Recompute buoyancies
-  ! --------------------------------------------------------------
-  DO k = 1, nl
-    DO il = 1, ncum
-      buoy(il, k) = tvp(il, k) - tv(il, k)
-    END DO
-  END DO
-
-  ! -------------------------------------------------------------
-  ! -- Compute low level buoyancy ( function of Ale+Cin )
-  ! -------------------------------------------------------------
-  IF (fixed_bll) THEN
-
-    DO il = 1, ncum
-      bll(il) = 0.5
-    END DO
-  ELSE
-
-    DO il = 1, ncum
-      IF (ale(il)+cin(il)>0.) THEN
-        gamma(il) = 4.*buoy(il, icb(il))**2 + 8.*dgamma*(ale(il)+cin(il))*tv( &
-          il, icb(il))/grav
-        gamma(il) = max(gamma(il), 1.E-10)
-      END IF
-    END DO
-
-    DO il = 1, ncum
-      IF (ale(il)+cin(il)>0.) THEN
-        bll(il) = 4.*dgamma*(ale(il)+cin(il))*tv(il, icb(il))/ &
-          (grav*(abs(buoy(il,icb(il))+0.5*sqrt(gamma(il)))))
-      END IF
-    END DO
-
-    DO il = 1, ncum
-      IF (ale(il)+cin(il)>0.) THEN
-        bll(il) = min(bll(il), buoymin)
-      END IF
-    END DO
-
-  END IF !(fixed_bll)
-
-
-  ! -------------------------------------------------------------
-  ! --Get highest buoyancy among levels below LCL-200hPa
-  ! -------------------------------------------------------------
-
-  DO il = 1, ncum
-    bmx(il) = -1000.
-    kmx(il) = icb(il)
-    ok(il) = .TRUE.
-  END DO
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (ale(il)+cin(il)>0. .AND. ok(il)) THEN
-        IF (k>icb(il) .AND. k<=inb(il)) THEN
-          ! c         print *,'k,p(il,k),plcl(il)-200. ',
-          ! k,p(il,k),plcl(il)-200.
-          IF (p(il,k)>plcl(il)-200.) THEN
-            IF (buoy(il,k)>bmx(il)) THEN
-              bmx(il) = buoy(il, k)
-              kmx(il) = k
-              IF (bmx(il)>=bll(il)) ok(il) = .FALSE.
-            END IF
-          END IF
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! print *,' ==cv3_buoy== bll(1),bmx(1),icb(1),kmx(1) '
-  ! $       ,bll(1),bmx(1),icb(1),kmx(1)
-
-  ! -------------------------------------------------------------
-  ! --Calculate modified buoyancies
-  ! -------------------------------------------------------------
-
-  DO il = 1, ncum
-    IF (ale(il)+cin(il)>0.) THEN
-      bll(il) = min(bll(il), bmx(il))
-    END IF
-  END DO
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (ale(il)+cin(il)>0.) THEN
-        IF (k>=icb(il) .AND. k<=kmx(il)-1) THEN
-          buoy(il, k) = bll(il)
-        END IF
-      END IF
-    END DO
-  END DO
-
-!CR:Correction of buoy for what comes next
-!keep flag or to modify in all cases?
-  IF (iflag_mix_adiab.eq.1) THEN
-  DO k = 1, nl 
-    DO il = 1, ncum
-       IF ((k>=kmx(il)) .AND. (k<=inb(il)) .AND. (buoy(il,k).lt.0.)) THEN
-          buoy(il,k)=buoy(il,k-1)
-       END IF
-    ENDDO
-  ENDDO
-  ENDIF
-
-  RETURN
-END SUBROUTINE cv3_buoy
+link ../phylmd/cv3_buoy.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3_cine.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3_cine.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3_cine.F90	(revision 3940)
@@ -1,461 +1,1 @@
-
-! $Id: cv3_cine.F90 2416 2015-12-24 11:58:33Z jyg $
-
-SUBROUTINE cv3_cine(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, tvp, &
-    cina, cinb, plfc)
-
-  ! **************************************************************
-  ! *
-  ! CV3_CINE                                                    *
-  ! *
-  ! *
-  ! written by   :   Frederique Cheruy                          *
-  ! vectorization:   Jean-Yves Grandpeix, 19/06/2003, 11.54.43  *
-  ! modified by :                                               *
-  ! **************************************************************
-
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-  include "cvthermo.h"
-  include "cv3param.h"
-  ! input:
-  INTEGER ncum, nd, nloc
-  INTEGER icb(nloc), inb(nloc)
-  REAL pbase(nloc), plcl(nloc)
-  REAL p(nloc, nd), ph(nloc, nd+1)
-  REAL tv(nloc, nd), tvp(nloc, nd)
-
-  ! output
-  REAL cina(nloc), cinb(nloc), plfc(nloc)
-
-  ! local variables
-  INTEGER il, i, j, k
-  INTEGER itop(nloc), ineg(nloc), ilow(nloc)
-  INTEGER ifst(nloc), isublcl(nloc)
-  LOGICAL lswitch(nloc), lswitch1(nloc), lswitch2(nloc), lswitch3(nloc)
-  LOGICAL exist_lfc(nloc)
-  REAL dpmax
-  REAL deltap, dcin
-  REAL buoylcl(nloc), tvplcl(nloc), tvlcl(nloc)
-  REAL p0(nloc)
-  REAL buoyz(nloc), buoy(nloc, nd)
-
-  ! -------------------------------------------------------------
-  ! Initialization
-  ! -------------------------------------------------------------
-  DO il = 1, ncum
-    cina(il) = 0.
-    cinb(il) = 0.
-  END DO
-
-  ! --------------------------------------------------------------
-  ! Recompute buoyancies
-  ! --------------------------------------------------------------
-  DO k = 1, nd
-    DO il = 1, ncum
-      ! print*,'tvp tv=',tvp(il,k),tv(il,k)
-      buoy(il, k) = tvp(il, k) - tv(il, k)
-    END DO
-  END DO
-  ! ---------------------------------------------------------------
-
-  ! calcul de la flottabilite a LCL (Buoylcl)
-  ! ifst = first P-level above lcl
-  ! isublcl = highest P-level below lcl.
-  ! ---------------------------------------------------------------
-
-  DO il = 1, ncum
-    tvplcl(il) = tvp(il, 1)*(plcl(il)/p(il,1))**(2./7.) !For dry air, R/Cp=2/7
-  END DO
-
-  DO il = 1, ncum
-    IF (plcl(il)>p(il,icb(il))) THEN
-      ifst(il) = icb(il)
-      isublcl(il) = icb(il) - 1
-    ELSE
-      ifst(il) = icb(il) + 1
-      isublcl(il) = icb(il)
-    END IF
-  END DO
-
-  DO il = 1, ncum
-    tvlcl(il) = tv(il, ifst(il)-1) + (tv(il,ifst(il))-tv(il,ifst(il)-1))*( &
-      plcl(il)-p(il,ifst(il)-1))/(p(il,ifst(il))-p(il,ifst(il)-1))
-  END DO
-
-  DO il = 1, ncum
-    buoylcl(il) = tvplcl(il) - tvlcl(il)
-  END DO
-
-  ! ---------------------------------------------------------------
-  ! premiere couche contenant un  niveau de flotabilite positive
-  ! et premiere couche contenant un  niveau de flotabilite negative
-  ! au dessus du niveau de condensation
-  ! ---------------------------------------------------------------
-  DO il = 1, ncum
-    itop(il) = nl - 1
-    ineg(il) = nl - 1
-    exist_lfc(il) = .FALSE.
-  END DO
-  DO k = nl - 1, 1, -1
-    DO il = 1, ncum
-      IF (k>=ifst(il)) THEN
-        IF (buoy(il,k)>0.) THEN
-          itop(il) = k
-          exist_lfc(il) = .TRUE.
-        ELSE
-          ineg(il) = k
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! ---------------------------------------------------------------
-  ! When there is no positive buoyancy level, set Plfc, Cina and Cinb
-  ! to arbitrary extreme values.
-  ! ---------------------------------------------------------------
-  DO il = 1, ncum
-    IF (.NOT. exist_lfc(il)) THEN
-      plfc(il) = 1.111
-      cinb(il) = -1111.
-      cina(il) = -1112.
-    END IF
-  END DO
-
-
-  ! ---------------------------------------------------------------
-  ! -- Two cases : BUOYlcl >= 0 and BUOYlcl < 0.
-  ! ---------------------------------------------------------------
-
-  ! --------------------
-  ! -- 1.0 BUOYlcl >=0.
-  ! --------------------
-
-  dpmax = 50.
-  DO il = 1, ncum
-    lswitch1(il) = buoylcl(il) >= 0. .AND. exist_lfc(il)
-    lswitch(il) = lswitch1(il)
-  END DO
-
-  ! 1.1 No inhibition case
-  ! ----------------------
-  ! If buoyancy is positive at LCL and stays positive over a large enough
-  ! pressure interval (=DPMAX), inhibition is set to zero,
-
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      IF (p(il,ineg(il))<p(il,icb(il))-dpmax) THEN
-        plfc(il) = plcl(il)
-        cina(il) = 0.
-        cinb(il) = 0.
-      END IF
-    END IF
-  END DO
-
-  ! 1.2 Upper inhibition only case
-  ! ------------------------------
-  DO il = 1, ncum
-    lswitch2(il) = p(il, ineg(il)) >= p(il, icb(il)) - dpmax
-    lswitch(il) = lswitch1(il) .AND. lswitch2(il)
-  END DO
-
-  ! 1.2.1 Recompute itop (=1st layer with positive buoyancy above ineg)
-  ! -------------------------------------------------------------------
-
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      itop(il) = nl - 1
-    END IF
-  END DO
-
-  DO k = nl, 1, -1
-    DO il = 1, ncum
-      IF (lswitch(il)) THEN
-        IF (k>=ineg(il) .AND. buoy(il,k)>0) THEN
-          itop(il) = k
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! If there is no layer with positive buoyancy above ineg, set Plfc, 
-  ! Cina and Cinb to arbitrary extreme values.
-  DO il = 1, ncum
-    IF (lswitch(il) .AND. itop(il) == nl - 1) THEN
-      plfc(il) = 1.121
-      cinb(il) = -1121.
-      cina(il) = -1122.
-    END IF
-  END DO
-
-  DO il = 1, ncum
-    lswitch3(il) = itop(il) < nl -1
-    lswitch(il) = lswitch1(il) .AND. lswitch2(il) .AND. lswitch3(il)
-  END DO
-
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      cinb(il) = 0.
-
-      ! 1.2.2  Calcul de la pression du niveau de flot. nulle juste au-dessus
-      ! de LCL
-      ! ---------------------------------------------------------------------------
-      IF (ineg(il)>isublcl(il)+1) THEN
-        ! In order to get P0, one may interpolate linearly buoyancies
-        ! between P(ineg) and P(ineg-1).
-        p0(il) = (buoy(il,ineg(il))*p(il,ineg(il)-1)-buoy(il,ineg(il)-1)*p(il,ineg(il)))/ &
-          (buoy(il,ineg(il))-buoy(il,ineg(il)-1))
-      ELSE
-        ! In order to get P0, one has to interpolate between P(ineg) and
-        ! Plcl.
-        p0(il) = (buoy(il,ineg(il))*plcl(il)-buoylcl(il)*p(il,ineg(il)))/ &
-          (buoy(il,ineg(il))-buoylcl(il))
-      END IF
-    END IF
-  END DO
-
-  ! 1.2.3 Computation of PLFC
-  ! -------------------------
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      plfc(il) = (buoy(il,itop(il))*p(il,itop(il)-1)-buoy(il,itop( &
-        il)-1)*p(il,itop(il)))/(buoy(il,itop(il))-buoy(il,itop(il)-1))
-    END IF
-  END DO
-
-  ! 1.2.4 Computation of CINA
-  ! -------------------------
-
-  ! Upper part of CINA : integral from P(itop-1) to Plfc
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      deltap = p(il, itop(il)-1) - plfc(il)
-      dcin = rd*buoy(il, itop(il)-1)*deltap/(p(il,itop(il)-1)+plfc(il))
-      cina(il) = min(0., dcin)
-    END IF
-  END DO
-
-  ! Middle part of CINA : integral from P(ineg) to P(itop-1)
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (lswitch(il)) THEN
-        IF (k>=ineg(il) .AND. k<=itop(il)-2) THEN
-          deltap = p(il, k) - p(il, k+1)
-          dcin = 0.5*rd*(buoy(il,k)+buoy(il,k+1))*deltap/ph(il, k+1)
-          cina(il) = cina(il) + min(0., dcin)
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! Lower part of CINA : integral from P0 to P(ineg)
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      deltap = p0(il) - p(il, ineg(il))
-      dcin = rd*buoy(il, ineg(il))*deltap/(p(il,ineg(il))+p0(il))
-      cina(il) = cina(il) + min(0., dcin)
-    END IF
-  END DO
-
-
-  ! ------------------
-  ! -- 2.0 BUOYlcl <0.
-  ! ------------------
-
-  DO il = 1, ncum
-    lswitch1(il) = buoylcl(il) < 0. .AND. exist_lfc(il)
-    lswitch(il) = lswitch1(il)
-  END DO
-
-  ! 2.0.1 Premiere  couche ou la flotabilite est negative au dessus du sol
-  ! ----------------------------------------------------
-  ! au cas ou elle existe  sinon ilow=1 (nk apres)
-  ! on suppose que la parcelle part de la premiere couche
-
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      ilow(il) = 1
-    END IF
-  END DO
-
-  DO k = nl, 1, -1
-    DO il = 1, ncum
-      IF (lswitch(il) .AND. k<=icb(il)-1) THEN
-        IF (buoy(il,k)<0.) THEN
-          ilow(il) = k
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! 2.0.2  Calcul de la pression du niveau de flot. nulle sous le nuage
-  ! ----------------------------------------------------
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      IF (ilow(il)>1) THEN
-        p0(il) = (buoy(il,ilow(il))*p(il,ilow(il)-1)-buoy(il,ilow( &
-          il)-1)*p(il,ilow(il)))/(buoy(il,ilow(il))-buoy(il,ilow(il)-1))
-        buoyz(il) = 0.
-      ELSE
-        p0(il) = p(il, 1)
-        buoyz(il) = buoy(il, 1)
-      END IF
-    END IF
-  END DO
-
-  ! 2.1. Computation of CINB
-  ! -----------------------
-
-  DO il = 1, ncum
-    lswitch2(il) = (isublcl(il)==1 .AND. ilow(il)==1) .OR. &
-      (isublcl(il)==ilow(il)-1)
-    lswitch(il) = lswitch1(il) .AND. lswitch2(il)
-  END DO
-  ! c      IF (    (isublcl .EQ. 1 .AND. ilow .EQ. 1)
-  ! c     $    .OR.(isublcl .EQ. ilow-1)) THEN
-
-  ! 2.1.1 First case : Plcl just above P0
-  ! -------------------------------------
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      deltap = p0(il) - plcl(il)
-      dcin = rd*(buoyz(il)+buoylcl(il))*deltap/(p0(il)+plcl(il))
-      cinb(il) = min(0., dcin)
-    END IF
-  END DO
-
-  DO il = 1, ncum
-    lswitch(il) = lswitch1(il) .AND. .NOT. lswitch2(il)
-  END DO
-  ! c      ELSE
-
-  ! 2.1.2 Second case : there is at least one P-level between P0 and Plcl
-  ! ---------------------------------------------------------------------
-
-  ! Lower part of CINB : integral from P0 to P(ilow)
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      deltap = p0(il) - p(il, ilow(il))
-      dcin = rd*(buoyz(il)+buoy(il,ilow(il)))*deltap/(p0(il)+p(il,ilow(il)))
-      cinb(il) = min(0., dcin)
-    END IF
-  END DO
-
-
-  ! Middle part of CINB : integral from P(ilow) to P(isublcl)
-  ! c      DO k = ilow,isublcl-1
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (lswitch(il) .AND. k>=ilow(il) .AND. k<=isublcl(il)-1) THEN
-        deltap = p(il, k) - p(il, k+1)
-        dcin = 0.5*rd*(buoy(il,k)+buoy(il,k+1))*deltap/ph(il, k+1)
-        cinb(il) = cinb(il) + min(0., dcin)
-      END IF
-    END DO
-  END DO
-
-  ! Upper part of CINB : integral from P(isublcl) to Plcl
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      deltap = p(il, isublcl(il)) - plcl(il)
-      dcin = rd*(buoy(il,isublcl(il))+buoylcl(il))*deltap/ &
-        (p(il,isublcl(il))+plcl(il))
-      cinb(il) = cinb(il) + min(0., dcin)
-    END IF
-  END DO
-
-
-  ! c      ENDIF
-
-  ! 2.2 Computation of CINA
-  ! ---------------------
-
-  DO il = 1, ncum
-    lswitch2(il) = plcl(il) > p(il, itop(il)-1)
-    lswitch(il) = lswitch1(il) .AND. lswitch2(il)
-  END DO
-
-  ! 2.2.1 FIrst case : Plcl > P(itop-1)
-  ! ---------------------------------
-  ! In order to get Plfc, one may interpolate linearly buoyancies
-  ! between P(itop) and P(itop-1).
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      plfc(il) = (buoy(il,itop(il))*p(il,itop(il)-1)-buoy(il,itop( &
-        il)-1)*p(il,itop(il)))/(buoy(il,itop(il))-buoy(il,itop(il)-1))
-    END IF
-  END DO
-
-  ! Upper part of CINA : integral from P(itop-1) to Plfc
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      deltap = p(il, itop(il)-1) - plfc(il)
-      dcin = rd*buoy(il, itop(il)-1)*deltap/(p(il,itop(il)-1)+plfc(il))
-      cina(il) = min(0., dcin)
-    END IF
-  END DO
-
-  ! Middle part of CINA : integral from P(icb+1) to P(itop-1)
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (lswitch(il) .AND. k>=icb(il)+1 .AND. k<=itop(il)-2) THEN
-        deltap = p(il, k) - p(il, k+1)
-        dcin = 0.5*rd*(buoy(il,k)+buoy(il,k+1))*deltap/ph(il, k+1)
-        cina(il) = cina(il) + min(0., dcin)
-      END IF
-    END DO
-  END DO
-
-  ! Lower part of CINA : integral from Plcl to P(icb+1)
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      IF (plcl(il)>p(il,icb(il))) THEN
-        IF (icb(il)<itop(il)-1) THEN
-          deltap = p(il, icb(il)) - p(il, icb(il)+1)
-          dcin = 0.5*rd*(buoy(il,icb(il))+buoy(il,icb(il)+1))*deltap/ &
-            ph(il, icb(il)+1)
-          cina(il) = cina(il) + min(0., dcin)
-        END IF
-
-        deltap = plcl(il) - p(il, icb(il))
-        dcin = rd*(buoylcl(il)+buoy(il,icb(il)))*deltap/ &
-          (plcl(il)+p(il,icb(il)))
-        cina(il) = cina(il) + min(0., dcin)
-      ELSE
-        deltap = plcl(il) - p(il, icb(il)+1)
-        dcin = rd*(buoylcl(il)+buoy(il,icb(il)+1))*deltap/ &
-          (plcl(il)+p(il,icb(il)+1))
-        cina(il) = cina(il) + min(0., dcin)
-      END IF
-    END IF
-  END DO
-
-  DO il = 1, ncum
-    lswitch(il) = lswitch1(il) .AND. .NOT. lswitch2(il)
-  END DO
-  ! c      ELSE
-
-  ! 2.2.2 Second case : Plcl lies between P(itop-1) and P(itop);
-  ! ----------------------------------------------------------
-  ! In order to get Plfc, one has to interpolate between P(itop) and Plcl.
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      plfc(il) = (buoy(il,itop(il))*plcl(il)-buoylcl(il)*p(il,itop(il)))/ &
-        (buoy(il,itop(il))-buoylcl(il))
-    END IF
-  END DO
-
-  DO il = 1, ncum
-    IF (lswitch(il)) THEN
-      deltap = plcl(il) - plfc(il)
-      dcin = rd*buoylcl(il)*deltap/(plcl(il)+plfc(il))
-      cina(il) = min(0., dcin)
-    END IF
-  END DO
-  ! c      ENDIF
-
-
-
-  RETURN
-END SUBROUTINE cv3_cine
+link ../phylmd/cv3_cine.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3_crit.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3_crit.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3_crit.F90	(revision 3940)
@@ -1,59 +1,1 @@
-SUBROUTINE cv3_crit(nloc, ncum, nd, icb, inb, p, ph, pzero, v, threshold, &
-    kcrit, pcrit)
-  ! **************************************************************
-  ! *
-  ! CV3_CRIT   Find pressure level where vertical profile of    *
-  ! variable 'v' intersects 'threshold'              *
-  ! *
-  ! written by   : FROHWIRTH Julie, 13/08/2003, 21.55.12        *
-  ! modified by :                                               *
-  ! **************************************************************
-
-  IMPLICIT NONE
-
-  include "cv3param.h"
-
-  ! input:
-  INTEGER ncum, nd, nloc
-  INTEGER icb(nloc), inb(nloc)
-  REAL p(nloc, nd), ph(nloc, nd+1)
-  REAL pzero(nloc)
-  REAL v(nloc, nd), threshold
-
-  ! output:
-  INTEGER kcrit(nloc)
-  REAL pcrit(nloc)
-
-  ! local variables
-  INTEGER i, j, k, il
-  LOGICAL ok(nloc)
-
-  DO il = 1, ncum
-    ok(il) = .TRUE.
-    pcrit(il) = -1.
-    kcrit(il) = 0
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. ok(il)) THEN
-          IF ((v(il,i)-threshold)*(v(il,i-1)-threshold)<0.) THEN
-            pcrit(il) = ((threshold-v(il,i))*p(il,i-1)-(threshold-v(il, &
-              i-1))*p(il,i))/(v(il,i-1)-v(il,i))
-            IF (pcrit(il)>pzero(il)) THEN
-              pcrit(il) = -1.
-            ELSE
-              ok(il) = .FALSE.
-              kcrit(il) = i
-              IF (pcrit(il)<ph(il,i)) kcrit(il) = kcrit(il) + 1
-            END IF
-          END IF ! end IF (v(i) ...
-        END IF ! end IF (P(i) ...
-      END IF ! end IF (icb+1 le i le inb)
-    END DO
-  END DO
-
-
-  RETURN
-END SUBROUTINE cv3_crit
+link ../phylmd/cv3_crit.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3_inicp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3_inicp.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3_inicp.F90	(revision 3940)
@@ -1,118 +1,1 @@
-SUBROUTINE cv3_inicp()
-
-  ! **************************************************************
-  ! *
-  ! CV3_INIP Lecture des choix de lois de probabilité de mélange*
-  ! et calcul de leurs coefficients normalisés.        *
-  ! *
-  ! written by   : Jean-Yves Grandpeix, 06/06/2006, 19.39.27    *
-  ! modified by :                                               *
-  ! **************************************************************
-  IMPLICIT NONE
-  include "YOMCST2.h"
-
-  INTEGER iflag_clos
-  CHARACTER (LEN=20) :: modname = 'cv3_inicp'
-  CHARACTER (LEN=80) :: abort_message
-
-  ! --   Mixing probability distribution functions
-
-  REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
-  REAL :: sumcoef,sigma,aire,pdf,mu,df,ff
-
-  qcoef1(f) = tanh(f/gammas)
-  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
-  qff(f) = max(min(f,1.), 0.)
-  qfff(f) = min(qff(f), scut)
-  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
-  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
-    qcoef2max
-  qmix2(f) = -log(1.-qfff(f))/scut
-  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
-  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
-  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
-
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-  ! ===========================================================================
-  ! READ IN PARAMETERS FOR THE MIXING DISTRIBUTION
-  ! AND PASS THESE THROUGH A COMMON BLOCK TO SUBROUTINE CONVECT etc.
-  ! (Written by V.T.J. Phillips, 20-30/Jan/99)
-  ! ===========================================================================
-
-  ! line 1:  a flag (0 or 1) to decide whether P(F) = 1 or the general P(F)
-  ! is to be
-  ! used, followed by SCUT, which is the cut-off value of F in CONVECT
-  ! line 2:  blank
-  ! line 3:  the coefficients for the linear combination of P(F)s to
-  ! make the general P(F)
-  ! line 4:  blank
-  ! line 5:  gammas, Fmax for the cosh^2 component of P(F)
-  ! line 6:  blank
-  ! line 7:  alphas for the 1st irrational P(F)
-  ! line 8:  blank
-  ! line 9:  betas  for the 2nd irrational P(F)
-
-
-  ! open(57,file='parameter_mix.data')
-
-  ! read(57,*) iflag_clos
-  ! read(57,*) iflag_mix, scut
-  ! read(57,*)
-  ! if(iflag_mix .gt. 0) then
-  ! read(57,*) qqa1, qqa2
-  ! read(57,*)
-  ! read(57,*) gammas, Fmax
-  ! read(57,*)
-  ! read(57,*) alphas
-  ! endif
-  ! close(57)
-
-  IF (iflag_mix>0) THEN
-
-    ! --      Normalize Pdf weights
-
-    sumcoef = qqa1 + qqa2
-    qqa1 = qqa1/sumcoef
-    qqa2 = qqa2/sumcoef
-
-    qcoef1max = qcoef1(fmax)
-    qcoef2max = qcoef2(fmax)
-
-    sigma = 0.
-    aire = 0.0
-    pdf = 0.0
-    mu = 0.0
-    df = 0.0001
-
-    ! do ff = 0.0 + df, 1.0 - 2.*df, df
-    ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff)
-      mu = mu + pdf*ff*df
-      ! c              write(*,*) pdf,  Qmix(ff), aire, ff
-      ff = ff + df
-    END DO
-
-    ! do ff=0.0+df,1.0 - 2.*df,df
-    ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      sigma = sigma + pdf*(ff-mu)*(ff-mu)*df
-      ff = ff + df
-    END DO
-    sigma = sqrt(sigma)
-
-    IF (abs(aire-1.0)>0.02) THEN
-      PRINT *, 'WARNING:: AREA OF MIXING PDF IS::', aire
-      abort_message = ''
-      CALL abort_physic(modname, abort_message, 1)
-    ELSE
-      PRINT *, 'Area, mean & std deviation are ::', aire, mu, sigma
-    END IF
-  END IF !  (iflag_mix .gt. 0)
-
-  RETURN
-END SUBROUTINE cv3_inicp
+link ../phylmd/cv3_inicp.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3_inip.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3_inip.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3_inip.F90	(revision 3940)
@@ -1,146 +1,1 @@
-SUBROUTINE cv3_inip()
-  ! *******************************************************************
-  ! *                                                                  *
-  ! CV3_INIP Input = choice of mixing probability laws                 *
-  !          Output = normalized coefficients of the probability laws. *
-  ! *                                                                  *
-  ! written by   : Jean-Yves Grandpeix, 06/06/2006, 19.39.27           *
-  ! modified by :                                                      *
-  ! *******************************************************************
-!
-!----------------------------------------------
-!  INPUT (from Common YOMCST2 in "YOMCST2.h") : 
-! iflag_mix
-! gammas    
-! alphas
-! betas
-! Fmax
-! scut
-!
-!----------------------------------------------
-!  INPUT/OUTPUT (from and to Common YOMCST2 in "YOMCST2.h") : 
-! qqa1
-! qqa2
-!
-!----------------------------------------------
-!  OUTPUT (to Common YOMCST2 in "YOMCST2.h") :
-! Qcoef1max
-! Qcoef2max
-!
-!----------------------------------------------
-
-  USE print_control_mod, ONLY: prt_level, lunout
-  IMPLICIT NONE
-
-  include "YOMCST2.h"
-
-!----------------------------------------------
-! Local variables :
-   CHARACTER (LEN=20) :: modname = 'cv3_inip'
-   CHARACTER (LEN=80) :: abort_message
-
-   REAL               :: sumcoef
-   REAL               :: sigma, aire, pdf, mu, df
-   REAL               :: ff
-
-
-  ! --   Mixing probability distribution functions
-
-  REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
-
-  qcoef1(f) = tanh(f/gammas)
-  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
-  qff(f) = max(min(f,1.), 0.)
-  qfff(f) = min(qff(f), scut)
-  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
-  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
-    qcoef2max
-  qmix2(f) = -log(1.-qfff(f))/scut
-  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
-  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
-  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
-
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-  ! ===========================================================================
-  ! READ IN PARAMETERS FOR THE MIXING DISTRIBUTION
-  ! AND PASS THESE THROUGH A COMMON BLOCK TO SUBROUTINE CONVECT etc.
-  ! (Written by V.T.J. Phillips, 20-30/Jan/99)
-  ! ===========================================================================
-
-  ! line 1:  a flag (0 or 1) to decide whether P(F) = 1 or the general P(F)
-  ! is to be
-  ! used, followed by SCUT, which is the cut-off value of F in CONVECT
-  ! line 2:  blank
-  ! line 3:  the coefficients for the linear combination of P(F)s to
-  ! make the general P(F)
-  ! line 4:  blank
-  ! line 5:  gammas, Fmax for the cosh^2 component of P(F)
-  ! line 6:  blank
-  ! line 7:  alphas for the 1st irrational P(F)
-  ! line 8:  blank
-  ! line 9:  betas  for the 2nd irrational P(F)
-
-
-  ! c$$$        open(57,file='parameter_mix.data')
-  ! c$$$
-  ! c$$$        read(57,*) iflag_mix, scut
-  ! c$$$        read(57,*)
-  ! c$$$        if(iflag_mix .gt. 0) then
-  ! c$$$	      read(57,*) qqa1, qqa2
-  ! c$$$              read(57,*)
-  ! c$$$              read(57,*) gammas, Fmax
-  ! c$$$              read(57,*)
-  ! c$$$              read(57,*) alphas
-  ! c$$$         endif
-  ! c$$$	 close(57)
-
-
-  IF (iflag_mix>0) THEN
-
-    ! --      Normalize Pdf weights
-
-    sumcoef = qqa1 + qqa2
-    qqa1 = qqa1/sumcoef
-    qqa2 = qqa2/sumcoef
-
-    qcoef1max = qcoef1(fmax)
-    qcoef2max = qcoef2(fmax)
-
-    sigma = 0.
-    aire = 0.0
-    pdf = 0.0
-    mu = 0.0
-    df = 0.0001
-
-    ! do ff = 0.0 + df, 1.0 - 2.*df, df
-    ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff)
-      mu = mu + pdf*ff*df
-      IF (prt_level>9) WRITE (lunout, *) pdf, qmix(ff), aire, ff
-      ff = ff + df
-    END DO
-
-    ! do ff=0.0+df,1.0 - 2.*df,df
-    ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      sigma = sigma + pdf*(ff-mu)*(ff-mu)*df
-      ff = ff + df
-    END DO
-    sigma = sqrt(sigma)
-
-    IF (abs(aire-1.0)>0.02) THEN
-      WRITE (lunout, *) 'WARNING:: AREA OF MIXING PDF IS::', aire
-      abort_message = ''
-      CALL abort_physic(modname, abort_message, 1)
-    ELSE
-      PRINT *, 'Area, mean & std deviation are ::', aire, mu, sigma
-    END IF
-  END IF !  (iflag_mix .gt. 0)
-
-  RETURN
-END SUBROUTINE cv3_inip
+link ../phylmd/cv3_inip.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3_mixscale.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3_mixscale.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3_mixscale.F90	(revision 3940)
@@ -1,34 +1,1 @@
-SUBROUTINE cv3_mixscale(nloc, ncum, na, ment, m)
-  ! **************************************************************
-  ! *
-  ! CV3_MIXSCALE                                                *
-  ! *
-  ! *
-  ! written by   : Jean-Yves Grandpeix, 30/05/2003, 16.34.37    *
-  ! modified by :                                               *
-  ! **************************************************************
-
-  IMPLICIT NONE
-
-  include "cv3param.h"
-
-!inputs:
-  INTEGER, INTENT (IN)                               :: ncum, na, nloc
-  REAL, DIMENSION (nloc, na), INTENT (IN)            :: m
-!input/outputs:
-  REAL, DIMENSION (nloc, na, na), INTENT (INOUT)     :: ment
-
-!local variables:
-  INTEGER i, j, il
-
-    DO j = 1, nl
-      DO i = 1, nl
-        DO il = 1, ncum
-          ment(il, i, j) = m(il, i)*ment(il, i, j)
-        END DO
-      END DO
-    END DO
-
-
-  RETURN
-END SUBROUTINE cv3_mixscale
+link ../phylmd/cv3_mixscale.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3p1_closure.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3p1_closure.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3p1_closure.F90	(revision 3940)
@@ -1,773 +1,1 @@
-
-! $Id: cv3p1_closure.F90 3671 2020-04-29 13:48:22Z jyg $
-
-SUBROUTINE cv3p1_closure(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, &
-    tvp, buoy, supmax, ok_inhib, ale, alp, omega,sig, w0, ptop2, cape, cin, m, &
-    iflag, coef, plim1, plim2, asupmax, supmax0, asupmaxmin, cbmf, plfc, &
-    wbeff)
-
-
-  ! **************************************************************
-  ! *
-  ! CV3P1_CLOSURE                                               *
-  ! Ale & Alp Closure of Convect3              *
-  ! *
-  ! written by   :   Kerry Emanuel                              *
-  ! vectorization:   S. Bony                                    *
-  ! modified by :    Jean-Yves Grandpeix, 18/06/2003, 19.32.10  *
-  ! Julie Frohwirth,     14/10/2005  17.44.22  *
-  ! **************************************************************
-
-  USE print_control_mod, ONLY: prt_level, lunout
-  IMPLICIT NONE
-
-  include "cvthermo.h"
-  include "cv3param.h"
-  include "YOMCST2.h"
-  include "YOMCST.h"
-  include "conema3.h"
-
-  ! input:
-  INTEGER, INTENT (IN)                               :: ncum, nd, nloc
-  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb
-  REAL, DIMENSION (nloc), INTENT (IN)                :: pbase, plcl
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
-  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: tv, tvp, buoy
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: supmax
-  LOGICAL, INTENT (IN)                               :: ok_inhib ! enable convection inhibition by dryness
-  REAL, DIMENSION (nloc), INTENT (IN)                :: ale, alp
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: omega
-
-  ! input/output:
-  INTEGER, DIMENSION (nloc), INTENT (INOUT)          :: iflag
-  REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: sig, w0
-  REAL, DIMENSION (nloc), INTENT (INOUT)             :: ptop2
-
-  ! output:
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: cape, cin
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: m
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: plim1, plim2
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: asupmax
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: supmax0
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: asupmaxmin
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: cbmf, plfc
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: wbeff
-
-  ! local variables:
-  INTEGER il, i, j, k, icbmax, i0(nloc), klfc(nloc)
-  REAL deltap, fac, w, amu
-  REAL rhodp, dz
-  REAL pbmxup
-  REAL dtmin(nloc, nd), sigold(nloc, nd)
-  REAL coefmix(nloc, nd)
-  REAL pzero(nloc), ptop2old(nloc)
-  REAL cina(nloc), cinb(nloc)
-  INTEGER ibeg(nloc)
-  INTEGER nsupmax(nloc)
-  REAL supcrit, temp(nloc, nd)
-  REAL p1(nloc), pmin(nloc)
-  REAL asupmax0(nloc)
-  LOGICAL ok(nloc)
-  REAL siglim(nloc, nd), wlim(nloc, nd), mlim(nloc, nd)
-  REAL wb2(nloc)
-  REAL cbmflim(nloc), cbmf1(nloc), cbmfmax(nloc)
-  REAL cbmflast(nloc)
-  REAL coef(nloc)
-  REAL xp(nloc), xq(nloc), xr(nloc), discr(nloc), b3(nloc), b4(nloc)
-  REAL theta(nloc), bb(nloc)
-  REAL term1, term2, term3
-  REAL alp2(nloc) ! Alp with offset
-  !CR: variables for new erosion of adiabiatic ascent
-  REAL mad(nloc, nd), me(nloc, nd), betalim(nloc, nd), beta_coef(nloc, nd)
-  REAL med(nloc, nd), md(nloc,nd)
-!jyg<
-! coef_peel is now in the common cv3_param 
-!!  REAL coef_peel
-!!  PARAMETER (coef_peel=0.25)
-!>jyg
-
-  REAL sigmax
-  PARAMETER (sigmax=0.1)
-
-  CHARACTER (LEN=20) :: modname = 'cv3p1_closure'
-  CHARACTER (LEN=80) :: abort_message
-
-  ! print *,' -> cv3p1_closure, Ale ',ale(1)
-
-
-  ! -------------------------------------------------------
-  ! -- Initialization
-  ! -------------------------------------------------------
-
-
-  DO il = 1, ncum
-    alp2(il) = max(alp(il), 1.E-5)
-    ! IM
-    alp2(il) = max(alp(il), 1.E-12)
-  END DO
-
-  pbmxup = 50. ! PBMXUP+PBCRIT = cloud depth above which mixed updraughts
-  ! exist (if any)
-
-  IF (prt_level>=20) PRINT *, 'cv3p1_param nloc ncum nd icb inb nl', nloc, &
-    ncum, nd, icb(nloc), inb(nloc), nl
-  DO k = 1, nd          !jyg: initialization up to nd
-    DO il = 1, ncum
-      m(il, k) = 0.0
-    END DO
-  END DO
-
-!CR: initializations for erosion of adiabatic ascent 
-  DO k = 1,nd           !jyg: initialization up to nd
-    DO il = 1, ncum
-        mad(il,k)=0.
-        me(il,k)=0.
-        betalim(il,k)=1.
-        wlim(il,k)=0.
-    ENDDO
-  ENDDO
-
-  ! -------------------------------------------------------
-  ! -- Reset sig(i) and w0(i) for i>inb and i<icb
-  ! -------------------------------------------------------
-
-  ! update sig and w0 above LNB:
-
-  DO k = 1, nl - 1
-    DO il = 1, ncum
-      IF ((inb(il)<(nl-1)) .AND. (k>=(inb(il)+1))) THEN
-        sig(il, k) = beta*sig(il, k) + 2.*alpha*buoy(il, inb(il))*abs(buoy(il &
-          ,inb(il)))
-        sig(il, k) = amax1(sig(il,k), 0.0)
-        w0(il, k) = beta*w0(il, k)
-      END IF
-    END DO
-  END DO
-
-  ! if(prt.level.GE.20) print*,'cv3p1_param apres 100'
-  ! compute icbmax:
-
-  icbmax = 2
-  DO il = 1, ncum
-    icbmax = max(icbmax, icb(il))
-  END DO
-  ! if(prt.level.GE.20) print*,'cv3p1_param apres 200'
-
-  ! update sig and w0 below cloud base:
-
-  DO k = 1, icbmax
-    DO il = 1, ncum
-      IF (k<=icb(il)) THEN
-        sig(il, k) = beta*sig(il, k) - 2.*alpha*buoy(il, icb(il))*buoy(il, &
-          icb(il))
-        sig(il, k) = amax1(sig(il,k), 0.0)
-        w0(il, k) = beta*w0(il, k)
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 300'
-  ! -------------------------------------------------------------
-  ! -- Reset fractional areas of updrafts and w0 at initial time
-  ! -- and after 10 time steps of no convection
-  ! -------------------------------------------------------------
-
-  DO k = 1, nl - 1
-    DO il = 1, ncum
-      IF (sig(il,nd)<1.5 .OR. sig(il,nd)>12.0) THEN
-        sig(il, k) = 0.0
-        w0(il, k) = 0.0
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 400'
-
-  ! -------------------------------------------------------------
-  ! jyg1
-  ! --  Calculate adiabatic ascent top pressure (ptop)
-  ! -------------------------------------------------------------
-
-
-  ! c 1. Start at first level where precipitations form
-  DO il = 1, ncum
-    pzero(il) = plcl(il) - pbcrit
-  END DO
-
-  ! c 2. Add offset
-  DO il = 1, ncum
-    pzero(il) = pzero(il) - pbmxup
-  END DO
-  DO il = 1, ncum
-    ptop2old(il) = ptop2(il)
-  END DO
-
-  DO il = 1, ncum
-    ! CR:c est quoi ce 300??
-    p1(il) = pzero(il) - 300.
-  END DO
-
-  ! compute asupmax=abs(supmax) up to lnm+1
-
-  DO il = 1, ncum
-    ok(il) = .TRUE.
-    nsupmax(il) = inb(il)
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. supmax(il,i)<0 .AND. ok(il)) THEN
-          nsupmax(il) = i
-          ok(il) = .FALSE.
-        END IF ! end IF (P(i) ...  )
-      END IF ! end IF (icb+1 le i le inb)
-    END DO
-  END DO
-
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 2.'
-  DO i = 1, nl
-    DO il = 1, ncum
-      asupmax(il, i) = abs(supmax(il,i))
-    END DO
-  END DO
-
-
-  DO il = 1, ncum
-    asupmaxmin(il) = 10.
-    pmin(il) = 100.
-    ! IM ??
-    asupmax0(il) = 0.
-  END DO
-
-  ! c 3.  Compute in which level is Pzero
-
-  ! IM bug      i0 = 18
-  DO il = 1, ncum
-    i0(il) = nl
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
-          IF (pzero(il)>p(il,i) .AND. pzero(il)<p(il,i-1)) THEN
-            i0(il) = i
-          END IF
-        END IF
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 3.'
-
-  ! c 4.  Compute asupmax at Pzero
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
-          asupmax0(il) = ((pzero(il)-p(il,i0(il)-1))*asupmax(il,i0(il))-( &
-            pzero(il)-p(il,i0(il)))*asupmax(il,i0(il)-1))/(p(il,i0(il))-p(il, &
-            i0(il)-1))
-        END IF
-      END IF
-    END DO
-  END DO
-
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (p(il,i)==pzero(il)) THEN
-        asupmax(i, il) = asupmax0(il)
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 4.'
-
-  ! c 5. Compute asupmaxmin, minimum of asupmax
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
-          IF (asupmax(il,i)<asupmaxmin(il)) THEN
-            asupmaxmin(il) = asupmax(il, i)
-            pmin(il) = p(il, i)
-          END IF
-        END IF
-      END IF
-    END DO
-  END DO
-
-  DO il = 1, ncum
-    ! IM
-    IF (prt_level>=20) THEN
-      PRINT *, 'cv3p1_closure il asupmax0 asupmaxmin', il, asupmax0(il), &
-        asupmaxmin(il), pzero(il), pmin(il)
-    END IF
-    IF (asupmax0(il)<asupmaxmin(il)) THEN
-      asupmaxmin(il) = asupmax0(il)
-      pmin(il) = pzero(il)
-    END IF
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 5.'
-
-
-  ! Compute Supmax at Pzero
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il)) THEN
-          supmax0(il) = ((p(il,i)-pzero(il))*asupmax(il,i-1)-(p(il, &
-            i-1)-pzero(il))*asupmax(il,i))/(p(il,i)-p(il,i-1))
-          GO TO 425
-        END IF ! end IF (P(i) ... )
-      END IF ! end IF (icb+1 le i le inb)
-    END DO
-  END DO
-
-425 CONTINUE
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 425.'
-
-  ! c 6. Calculate ptop2
-
-  DO il = 1, ncum
-    IF (asupmaxmin(il)<supcrit1) THEN
-      ptop2(il) = pmin(il)
-    END IF
-
-    IF (asupmaxmin(il)>supcrit1 .AND. asupmaxmin(il)<supcrit2) THEN
-      ptop2(il) = ptop2old(il)
-    END IF
-
-    IF (asupmaxmin(il)>supcrit2) THEN
-      ptop2(il) = ph(il, inb(il))
-    END IF
-  END DO
-
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 6.'
-
-  ! c 7. Compute multiplying factor for adiabatic updraught mass flux
-
-
-  IF (ok_inhib) THEN
-
-    DO i = 1, nl
-      DO il = 1, ncum
-        IF (i<=nl) THEN
-          coefmix(il, i) = (min(ptop2(il),ph(il,i))-ph(il,i))/(ph(il,i+1)-ph( &
-            il,i))
-          coefmix(il, i) = min(coefmix(il,i), 1.)
-        END IF
-      END DO
-    END DO
-
-
-  ELSE ! when inhibition is not taken into account, coefmix=1
-
-
-
-    DO i = 1, nl
-      DO il = 1, ncum
-        IF (i<=nl) THEN
-          coefmix(il, i) = 1.
-        END IF
-      END DO
-    END DO
-
-  END IF ! ok_inhib
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 7.'
-  ! -------------------------------------------------------------------
-  ! -------------------------------------------------------------------
-
-
-  ! jyg2
-
-  ! ==========================================================================
-
-
-  ! -------------------------------------------------------------
-  ! -- Calculate convective inhibition (CIN)
-  ! -------------------------------------------------------------
-
-  ! do i=1,nloc
-  ! print*,'avant cine p',pbase(i),plcl(i)
-  ! enddo
-  ! do j=1,nd
-  ! do i=1,nloc
-  ! print*,'avant cine t',tv(i),tvp(i)
-  ! enddo
-  ! enddo
-  CALL cv3_cine(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, tvp, cina, &
-    cinb, plfc)
-
-  DO il = 1, ncum
-    cin(il) = cina(il) + cinb(il)
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres cv3_cine'
-  ! -------------------------------------------------------------
-  ! --Update buoyancies to account for Ale
-  ! -------------------------------------------------------------
-
-  CALL cv3_buoy(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, ale, cin, tv, &
-    tvp, buoy)
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres cv3_buoy'
-
-  ! -------------------------------------------------------------
-  ! -- Calculate convective available potential energy (cape),
-  ! -- vertical velocity (w), fractional area covered by
-  ! -- undilute updraft (sig), and updraft mass flux (m)
-  ! -------------------------------------------------------------
-
-  DO il = 1, ncum
-    cape(il) = 0.0
-  END DO
-
-  ! compute dtmin (minimum buoyancy between ICB and given level k):
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      dtmin(il, k) = 100.0
-    END DO
-  END DO
-
-  DO k = 1, nl
-    DO j = minorig, nl
-      DO il = 1, ncum
-        IF ((k>=(icb(il)+1)) .AND. (k<=inb(il)) .AND. (j>=icb(il)) .AND. (j<= &
-            (k-1))) THEN
-          dtmin(il, k) = amin1(dtmin(il,k), buoy(il,j))
-        END IF
-      END DO
-    END DO
-  END DO
-
-  ! the interval on which cape is computed starts at pbase :
-
-  DO k = 1, nl
-    DO il = 1, ncum
-
-      IF ((k>=(icb(il)+1)) .AND. (k<=inb(il))) THEN
-        IF (iflag_mix_adiab.eq.1) THEN
-!CR:computation of cape from LCL: keep flag or to modify in all cases?
-        deltap = min(plcl(il), ph(il,k-1)) - min(plcl(il), ph(il,k))
-        ELSE
-        deltap = min(pbase(il), ph(il,k-1)) - min(pbase(il), ph(il,k))
-        ENDIF
-        cape(il) = cape(il) + rrd*buoy(il, k-1)*deltap/p(il, k-1)
-        cape(il) = amax1(0.0, cape(il))
-        sigold(il, k) = sig(il, k)
-
-
-        ! jyg       Coefficient coefmix limits convection to levels where a
-        ! sufficient
-        ! fraction of mixed draughts are ascending.
-        siglim(il, k) = coefmix(il, k)*alpha1*dtmin(il, k)*abs(dtmin(il,k))
-        siglim(il, k) = amax1(siglim(il,k), 0.0)
-        siglim(il, k) = amin1(siglim(il,k), 0.01)
-        ! c         fac=AMIN1(((dtcrit-dtmin(il,k))/dtcrit),1.0)
-        fac = 1.
-        wlim(il, k) = fac*sqrt(cape(il))
-        amu = siglim(il, k)*wlim(il, k)
-        rhodp = 0.007*p(il, k)*(ph(il,k)-ph(il,k+1))/tv(il, k)
-        mlim(il, k) = amu*rhodp
-        ! print*, 'siglim ', k,siglim(1,k)
-      END IF
-
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 600'
-
-  DO il = 1, ncum
-    ! IM beg
-    IF (prt_level>=20) THEN
-      PRINT *, 'cv3p1_closure il icb mlim ph ph+1 ph+2', il, icb(il), &
-        mlim(il, icb(il)+1), ph(il, icb(il)), ph(il, icb(il)+1), &
-        ph(il, icb(il)+2)
-    END IF
-
-    IF (icb(il)+1<=inb(il)) THEN
-      ! IM end
-      mlim(il, icb(il)) = 0.5*mlim(il, icb(il)+1)*(ph(il,icb(il))-ph(il,icb( &
-        il)+1))/(ph(il,icb(il)+1)-ph(il,icb(il)+2))
-      ! IM beg
-    END IF !(icb(il.le.inb(il))) then
-    ! IM end
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres 700'
-
-  ! jyg1
-  ! ------------------------------------------------------------------------
-  ! c     Correct mass fluxes so that power used to overcome CIN does not
-  ! c     exceed Power Available for Lifting (PAL).
-  ! ------------------------------------------------------------------------
-
-  DO il = 1, ncum
-    cbmflim(il) = 0.
-    cbmf(il) = 0.
-  END DO
-
-  ! c 1. Compute cloud base mass flux of elementary system (Cbmf0=Cbmflim)
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      ! old       IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
-      ! IM        IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
-      IF (k>=icb(il) .AND. k<=inb(il) & !cor jyg
-          .AND. icb(il)+1<=inb(il)) THEN !cor jyg
-        cbmflim(il) = cbmflim(il) + mlim(il, k)
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres cbmflim'
-
-  ! 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum
-  !     allowed mass flux (Cbmfmax) and final target mass flux (Cbmf)
-  !     Cbmf is set to zero if Cbmflim (the mass flux of elementary cloud)
-  !     is exceedingly small.
-
-  DO il = 1, ncum
-    wb2(il) = sqrt(2.*max(ale(il)+cin(il),0.))
-  END DO
-
-  DO il = 1, ncum
-    IF (plfc(il)<100.) THEN
-      ! This is an irealistic value for plfc => no calculation of wbeff
-      wbeff(il) = 100.1
-    ELSE
-      ! Calculate wbeff
-      IF (NINT(flag_wb)==0) THEN
-        wbeff(il) = wbmax
-      ELSE IF (NINT(flag_wb)==1) THEN
-        wbeff(il) = wbmax/(1.+500./(ph(il,1)-plfc(il)))
-      ELSE IF (NINT(flag_wb)==2) THEN
-        wbeff(il) = wbmax*(0.01*(ph(il,1)-plfc(il)))**2
-      ELSE ! Option provisoire ou le iflag_wb/10 est considere comme une vitesse
-        wbeff(il) = flag_wb*0.01+wbmax/(1.+500./(ph(il,1)-plfc(il)))
-      END IF
-    END IF
-  END DO
-
-!CR:Compute k at plfc
-  DO il=1,ncum
-           klfc(il)=nl
-  ENDDO
-  DO k=1,nl
-     DO il=1,ncum
-        if ((plfc(il).lt.ph(il,k)).and.(plfc(il).ge.ph(il,k+1))) then
-           klfc(il)=k
-        endif
-     ENDDO
-  ENDDO
-!RC
-
-  DO il = 1, ncum
-    ! jyg    Modification du coef de wb*wb pour conformite avec papier Wake
-    ! c       cbmf1(il) = alp2(il)/(0.5*wb*wb-Cin(il))
-    cbmf1(il) = alp2(il)/(2.*wbeff(il)*wbeff(il)-cin(il))
-!CR: Add large-scale component to the mass-flux
-!encore connu sous le nom "Experience du tube de dentifrice"
-    if ((coef_clos_ls.gt.0.).and.(plfc(il).gt.0.)) then 
-       cbmf1(il) = cbmf1(il) - coef_clos_ls*min(0.,1./RG*omega(il,klfc(il)))
-    endif
-!RC
-    IF (cbmf1(il)==0 .AND. alp2(il)/=0.) THEN
-      WRITE (lunout, *) 'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ' &
-        , il, alp2(il), alp(il), cin(il)
-      abort_message = ''
-      CALL abort_physic(modname, abort_message, 1)
-    END IF
-    cbmfmax(il) = sigmax*wb2(il)*100.*p(il, icb(il))/(rrd*tv(il,icb(il)))
-  END DO
-
-  DO il = 1, ncum
-    IF (cbmflim(il)>1.E-6) THEN
-      ! ATTENTION TEST CR
-      ! if (cbmfmax(il).lt.1.e-12) then
-      cbmf(il) = min(cbmf1(il), cbmfmax(il))
-      ! else
-      ! cbmf(il) = cbmf1(il)
-      ! endif
-      ! print*,'cbmf',cbmf1(il),cbmfmax(il)
-    END IF
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres cbmflim_testCR'
-
-  ! c 2. Compute coefficient and apply correction
-
-  DO il = 1, ncum
-    coef(il) = (cbmf(il)+1.E-10)/(cbmflim(il)+1.E-10)
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres coef_plantePLUS'
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (k>=icb(il)+1 .AND. k<=inb(il)) THEN
-        amu = beta*sig(il, k)*w0(il, k) + (1.-beta)*coef(il)*siglim(il, k)* &
-          wlim(il, k)
-        w0(il, k) = wlim(il, k)
-        w0(il, k) = max(w0(il,k), 1.E-10)
-        sig(il, k) = amu/w0(il, k)
-        sig(il, k) = min(sig(il,k), 1.)
-        ! c         amu = 0.5*(SIG(il,k)+sigold(il,k))*W0(il,k)
-        m(il, k) = amu*0.007*p(il, k)*(ph(il,k)-ph(il,k+1))/tv(il, k)
-      END IF
-    END DO
-  END DO
-  ! jyg2
-  DO il = 1, ncum
-    w0(il, icb(il)) = 0.5*w0(il, icb(il)+1)
-    m(il, icb(il)) = 0.5*m(il, icb(il)+1)*(ph(il,icb(il))-ph(il,icb(il)+1))/ &
-      (ph(il,icb(il)+1)-ph(il,icb(il)+2))
-    sig(il, icb(il)) = sig(il, icb(il)+1)
-    sig(il, icb(il)-1) = sig(il, icb(il))
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres w0_sig_M'
-
-!CR: new erosion of adiabatic ascent: modification of m
-!computation of the sum of ascending fluxes 
-  IF (iflag_mix_adiab.eq.1) THEN
-
-!Verification sum(me)=sum(m)
-  DO k = 1,nd                         !jyg: initialization up to nd
-    DO il = 1, ncum
-       md(il,k)=0.
-       med(il,k)=0.
-    ENDDO
-  ENDDO
-
-  DO k = nl,1,-1
-    DO il = 1, ncum
-           md(il,k)=md(il,k+1)+m(il,k+1)
-    ENDDO
-  ENDDO
-
-  DO k = nl,1,-1
-    DO il = 1, ncum
-        IF ((k>=(icb(il))) .AND. (k<=inb(il))) THEN
-           mad(il,k)=mad(il,k+1)+m(il,k+1)
-        ENDIF
-!        print*,"mad",il,k,mad(il,k)
-    ENDDO
-  ENDDO
-
-!CR: erosion of each adiabatic ascent during its ascent
-
-!Computation of erosion coefficient beta_coef
-  DO k = 1, nl
-    DO il = 1, ncum
-       IF ((k>=(icb(il)+1)) .AND. (k<=inb(il)) .AND. (mlim(il,k).gt.0.)) THEN     
-!          print*,"beta_coef",il,k,icb(il),inb(il),buoy(il,k),tv(il,k),wlim(il,k),wlim(il,k+1)
-          beta_coef(il,k)=RG*coef_peel*buoy(il,k)/tv(il,k)/((wlim(il,k)+wlim(il,k+1))/2.)**2
-       ELSE
-          beta_coef(il,k)=0.
-       ENDIF
-    ENDDO
-  ENDDO
-
-!  print*,"apres beta_coef"
-
-  DO k = 1, nl
-    DO il = 1, ncum
-
-      IF ((k>=(icb(il)+1)) .AND. (k<=inb(il))) THEN
-
-!        print*,"dz",il,k,tv(il, k-1)
-        dz = (ph(il,k-1)-ph(il,k))/(p(il, k-1)/(rrd*tv(il, k-1))*RG)
-        betalim(il,k)=betalim(il,k-1)*exp(-1.*beta_coef(il,k-1)*dz)
-!        betalim(il,k)=betalim(il,k-1)*exp(-RG*coef_peel*buoy(il,k-1)/tv(il,k-1)/5.**2*dz)
-!        print*,"me",il,k,mlim(il,k),buoy(il,k),wlim(il,k),mad(il,k)
-        dz = (ph(il,k)-ph(il,k+1))/(p(il, k)/(rrd*tv(il, k))*RG)
-!        me(il,k)=betalim(il,k)*(m(il,k)+RG*coef_peel*buoy(il,k)/tv(il,k)/((wlim(il,k)+wlim(il,k+1))/2.)**2*dz*mad(il,k))
-        me(il,k)=betalim(il,k)*(m(il,k)+beta_coef(il,k)*dz*mad(il,k))
-!        print*,"B/w2",il,k,RG*coef_peel*buoy(il,k)/tv(il,k)/((wlim(il,k)+wlim(il,k+1))/2.)**2*dz    
-      
-      END IF
-        
-!Modification of m
-      m(il,k)=me(il,k) 
-    END DO
-  END DO
- 
-!  DO il = 1, ncum
-!     dz = (ph(il,icb(il))-ph(il,icb(il)+1))/(p(il, icb(il))/(rrd*tv(il, icb(il)))*RG)
-!     m(il,icb(il))=m(il,icb(il))+RG*coef_peel*buoy(il,icb(il))/tv(il,icb(il)) &
-!                  /((wlim(il,icb(il))+wlim(il,icb(il)+1))/2.)**2*dz*mad(il,icb(il))
-!     print*,"wlim(icb)",icb(il),wlim(il,icb(il)),m(il,icb(il))
-!  ENDDO
-
-!Verification sum(me)=sum(m)
-  DO k = nl,1,-1
-    DO il = 1, ncum
-           med(il,k)=med(il,k+1)+m(il,k+1)
-!           print*,"somme(me),somme(m)",il,k,icb(il),med(il,k),md(il,k),me(il,k),m(il,k),wlim(il,k)
-    ENDDO
-  ENDDO
-
-
-  ENDIF !(iflag_mix_adiab)
-!RC
-
-
-
-  ! c 3. Compute final cloud base mass flux and set iflag to 3 if
-  ! c    cloud base mass flux is exceedingly small and is decreasing (i.e. if
-  ! c    the final mass flux (cbmflast) is greater than the target mass flux
-  ! c    (cbmf)).
-
-  DO il = 1, ncum
-    cbmflast(il) = 0.
-  END DO
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (k>=icb(il) .AND. k<=inb(il)) THEN
-          !IMpropo??      IF ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) THEN
-        cbmflast(il) = cbmflast(il) + m(il, k)
-      END IF
-    END DO
-  END DO
-
-  DO il = 1, ncum
-    IF (cbmflast(il)<1.E-6 .AND. cbmflast(il)>=cbmf(il)) THEN
-      iflag(il) = 3
-    END IF
-  END DO
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (iflag(il)>=3) THEN
-        m(il, k) = 0.
-        sig(il, k) = 0.
-        w0(il, k) = 0.
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p1_param apres iflag'
-
-  ! c 4. Introduce a correcting factor for coef, in order to obtain an
-  ! effective
-  ! c    sigdz larger in the present case (using cv3p1_closure) than in the
-  ! old
-  ! c    closure (using cv3_closure).
-  IF (1==0) THEN
-    DO il = 1, ncum
-      ! c      coef(il) = 2.*coef(il)
-      coef(il) = 5.*coef(il)
-    END DO
-    ! version CVS du ..2008
-  ELSE
-    IF (iflag_cvl_sigd==0) THEN
-      ! test pour verifier qu on fait la meme chose qu avant: sid constant
-      coef(1:ncum) = 1.
-    ELSE
-      coef(1:ncum) = min(2.*coef(1:ncum), 5.)
-      coef(1:ncum) = max(2.*coef(1:ncum), 0.2)
-    END IF
-  END IF
-
-  IF (prt_level>=20) PRINT *, 'cv3p1_param FIN'
-  RETURN
-END SUBROUTINE cv3p1_closure
-
-
+link ../phylmd/cv3p1_closure.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3p2_closure.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3p2_closure.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3p2_closure.F90	(revision 3940)
@@ -1,869 +1,1 @@
-
-
-SUBROUTINE cv3p2_closure(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, &
-    tvp, buoy, supmax, ok_inhib, ale, alp, omega,sig, w0, ptop2, cape, cin, m, &
-    iflag, coef, plim1, plim2, asupmax, supmax0, asupmaxmin, cbmflast, plfc, &
-    wbeff)
-
-
-  ! **************************************************************
-  ! *
-  ! CV3P2_CLOSURE                                               *
-  ! Ale & Alp Closure of Convect3              *
-  ! *
-  ! written by   :   Kerry Emanuel                              *
-  ! vectorization:   S. Bony                                    *
-  ! modified by :    Jean-Yves Grandpeix, 18/06/2003, 19.32.10  *
-  ! Julie Frohwirth,     14/10/2005  17.44.22  *
-  ! **************************************************************
-
-  USE print_control_mod, ONLY: prt_level, lunout
-  IMPLICIT NONE
-
-  include "cvthermo.h"
-  include "cv3param.h"
-  include "cvflag.h"
-  include "YOMCST2.h"
-  include "YOMCST.h"
-  include "conema3.h"
-
-  ! input:
-  INTEGER, INTENT (IN)                               :: ncum, nd, nloc
-  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb
-  REAL, DIMENSION (nloc), INTENT (IN)                :: pbase, plcl
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
-  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: tv, tvp, buoy
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: supmax
-  LOGICAL, INTENT (IN)                               :: ok_inhib ! enable convection inhibition by dryness
-  REAL, DIMENSION (nloc), INTENT (IN)                :: ale, alp
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: omega
-
-  ! input/output:
-  INTEGER, DIMENSION (nloc), INTENT (INOUT)          :: iflag
-  REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: sig, w0
-  REAL, DIMENSION (nloc), INTENT (INOUT)             :: ptop2
-
-  ! output:
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: cape, cin
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: m
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: plim1, plim2
-  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: asupmax
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: supmax0
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: asupmaxmin
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: cbmflast, plfc
-  REAL, DIMENSION (nloc), INTENT (OUT)               :: wbeff
-
-  ! local variables:
-  INTEGER                                            :: il, i, j, k, icbmax
-  INTEGER, DIMENSION (nloc)                          :: i0, klfc
-  REAL                                               :: deltap, fac, w, amu
-  REAL, DIMENSION (nloc, nd)                         :: rhodp               ! Factor such that m=rhodp*sig*w
-  REAL                                               :: dz
-  REAL                                               :: pbmxup
-  REAL, DIMENSION (nloc, nd)                         :: dtmin, sigold
-  REAL, DIMENSION (nloc, nd)                         :: coefmix
-  REAL, DIMENSION (nloc)                             :: dtminmax
-  REAL, DIMENSION (nloc)                             :: pzero, ptop2old
-  REAL, DIMENSION (nloc)                             :: cina, cinb
-  INTEGER, DIMENSION (nloc)                          :: ibeg
-  INTEGER, DIMENSION (nloc)                          :: nsupmax
-  REAL                                               :: supcrit
-  REAL, DIMENSION (nloc, nd)                         :: temp
-  REAL, DIMENSION (nloc)                             :: p1, pmin
-  REAL, DIMENSION (nloc)                             :: asupmax0
-  LOGICAL, DIMENSION (nloc)                          :: ok
-  REAL, DIMENSION (nloc, nd)                         :: siglim, wlim, mlim
-  REAL, DIMENSION (nloc)                             :: wb2
-  REAL, DIMENSION (nloc)                             :: cbmf0        ! initial cloud base mass flux
-  REAL, DIMENSION (nloc)                             :: cbmflim      ! cbmf given by Cape closure
-  REAL, DIMENSION (nloc)                             :: cbmfalp      ! cbmf given by Alp closure
-  REAL, DIMENSION (nloc)                             :: cbmfalpb     ! bounded cbmf given by Alp closure
-  REAL, DIMENSION (nloc)                             :: cbmfmax      ! upper bound on cbmf
-  REAL, DIMENSION (nloc)                             :: coef
-  REAL, DIMENSION (nloc)                             :: xp, xq, xr, discr, b3, b4
-  REAL, DIMENSION (nloc)                             :: theta, bb
-  REAL                                               :: term1, term2, term3
-  REAL, DIMENSION (nloc)                             :: alp2                  ! Alp with offset
-
-!CR: variables for new erosion of adiabiatic ascent
-  REAL, DIMENSION (nloc, nd)                         :: mad, me, betalim, beta_coef
-  REAL, DIMENSION (nloc, nd)                         :: med, md
-!jyg<
-! coef_peel is now in the common cv3_param 
-!!  REAL                                               :: coef_peel
-!!  PARAMETER (coef_peel=0.25)
-!>jyg
-
-  REAL                                               :: sigmax
-  PARAMETER (sigmax=0.1)
-!!  PARAMETER (sigmax=10.)
-
-  CHARACTER (LEN=20)                                 :: modname = 'cv3p2_closure'
-  CHARACTER (LEN=80)                                 :: abort_message
-
-  INTEGER,SAVE                                       :: igout=1
-!$OMP THREADPRIVATE(igout)
-
- IF (prt_level>=20) print *,' -> cv3p2_closure, Ale ',ale(igout)
-
-
-  ! -------------------------------------------------------
-  ! -- Initialization
-  ! -------------------------------------------------------
-
-
-  DO il = 1, ncum
-    alp2(il) = max(alp(il), 1.E-5)
-    ! IM
-    alp2(il) = max(alp(il), 1.E-12)
-  END DO
-
-  pbmxup = 50. ! PBMXUP+PBCRIT = cloud depth above which mixed updraughts
-  ! exist (if any)
-
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure nloc ncum nd icb inb nl', nloc, &
-    ncum, nd, icb(nloc), inb(nloc), nl
-  DO k = 1, nl
-    DO il = 1, ncum
-      rhodp(il,k) = 0.007*p(il, k)*(ph(il,k)-ph(il,k+1))/tv(il, k)
-    END DO
-  END DO
-
-!CR+jyg: initializations (up to nd) for erosion of adiabatic ascent and of m and wlim
-  DO k = 1,nd
-    DO il = 1, ncum
-        mad(il,k)=0.
-        me(il,k)=0.
-        betalim(il,k)=1.
-        wlim(il,k)=0.
-        m(il, k) = 0.0
-    ENDDO
-  ENDDO
-
-  ! -------------------------------------------------------
-  ! -- Reset sig(i) and w0(i) for i>inb and i<icb
-  ! -------------------------------------------------------
-
-  ! update sig and w0 above LNB:
-
-  DO k = 1, nl - 1
-    DO il = 1, ncum
-      IF ((inb(il)<(nl-1)) .AND. (k>=(inb(il)+1))) THEN
-        sig(il, k) = beta*sig(il, k) + 2.*alpha*buoy(il, inb(il))*abs(buoy(il,inb(il)))
-        sig(il, k) = amax1(sig(il,k), 0.0)
-        w0(il, k) = beta*w0(il, k)
-      END IF
-    END DO
-  END DO
-
-  ! if(prt.level.GE.20) print*,'cv3p2_closure apres 100'
-  ! compute icbmax:
-
-  icbmax = 2
-  DO il = 1, ncum
-    icbmax = max(icbmax, icb(il))
-  END DO
-  ! if(prt.level.GE.20) print*,'cv3p2_closure apres 200'
-
-  ! update sig and w0 below cloud base:
-
-  DO k = 1, icbmax
-    DO il = 1, ncum
-      IF (k<=icb(il)) THEN
-        sig(il, k) = beta*sig(il, k) - 2.*alpha*buoy(il, icb(il))*buoy(il,icb(il))
-        sig(il, k) = amax1(sig(il,k), 0.0)
-        w0(il, k) = beta*w0(il, k)
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 300'
-
-  ! -------------------------------------------------------------
-  ! -- Reset fractional areas of updrafts and w0 at initial time
-  ! -- and after 10 time steps of no convection
-  ! -------------------------------------------------------------
-
-!jyg<
-  IF (ok_convstop) THEN
-    DO k = 1, nl - 1
-      DO il = 1, ncum
-        IF (sig(il,nd)<1.5 .OR. sig(il,nd)>noconv_stop) THEN
-          sig(il, k) = 0.0
-          w0(il, k) = 0.0
-        END IF
-      END DO
-    END DO
-  ELSE
-  DO k = 1, nl - 1
-    DO il = 1, ncum
-      IF (sig(il,nd)<1.5 .OR. sig(il,nd)>12.0) THEN
-        sig(il, k) = 0.0
-        w0(il, k) = 0.0
-      END IF
-    END DO
-  END DO
-  ENDIF  ! (ok_convstop)
-!>jyg
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 400'
-
-  ! -------------------------------------------------------
-  ! -- Compute initial cloud base mass flux (Cbmf0)
-  ! -------------------------------------------------------
-  DO il = 1, ncum
-    cbmf0(il) = 0.0
-  END DO
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (k>=icb(il) .AND. k<=inb(il) & 
-          .AND. icb(il)+1<=inb(il)) THEN
-        cbmf0(il) = cbmf0(il) + sig(il, k)*w0(il,k)*rhodp(il,k)
-      END IF
-    END DO
-  END DO
-
-  ! -------------------------------------------------------------
-  ! jyg1
-  ! --  Calculate adiabatic ascent top pressure (ptop)
-  ! -------------------------------------------------------------
-
-
-  ! c 1. Start at first level where precipitations form
-  DO il = 1, ncum
-    pzero(il) = plcl(il) - pbcrit
-  END DO
-
-  ! c 2. Add offset
-  DO il = 1, ncum
-    pzero(il) = pzero(il) - pbmxup
-  END DO
-  DO il = 1, ncum
-    ptop2old(il) = ptop2(il)
-  END DO
-
-  DO il = 1, ncum
-    ! CR:c est quoi ce 300??
-    p1(il) = pzero(il) - 300.
-  END DO
-
-  ! compute asupmax=abs(supmax) up to lnm+1
-
-  DO il = 1, ncum
-    ok(il) = .TRUE.
-    nsupmax(il) = inb(il)
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. supmax(il,i)<0 .AND. ok(il)) THEN
-          nsupmax(il) = i
-          ok(il) = .FALSE.
-        END IF ! end IF (P(i) ...  )
-      END IF ! end IF (icb+1 le i le inb)
-    END DO
-  END DO
-
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 2.'
-  DO i = 1, nl
-    DO il = 1, ncum
-      asupmax(il, i) = abs(supmax(il,i))
-    END DO
-  END DO
-
-
-  DO il = 1, ncum
-    asupmaxmin(il) = 10.
-    pmin(il) = 100.
-    ! IM ??
-    asupmax0(il) = 0.
-  END DO
-
-  ! c 3.  Compute in which level is Pzero
-
-  ! IM bug      i0 = 18
-  DO il = 1, ncum
-    i0(il) = nl
-  END DO
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
-          IF (pzero(il)>p(il,i) .AND. pzero(il)<p(il,i-1)) THEN
-            i0(il) = i
-          END IF
-        END IF
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 3.'
-
-  ! c 4.  Compute asupmax at Pzero
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
-          asupmax0(il) = ((pzero(il)-p(il,i0(il)-1))*asupmax(il,i0(il))- &
-            (pzero(il)-p(il,i0(il)))*asupmax(il,i0(il)-1))/(p(il,i0(il))-p(il,i0(il)-1))
-        END IF
-      END IF
-    END DO
-  END DO
-
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (p(il,i)==pzero(il)) THEN
-        asupmax(i, il) = asupmax0(il)
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 4.'
-
-  ! c 5. Compute asupmaxmin, minimum of asupmax
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
-          IF (asupmax(il,i)<asupmaxmin(il)) THEN
-            asupmaxmin(il) = asupmax(il, i)
-            pmin(il) = p(il, i)
-          END IF
-        END IF
-      END IF
-    END DO
-  END DO
-
-  DO il = 1, ncum
-    ! IM
-    IF (prt_level>=20) THEN
-      PRINT *, 'cv3p2_closure il asupmax0 asupmaxmin', il, asupmax0(il), &
-        asupmaxmin(il), pzero(il), pmin(il)
-    END IF
-    IF (asupmax0(il)<asupmaxmin(il)) THEN
-      asupmaxmin(il) = asupmax0(il)
-      pmin(il) = pzero(il)
-    END IF
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 5.'
-
-
-  ! Compute Supmax at Pzero
-
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i>icb(il) .AND. i<=inb(il)) THEN
-        IF (p(il,i)<=pzero(il)) THEN
-          supmax0(il) = ((p(il,i)-pzero(il))*asupmax(il,i-1)- &
-            (p(il,i-1)-pzero(il))*asupmax(il,i))/(p(il,i)-p(il,i-1))
-          GO TO 425
-        END IF ! end IF (P(i) ... )
-      END IF ! end IF (icb+1 le i le inb)
-    END DO
-  END DO
-
-425 CONTINUE
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 425.'
-
-  ! c 6. Calculate ptop2
-
-  DO il = 1, ncum
-    IF (asupmaxmin(il)<supcrit1) THEN
-      ptop2(il) = pmin(il)
-    END IF
-
-    IF (asupmaxmin(il)>supcrit1 .AND. asupmaxmin(il)<supcrit2) THEN
-      ptop2(il) = ptop2old(il)
-    END IF
-
-    IF (asupmaxmin(il)>supcrit2) THEN
-      ptop2(il) = ph(il, inb(il))
-    END IF
-  END DO
-
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 6.'
-
-  ! c 7. Compute multiplying factor for adiabatic updraught mass flux
-
-
-  IF (ok_inhib) THEN
-
-    DO i = 1, nl
-      DO il = 1, ncum
-        IF (i<=nl) THEN
-          coefmix(il, i) = (min(ptop2(il),ph(il,i))-ph(il,i))/(ph(il,i+1)-ph(il,i))
-          coefmix(il, i) = min(coefmix(il,i), 1.)
-        END IF
-      END DO
-    END DO
-
-
-  ELSE ! when inhibition is not taken into account, coefmix=1
-
-
-
-    DO i = 1, nl
-      DO il = 1, ncum
-        IF (i<=nl) THEN
-          coefmix(il, i) = 1.
-        END IF
-      END DO
-    END DO
-
-  END IF ! ok_inhib
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 7.'
-  ! -------------------------------------------------------------------
-  ! -------------------------------------------------------------------
-
-
-  ! jyg2
-
-  ! ==========================================================================
-
-
-  ! -------------------------------------------------------------
-  ! -- Calculate convective inhibition (CIN)
-  ! -------------------------------------------------------------
-
-  ! do i=1,nloc
-  ! print*,'avant cine p',pbase(i),plcl(i)
-  ! enddo
-  ! do j=1,nd
-  ! do i=1,nloc
-  ! print*,'avant cine t',tv(i),tvp(i)
-  ! enddo
-  ! enddo
-  CALL cv3_cine(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, tvp, cina, &
-    cinb, plfc)
-
-  DO il = 1, ncum
-    cin(il) = cina(il) + cinb(il)
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure after cv3_cine: cina, cinb, cin ', &
-                              cina(igout), cinb(igout), cin(igout)
-  ! -------------------------------------------------------------
-  ! --Update buoyancies to account for Ale
-  ! -------------------------------------------------------------
-
-  CALL cv3_buoy(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, ale, cin, tv, &
-    tvp, buoy)
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure after cv3_buoy'
-
-  ! -------------------------------------------------------------
-  ! -- Calculate convective available potential energy (cape),
-  ! -- vertical velocity (w), fractional area covered by
-  ! -- undilute updraft (sig), and updraft mass flux (m)
-  ! -------------------------------------------------------------
-
-  DO il = 1, ncum
-    cape(il) = 0.0
-    dtminmax(il) = -100.
-  END DO
-
-  ! compute dtmin (minimum buoyancy between ICB and given level k):
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      dtmin(il, k) = 100.0
-    END DO
-  END DO
-
-  DO k = 1, nl
-    DO j = minorig, nl
-      DO il = 1, ncum
-        IF ((k>=(icb(il)+1)) .AND. (k<=inb(il)) .AND. (j>=icb(il)) &
-                             .AND. (j<=(k-1))) THEN
-          dtmin(il, k) = amin1(dtmin(il,k), buoy(il,j))
-        END IF
-      END DO
-    END DO
-  END DO
-!jyg<
-!  Store maximum of dtmin
-!  C est pas terrible d avoir ce test sur Ale+Cin encore une fois ici.
-!                      A REVOIR !
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (k>=(icb(il)+1) .AND. k<=inb(il) .AND. ale(il)+cin(il)>0.) THEN
-        dtminmax(il) = max(dtmin(il,k), dtminmax(il))
-      ENDIF
-    END DO
-  END DO
-!
-!    prevent convection when ale+cin <= 0
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (k>=(icb(il)+1) .AND. k<=inb(il)) THEN
-        dtmin(il,k) = min(dtmin(il,k), dtminmax(il))
-      ENDIF
-    END DO
-  END DO
-!>jyg
-!
-  IF (prt_level >= 20) THEN
-    print *,'cv3p2_closure: dtmin ', (k, dtmin(igout,k), k=1,nl)
-    print *,'cv3p2_closure: dtminmax ', dtminmax(igout)
-  ENDIF
-!
-  ! the interval on which cape is computed starts at pbase :
-
-  DO k = 1, nl
-    DO il = 1, ncum
-
-      IF ((k>=(icb(il)+1)) .AND. (k<=inb(il))) THEN
-
-        IF (iflag_mix_adiab.eq.1) THEN
-!CR:computation of cape from LCL: keep flag or to modify in all cases?
-        deltap = min(plcl(il), ph(il,k-1)) - min(plcl(il), ph(il,k))
-        ELSE
-        deltap = min(pbase(il), ph(il,k-1)) - min(pbase(il), ph(il,k))
-        ENDIF
-        cape(il) = cape(il) + rrd*buoy(il, k-1)*deltap/p(il, k-1)
-        cape(il) = amax1(0.0, cape(il))
-        sigold(il, k) = sig(il, k)
-
-
-        ! jyg       Coefficient coefmix limits convection to levels where a
-        ! sufficient
-        ! fraction of mixed draughts are ascending.
-        siglim(il, k) = coefmix(il, k)*alpha1*dtmin(il, k)*abs(dtmin(il,k))
-        siglim(il, k) = amax1(siglim(il,k), 0.0)
-        siglim(il, k) = amin1(siglim(il,k), 0.01)
-        ! c         fac=AMIN1(((dtcrit-dtmin(il,k))/dtcrit),1.0)
-        fac = 1.
-        wlim(il, k) = fac*sqrt(cape(il))
-        amu = siglim(il, k)*wlim(il, k)
-!!        rhodp(il,k) = 0.007*p(il, k)*(ph(il,k)-ph(il,k+1))/tv(il, k) !cor jyg : computed earlier
-        mlim(il, k) = amu*rhodp(il,k)
-        ! print*, 'siglim ', k,siglim(1,k)
-      END IF
-
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 600'
-
-  DO il = 1, ncum
-    ! IM beg
-    IF (prt_level>=20) THEN
-      PRINT *, 'cv3p2_closure il icb mlim ph ph+1 ph+2', il, icb(il), &
-        mlim(il, icb(il)+1), ph(il, icb(il)), ph(il, icb(il)+1), &
-        ph(il, icb(il)+2)
-    END IF
-
-    IF (icb(il)+1<=inb(il)) THEN
-      ! IM end
-      mlim(il, icb(il)) = 0.5*mlim(il,icb(il)+1)*(ph(il,icb(il))-ph(il,icb(il)+1))/ &
-                                               (ph(il,icb(il)+1)-ph(il,icb(il)+2))
-      ! IM beg
-    END IF !(icb(il.le.inb(il))) then
-    ! IM end
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres 700'
-
-  ! 
-  ! ------------------------------------------------------------------------
-  ! c     Compute Cloud base mass flux given by Cape closure (cbmflim = cbmf of 
-  ! c     elementary systems), cbmf given by Alp closure (cbmfalp), cbmf given by Alp 
-  ! c     closure with an upper bound imposed (cbmfalpb) and cbmf resulting from
-  ! c     time integration (cbmflast).
-  ! ------------------------------------------------------------------------
-
-  DO il = 1, ncum
-    cbmflim(il) = 0.
-    cbmfalp(il) = 0.
-    cbmfalpb(il) = 0.
-    cbmflast(il) = 0.
-  END DO
-
-  ! c 1. Compute cloud base mass flux of elementary system (Cbmflim)
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      ! old       IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
-      ! IM        IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
-      IF (k>=icb(il) .AND. k<=inb(il) & !cor jyg
-          .AND. icb(il)+1<=inb(il)) THEN !cor jyg
-        cbmflim(il) = cbmflim(il) + mlim(il, k)
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure after cbmflim: cbmflim ', cbmflim(igout)
-
-  ! 1.5 Compute cloud base mass flux given by Alp closure (Cbmfalp), maximum
-  !     allowed mass flux (Cbmfmax) and bounded mass flux (Cbmfalpb)
-  !     Cbmfalpb is set to zero if Cbmflim (the mass flux of elementary cloud)
-  !     is exceedingly small.
-
-  DO il = 1, ncum
-    wb2(il) = sqrt(2.*max(ale(il)+cin(il),0.))
-  END DO
-
-  DO il = 1, ncum
-    IF (plfc(il)<100.) THEN
-      ! This is an irealistic value for plfc => no calculation of wbeff
-      wbeff(il) = 100.1
-    ELSE
-      ! Calculate wbeff
-      IF (NINT(flag_wb)==0) THEN
-        wbeff(il) = wbmax
-      ELSE IF (NINT(flag_wb)==1) THEN
-        wbeff(il) = wbmax/(1.+500./(ph(il,1)-plfc(il)))
-      ELSE IF (NINT(flag_wb)==2) THEN
-        wbeff(il) = wbmax*(0.01*(ph(il,1)-plfc(il)))**2
-      END IF
-    END IF
-  END DO
-
-!CR:Compute k at plfc
-  DO il=1,ncum
-           klfc(il)=nl
-  ENDDO
-  DO k=1,nl
-     DO il=1,ncum
-        if ((plfc(il).lt.ph(il,k)).and.(plfc(il).ge.ph(il,k+1))) then
-           klfc(il)=k
-        endif
-     ENDDO
-  ENDDO
-!RC
-
-  DO il = 1, ncum
-    ! jyg    Modification du coef de wb*wb pour conformite avec papier Wake
-    ! c       cbmfalp(il) = alp2(il)/(0.5*wb*wb-Cin(il))
-    cbmfalp(il) = alp2(il)/(2.*wbeff(il)*wbeff(il)-cin(il))
-!CR: Add large-scale component to the mass-flux
-!encore connu sous le nom "Experience du tube de dentifrice"
-    if ((coef_clos_ls.gt.0.).and.(plfc(il).gt.0.)) then 
-       cbmfalp(il) = cbmfalp(il) - coef_clos_ls*min(0.,1./RG*omega(il,klfc(il)))
-    endif
-!RC
-    IF (cbmfalp(il)==0 .AND. alp2(il)/=0.) THEN
-      WRITE (lunout, *) 'cv3p2_closure cbmfalp=0 and alp NE 0 il alp2 alp cin ' , &
-                         il, alp2(il), alp(il), cin(il)
-      abort_message = ''
-      CALL abort_physic(modname, abort_message, 1)
-    END IF
-    cbmfmax(il) = sigmax*wb2(il)*100.*p(il, icb(il))/(rrd*tv(il,icb(il)))
-  END DO
-
-!jyg<
-  IF (OK_intermittent) THEN
-    DO il = 1, ncum
-      IF (cbmflim(il)>1.E-6) THEN
-        cbmfalpb(il) = min(cbmfalp(il), (cbmfmax(il)-beta*cbmf0(il))/(1.-beta))
-        ! print*,'cbmfalpb',cbmfalpb(il),cbmfmax(il)
-      END IF
-    END DO
-  ELSE
-!>jyg
-  DO il = 1, ncum
-    IF (cbmflim(il)>1.E-6) THEN
-      ! ATTENTION TEST CR
-      ! if (cbmfmax(il).lt.1.e-12) then
-      cbmfalpb(il) = min(cbmfalp(il), cbmfmax(il))
-      ! else
-      ! cbmfalpb(il) = cbmfalp(il)
-      ! endif
-      ! print*,'cbmfalpb',cbmfalp(il),cbmfmax(il)
-    END IF
-  END DO
-  ENDIF  !(OK_intermittent)
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres cbmfalpb: cbmfalpb ',cbmfalpb(igout)
-
-  ! c 2. Compute coefficient and apply correction
-
-  DO il = 1, ncum
-    coef(il) = (cbmfalpb(il)+1.E-10)/(cbmflim(il)+1.E-10)
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres coef_plantePLUS'
-
-     DO k = 1, nl
-       DO il = 1, ncum
-         IF (k>=icb(il)+1 .AND. k<=inb(il)) THEN
-           amu = beta*sig(il, k)*w0(il, k) + (1.-beta)*coef(il)*siglim(il, k)*wlim(il, k)
-           w0(il, k) = wlim(il, k)
-           w0(il, k) = max(w0(il,k), 1.E-10)
-           sig(il, k) = amu/w0(il, k)
-           sig(il, k) = min(sig(il,k), 1.)
-           ! c         amu = 0.5*(SIG(il,k)+sigold(il,k))*W0(il,k)
-           !jyg m(il, k) = amu*0.007*p(il, k)*(ph(il,k)-ph(il,k+1))/tv(il, k)
-           m(il, k) = amu*rhodp(il,k)
-         END IF
-       END DO
-     END DO
-  ! jyg2
-  DO il = 1, ncum
-    w0(il, icb(il)) = 0.5*w0(il, icb(il)+1)
-    m(il, icb(il)) = 0.5*m(il, icb(il)+1)*(ph(il,icb(il))-ph(il,icb(il)+1))/ &
-                                         (ph(il,icb(il)+1)-ph(il,icb(il)+2))
-    sig(il, icb(il)) = sig(il, icb(il)+1)
-    sig(il, icb(il)-1) = sig(il, icb(il))
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres w0_sig_M: w0, sig ', &
-                         (k,w0(igout,k),sig(igout,k), k=icb(igout),inb(igout))
-
-!CR: new erosion of adiabatic ascent: modification of m
-!computation of the sum of ascending fluxes 
-  IF (iflag_mix_adiab.eq.1) THEN
-
-!Verification sum(me)=sum(m)
-  DO k = 1,nd
-    DO il = 1, ncum
-       md(il,k)=0.
-       med(il,k)=0.
-    ENDDO
-  ENDDO
-
-  DO k = nl,1,-1
-    DO il = 1, ncum
-           md(il,k)=md(il,k+1)+m(il,k+1)
-    ENDDO
-  ENDDO
-
-  DO k = nl,1,-1
-    DO il = 1, ncum
-        IF ((k>=(icb(il))) .AND. (k<=inb(il))) THEN
-           mad(il,k)=mad(il,k+1)+m(il,k+1)
-        ENDIF
-!        print*,"mad",il,k,mad(il,k)
-    ENDDO
-  ENDDO
-
-!CR: erosion of each adiabatic ascent during its ascent
-
-!Computation of erosion coefficient beta_coef
-  DO k = 1, nl
-    DO il = 1, ncum
-       IF ((k>=(icb(il)+1)) .AND. (k<=inb(il)) .AND. (mlim(il,k).gt.0.)) THEN     
-!          print*,"beta_coef",il,k,icb(il),inb(il),buoy(il,k),tv(il,k),wlim(il,k),wlim(il,k+1)
-          beta_coef(il,k)=RG*coef_peel*buoy(il,k)/tv(il,k)/((wlim(il,k)+wlim(il,k+1))/2.)**2
-       ELSE
-          beta_coef(il,k)=0.
-       ENDIF
-    ENDDO
-  ENDDO
-
-!  print*,"apres beta_coef"
-
-  DO k = 1, nl
-    DO il = 1, ncum
-
-      IF ((k>=(icb(il)+1)) .AND. (k<=inb(il))) THEN
-
-!        print*,"dz",il,k,tv(il, k-1)
-        dz = (ph(il,k-1)-ph(il,k))/(p(il, k-1)/(rrd*tv(il, k-1))*RG)
-        betalim(il,k)=betalim(il,k-1)*exp(-1.*beta_coef(il,k-1)*dz)
-!        betalim(il,k)=betalim(il,k-1)*exp(-RG*coef_peel*buoy(il,k-1)/tv(il,k-1)/5.**2*dz)
-!        print*,"me",il,k,mlim(il,k),buoy(il,k),wlim(il,k),mad(il,k)
-        dz = (ph(il,k)-ph(il,k+1))/(p(il, k)/(rrd*tv(il, k))*RG)
-!        me(il,k)=betalim(il,k)*(m(il,k)+RG*coef_peel*buoy(il,k)/tv(il,k)/((wlim(il,k)+wlim(il,k+1))/2.)**2*dz*mad(il,k))
-        me(il,k)=betalim(il,k)*(m(il,k)+beta_coef(il,k)*dz*mad(il,k))
-!        print*,"B/w2",il,k,RG*coef_peel*buoy(il,k)/tv(il,k)/((wlim(il,k)+wlim(il,k+1))/2.)**2*dz    
-      
-      END IF
-        
-!Modification of m
-      m(il,k)=me(il,k) 
-    END DO
-  END DO
- 
-!  DO il = 1, ncum
-!     dz = (ph(il,icb(il))-ph(il,icb(il)+1))/(p(il, icb(il))/(rrd*tv(il, icb(il)))*RG)
-!     m(il,icb(il))=m(il,icb(il))+RG*coef_peel*buoy(il,icb(il))/tv(il,icb(il)) &
-!                  /((wlim(il,icb(il))+wlim(il,icb(il)+1))/2.)**2*dz*mad(il,icb(il))
-!     print*,"wlim(icb)",icb(il),wlim(il,icb(il)),m(il,icb(il))
-!  ENDDO
-
-!Verification sum(me)=sum(m)
-  DO k = nl,1,-1
-    DO il = 1, ncum
-           med(il,k)=med(il,k+1)+m(il,k+1)
-!           print*,"somme(me),somme(m)",il,k,icb(il),med(il,k),md(il,k),me(il,k),m(il,k),wlim(il,k)
-    ENDDO
-  ENDDO
-
-
-  ENDIF !(iflag_mix_adiab)
-!RC
-
-  ! c 3. Compute final cloud base mass flux;
-  ! c    set iflag to 3 if cloud base mass flux is exceedingly small and is 
-  ! c     decreasing (i.e. if the final mass flux (cbmflast) is greater than 
-  ! c     the target mass flux (cbmfalpb)).
-  ! c    If(ok_convstop): set iflag to 4 if no positive buoyancy has been met
-
-!jyg  DO il = 1, ncum
-!jyg    cbmflast(il) = 0.
-!jyg  END DO
-
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (k>=icb(il) .AND. k<=inb(il)) THEN
-          !IMpropo??      IF ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) THEN
-        cbmflast(il) = cbmflast(il) + m(il, k)
-      END IF
-    END DO
-  END DO
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure apres cbmflast: cbmflast ',cbmflast(igout)
-
-  DO il = 1, ncum
-    IF (cbmflast(il)<1.E-6 .AND. cbmflast(il)>=cbmfalpb(il)) THEN
-      iflag(il) = 3
-    END IF
-  END DO
-
-!jyg<
-  IF (ok_convstop) THEN
-    DO il = 1, ncum
-      IF (dtminmax(il) .LE. 0.) THEN
-        iflag(il) = 4
-      END IF
-    END DO
-  ELSE
-!>jyg
-  DO k = 1, nl
-    DO il = 1, ncum
-      IF (iflag(il)>=3) THEN
-        m(il, k) = 0.
-        sig(il, k) = 0.
-        w0(il, k) = 0.
-      END IF
-    END DO
-  END DO
-  ENDIF ! (ok_convstop)
-!
-  IF (prt_level >= 10) THEN
-   print *,'cv3p2_closure: iflag ',iflag(igout)
-  ENDIF
-!
-
-  ! c 4. Introduce a correcting factor for coef, in order to obtain an
-  ! effective
-  ! c    sigdz larger in the present case (using cv3p2_closure) than in the
-  ! old
-  ! c    closure (using cv3_closure).
-  IF (1==0) THEN
-    DO il = 1, ncum
-      ! c      coef(il) = 2.*coef(il)
-      coef(il) = 5.*coef(il)
-    END DO
-    ! version CVS du ..2008
-  ELSE
-    IF (iflag_cvl_sigd==0) THEN
-      ! test pour verifier qu on fait la meme chose qu avant: sid constant
-      coef(1:ncum) = 1.
-    ELSE
-      coef(1:ncum) = min(2.*coef(1:ncum), 5.)
-      coef(1:ncum) = max(2.*coef(1:ncum), 0.2)
-    END IF
-  END IF
-
-  IF (prt_level>=20) PRINT *, 'cv3p2_closure FIN'
-  RETURN
-END SUBROUTINE cv3p2_closure
-
-
+link ../phylmd/cv3p2_closure.F90
Index: LMDZ6/trunk/libf/phylmdiso/cv3param.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cv3param.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cv3param.h	(revision 3940)
@@ -1,44 +1,1 @@
-!------------------------------------------------------------
-! Parameters for convectL, iflag_con=3:
-! (includes - microphysical parameters,
-!			- parameters that control the rate of approach
-!               to quasi-equilibrium)
-!			- noff & minorig (previously in input of convect1)
-!------------------------------------------------------------
-
-      integer flag_epKEorig
-      real flag_wb
-      integer cv_flag_feed
-      integer noff, minorig, nl, nlp, nlm
-      real sigdz, spfac
-      real pbcrit, ptcrit
-      real elcrit, tlcrit
-      real coef_peel
-      real omtrain
-      real dtovsh, dpbase, dttrig
-      real dtcrit, tau, beta, alpha, alpha1
-      real T_top_max
-      real tau_stop, noconv_stop
-      real wbmax
-      real delta
-      real betad
-      real ejectliq
-      real ejectice
-
-      COMMON /cv3param/ sigdz, spfac &
-                      ,pbcrit, ptcrit &
-                      ,elcrit, tlcrit &
-                      ,coef_peel &
-                      ,omtrain &
-                      ,dtovsh, dpbase, dttrig &
-                      ,dtcrit, tau, beta, alpha, alpha1 &
-                      ,T_top_max &
-                      ,tau_stop, noconv_stop &
-                      ,wbmax &
-                      ,delta, betad  &
-                      ,ejectliq, ejectice &
-                      ,flag_epKEorig &
-                      ,flag_wb, cv_flag_feed &
-                      ,noff, minorig, nl, nlp, nlm
-!$OMP THREADPRIVATE(/cv3param/)
-
+link ../phylmd/cv3param.h
Index: LMDZ6/trunk/libf/phylmdiso/cvflag.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvflag.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvflag.h	(revision 3940)
@@ -1,27 +1,1 @@
-!
-! $Header$
-!
-      logical cvflag_grav
-      logical cvflag_ice
-      logical ok_optim_yield
-      logical ok_entrain
-      logical ok_homo_tend
-      logical ok_convstop
-      logical ok_intermittent
-      logical cvflag_prec_eject
-      logical qsat_depends_on_qt
-      logical adiab_ascent_mass_flux_depends_on_ejectliq
-      logical keepbug_ice_frac
-      integer icvflag_Tpa
-
-      COMMON /cvflag/ icvflag_Tpa, &
-                      cvflag_grav, cvflag_ice, &
-                      ok_optim_yield, &
-                      ok_entrain, &
-                      ok_homo_tend, &
-                      ok_convstop, ok_intermittent, &
-                      cvflag_prec_eject, &
-                      qsat_depends_on_qt, &
-                      adiab_ascent_mass_flux_depends_on_ejectliq, &
-                      keepbug_ice_frac
-!$OMP THREADPRIVATE(/cvflag/)
+link ../phylmd/cvflag.h
Index: LMDZ6/trunk/libf/phylmdiso/cvltr.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvltr.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvltr.F90	(revision 3940)
@@ -1,696 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE cvltr(pdtime, da, phi,phi2,d1a,dam, mpIN,epIN, &
-!!           sigd,sij,clw,elij,epmlmMm,eplaMm,              &   !RL
-           sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,    &     !RL
-           pmflxrIN,pmflxsIN,ev,te,wdtrainA,wdtrainM,     &
-           paprs,it,tr,upd,dnd,inb,icb,                   &
-           dtrcv,trsptd,dtrSscav,dtrsat,dtrUscav,qDi,qPr, &
-           qPa,qMel,qTrdi,dtrcvMA,Mint,                   &
-           zmfd1a,zmfphi2,zmfdam)
-  USE IOIPSL 
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr,tname
-  IMPLICIT NONE 
-!=====================================================================
-! Objet : convection des traceurs / KE
-! Auteurs: M-A Filiberti and J-Y Grandpeix
-! modifiee par R Pilon : lessivage des traceurs / KE
-!=====================================================================
-
-  include "YOMCST.h"
-  include "YOECUMF.h"
-  include "conema3.h"
-
-! Entree
-  REAL,INTENT(IN)                           :: pdtime
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: da
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi
-! RomP
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: d1a,dam ! matrices pour simplifier
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2    ! l'ecriture des tendances
-!
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: mpIN
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)    :: paprs  ! pression aux 1/2 couches (bas en haut)
-!  REAL,DIMENSION(klon,klev),INTENT(IN)    :: pplay ! pression aux 1/2 couches (bas en haut)
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr     ! q de traceur (bas en haut)
-  INTEGER,INTENT(IN)                        :: it 
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: upd   ! saturated updraft mass flux
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: dnd   ! saturated downdraft mass flux
-!
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainA   ! masses precipitantes de l'asc adiab
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainM   ! masses precipitantes des melanges
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pmflxrIN   ! vprecip: eau
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pmflxsIN   ! vprecip: neige
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: ev         ! evaporation cv30_routine
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: epIN
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: te 
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij        ! fraction dair de lenv
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd  ! weights of the layers feeding convection
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij       ! contenu en eau condensée spécifique/conc deau condensée massique
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm    ! eau condensee precipitee dans mel masse dair sat
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: eplaMm    ! eau condensee precipitee dans aa masse dair sat
-
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw        ! contenu en eau condensée dans lasc adiab
-  REAL,DIMENSION(klon),INTENT(IN)           :: sigd
-  INTEGER,DIMENSION(klon),INTENT(IN)        :: icb,inb
-! Sortie
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrcv     ! tendance totale (bas en haut)
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrcvMA ! M-A Filiberti
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: trsptd    ! tendance du transport 
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrSscav  ! tendance du lessivage courant sat
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrsat    ! tendance trsp+sat scav
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrUscav  ! tendance du lessivage courant unsat
-!
-! Variables locales
-  INTEGER                           :: i,j,k
-  REAL,DIMENSION(klon,klev)         :: dxpres   ! difference de pression entre niveau (j+1) et (j)
-  REAL                              :: pdtimeRG ! pas de temps * gravite
-! variables pour les courants satures
-  REAL,DIMENSION(klon,klev,klev)    :: zmd
-  REAL,DIMENSION(klon,klev,klev)    :: za
-  REAL,DIMENSION(klon,klev,nbtr)    :: zmfd,zmfa
-  REAL,DIMENSION(klon,klev,nbtr)    :: zmfp,zmfu
-  REAL,DIMENSION(klon,nbtr)         :: qfeed     ! tracer concentration feeding convection
-
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfd1a
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfdam
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfphi2
-
-! RomP ! les variables sont nettoyees des valeurs aberrantes
-  REAL,DIMENSION(klon,klev)         :: Pa, Pm  ! pluie AA et mélanges, var temporaire
-  REAL,DIMENSION(klon,klev)         :: pmflxs,pmflxr ! pmflxrIN,pmflxsIN sans valeur aberante
-  REAL,DIMENSION(klon,klev)         :: mp            ! flux de masse
-  REAL,DIMENSION(klon,klev)         :: ep            ! fraction d'eau convertie en precipitation 
-  REAL,DIMENSION(klon,klev)         :: evap          ! evaporation : variable temporaire 
-  REAL,DIMENSION(klon,klev)         :: rho    !environmental density
-
-  REAL,DIMENSION(klon,klev)         :: kappa ! denominateur du au calcul de la matrice 
-                                             ! pour obtenir qd et qp
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qTrdi ! traceurs descente air insature transport MA
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qDi  ! traceurs descente insaturees
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qPr  ! traceurs colonne precipitante
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qPa  ! traceurs dans les precip issues lasc. adiab.
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qMel ! traceurs dans les precip issues des melanges
-  REAL,DIMENSION(klon,klev,nbtr)                :: qMeltmp ! variable temporaire 
-  REAL,DIMENSION(klon,klev,nbtr)                :: qpmMint
-  REAL,DIMENSION(klon,klev),INTENT(OUT)         :: Mint
-! tendances
-  REAL                              :: tdcvMA           ! terme de transport de traceur (schema Marie Angele)
-  REAL                              :: trsptrac         ! terme de transport de traceur par l'air
-  REAL                              :: scavtrac         ! terme de lessivage courant sature
-  REAL                              :: uscavtrac        ! terme de lessivage courant insature
-! impaction
-!!!       Correction apres discussion Romain P. / Olivier B. 
-!!!  REAL,PARAMETER                    :: rdrop=2.5e-3     ! rayon des gouttes d'eau
-  REAL,PARAMETER                    :: rdrop=1.e-3     ! rayon des gouttes d'eau 
-!!!
-  REAL,DIMENSION(klon,klev)         :: imp              ! coefficient d'impaction
-! parametres lessivage
-  REAL                    :: ccntrAA_coef        ! \alpha_a : fract aerosols de l'AA convertis en CCN
-  REAL                    :: ccntrENV_coef       ! \beta_m  : fract aerosols de l'env convertis en CCN
-  REAL                    :: coefcoli            ! coefficient de collision des gouttes sur les aerosols
-!
-  LOGICAL,DIMENSION(klon,klev) :: NO_precip
-!  LOGICAL                      :: scavON
-! var tmp tests
-  REAL                           :: conserv
-  real                           :: conservMA
-
-! coefficient lessivage
-   ccntrAA_coef     = 0.
-   ccntrENV_coef    = 0.
-   coefcoli         = 0.
-
-!$OMP MASTER
-  call getin('ccntrAA_coef',ccntrAA_coef)
-  call getin('ccntrENV_coef',ccntrENV_coef)
-  call getin('coefcoli',coefcoli)
-!$OMP END MASTER
-!$OMP BARRIER
-  print*,'cvltr coef lessivage convectif', ccntrAA_coef,ccntrENV_coef,coefcoli
-
-!  scavON=.TRUE.
-!  if(scavON) then
-!   ccntrAA_coef     = 1.
-!   ccntrENV_coef    = 1.
-!   coefcoli         = 1.
-!  else
-!   ccntrAA_coef     = 0.
-!   ccntrENV_coef    = 0.
-!   coefcoli         = 0.
-!  endif
-
-! ======================================================
-! calcul de l'impaction
-! ======================================================
-!initialisation
-  do j=1,klev
-   do i=1,klon
-     imp(i,j)=0.
-   enddo
-  enddo
-! impaction sur la surface de la colonne de la descente insaturee
-! On prend la moyenne des precip entre le niveau i+1 et i
-! I=3/4* (P(1+1)+P(i))/2 / (sigd*r*rho_l)
-!  1000kg/m3= densité de l'eau
-! 0.75e-3 = 3/4 /1000
-! Par la suite, I est tout le temps multiplié par sig_d pour avoir l'impaction sur la surface de la maille
-! on le néglige ici pour simplifier le code
-  do j=1,klev-1
-   do i=1,klon
-    imp(i,j) = coefcoli*0.75e-3/rdrop *&
-             0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
-!    rho(i,j)=pplay(i,j)/(rd*te(i,j))
-   enddo
-  enddo
-!
-! initialisation pour flux de traceurs, td et autre
-   trsptrac = 0.
-   scavtrac = 0.
-   uscavtrac = 0.
-   qfeed(:,it) = 0.              !RL
-  DO j=1,klev
-   DO i=1,klon
-    zmfd(i,j,it)=0.
-    zmfa(i,j,it)=0.
-    zmfu(i,j,it)=0.
-    zmfp(i,j,it)=0.
-    zmfphi2(i,j,it)=0.
-    zmfd1a(i,j,it)=0.
-    zmfdam(i,j,it)=0.
-    qDi(i,j,it)=0.
-    qPr(i,j,it)=0.
-    qPa(i,j,it)=0.
-    qMel(i,j,it)=0.
-    qMeltmp(i,j,it)=0.
-    qTrdi(i,j,it)=0.
-    kappa(i,j)=0.
-    trsptd(i,j,it)=0.
-    dtrsat(i,j,it)=0.
-    dtrSscav(i,j,it)=0.
-    dtrUscav(i,j,it)=0.
-    dtrcv(i,j,it)=0.
-    dtrcvMA(i,j,it)=0.
-    evap(i,j)=0.
-    dxpres(i,j)=0.
-    qpmMint(i,j,it)=0.
-    Mint(i,j)=0.
-   END DO
-  END DO
-
-! suppression des valeurs très faibles (~1e-320)
-! multiplication de levaporation pour lavoir par unite de temps
-! et par unite de surface de la maille
-! -> cv30_unsat : evap : masse evaporee/s/(m2 de la descente)
-  DO j=1,klev
-   DO i=1,klon
-    if(ev(i,j).lt.1.e-16) then
-     evap(i,j)=0.
-    else
-     evap(i,j)=ev(i,j)*sigd(i)
-    endif
-   END DO
-  END DO
-
-  DO j=1,klev
-   DO i=1,klon
-   if(j.lt.klev) then
-    if(epIN(i,j).lt.1.e-32) then
-     ep(i,j)=0.
-    else
-     ep(i,j)=epIN(i,j)
-    endif
-   else
-    ep(i,j)=epmax
-   endif
-    if(mpIN(i,j).lt.1.e-32) then
-     mp(i,j)=0.
-    else
-     mp(i,j)=mpIN(i,j)
-    endif
-    if(pmflxsIN(i,j).lt.1.e-32) then
-     pmflxs(i,j)=0.
-    else
-     pmflxs(i,j)=pmflxsIN(i,j)
-    endif
-    if(pmflxrIN(i,j).lt.1.e-32) then
-     pmflxr(i,j)=0.
-    else
-     pmflxr(i,j)=pmflxrIN(i,j)
-    endif
-    if(wdtrainA(i,j).lt.1.e-32) then
-     Pa(i,j)=0.
-    else
-     Pa(i,j)=wdtrainA(i,j)
-    endif
-    if(wdtrainM(i,j).lt.1.e-32) then
-     Pm(i,j)=0.
-    else
-     Pm(i,j)=wdtrainM(i,j)
-    endif
-   END DO
-  END DO
-
-!==========================================
-  DO j = klev-1,1,-1
-   DO i = 1,klon
-     NO_precip(i,j) = (pmflxr(i,j+1)+pmflxs(i,j+1)).lt.1.e-10&
-                    .and.Pa(i,j).lt.1.e-10.and.Pm(i,j).lt.1.e-10
-   END DO
-  END DO
-
-! =========================================
-! calcul des tendances liees au downdraft
-! =========================================
-!cdir collapse
-  DO k=1,klev
-   DO j=1,klev
-    DO i=1,klon
-     zmd(i,j,k)=0.
-     za (i,j,k)=0.
-    END DO
-   END DO
-  END DO
-! calcul de la matrice d echange
-! matrice de distribution de la masse entrainee en k
-! commmentaire RomP : mp > 0
-  DO k=1,klev-1
-     DO i=1,klon
-        zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1))   ! ~ mk(k)
-     END DO
-  END DO
-  DO k=2,klev
-     DO j=k-1,1,-1
-        DO i=1,klon
-           if(mp(i,j+1).gt.1.e-10) then
-              zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1)) !det ~ mk(j)=mk(j+1)*mp(i,j)/mp(i,j+1)
-           ENDif
-        END DO
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-           za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
-        END DO
-     END DO
-  END DO
-!!!!! quantite  de traceur dans la descente d'air insaturee  :   4 juin 2012
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-        if(mp(i,j+1).gt.1.e-10) then
-          qTrdi(i,j+1,it)=qTrdi(i,j+1,it)+(zmd(i,j+1,k)/mp(i,j+1))*tr(i,k,it)
-        else
-          qTrdi(i,j,it)=0.!tr(i,j,it)
-        endif
-        ENDDO
-     ENDDO
-  ENDDO
-!!!!!
-!
-! rajout du terme lie a l ascendance induite
-!
-  DO j=2,klev
-     DO i=1,klon
-        za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
-     END DO
-  END DO
-!
-! tendance courants insatures  ! sans lessivage ancien schema
-!
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfd(i,j,it)=zmfd(i,j,it)+za(i,j,k)*(tr(i,k,it)-tr(i,j,it))
-        END DO
-     END DO
-  END DO
-!
-! =========================================
-! calcul des tendances liees aux courants satures   j <-> z ; k <-> z'
-! =========================================
-!
-!RL
-!  Feeding concentrations
-  DO j=1,klev
-     DO i=1,klon
-        qfeed(i,it)=qfeed(i,it)+wght_cvfd(i,j)*tr(i,j,it)
-     END DO
-  END DO
-!RL
-!
-  DO j=1,klev
-     DO i=1,klon
-!RL
-!!        zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it))                     ! da
-        zmfa(i,j,it)=da(i,j)*(qfeed(i,it)-tr(i,j,it))                     ! da
-!RL
-     END DO
-  END DO
-!
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfp(i,j,it)=zmfp(i,j,it)+phi(i,j,k)*(tr(i,k,it)-tr(i,j,it))  ! phi
-        END DO
-     END DO
-  END DO
-! RomP ajout des matrices liees au lessivage
-  DO j=1,klev
-     DO i=1,klon
-        zmfd1a(i,j,it)=d1a(i,j)*tr(i,1,it)   ! da1
-        zmfdam(i,j,it)=dam(i,j)*tr(i,1,it)   ! dam
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-          zmfphi2(i,j,it)=zmfphi2(i,j,it)+phi2(i,j,k)*tr(i,k,it)  ! psi
-        END DO
-     END DO
-  END DO
-  DO j=1,klev-1
-     DO i=1,klon
-        zmfu(i,j,it)=max(0.,upd(i,j+1)+dnd(i,j+1))*(tr(i,j+1,it)-tr(i,j,it))
-     END DO
-  END DO
-  DO j=2,klev
-     DO i=1,klon
-        zmfu(i,j,it)=zmfu(i,j,it)+min(0.,upd(i,j)+dnd(i,j))*(tr(i,j,it)-tr(i,j-1,it))
-     END DO
-  END DO
-! ===================================================
-! calcul des tendances liees aux courants insatures
-! ===================================================
-!  pression  
-  DO k=1, klev
-     DO i=1, klon
-        dxpres(i,k)=paprs(i,k)-paprs(i,k+1)
-     ENDDO
-  ENDDO
-  pdtimeRG=pdtime*RG
-
-! q_pa et q_pm    traceurs issues des courants satures se retrouvant dans les precipitations
-  DO j=1,klev
-     DO i=1,klon
-        if(j.ge.icb(i).and.j.le.inb(i)) then
-          if(clw(i,j).gt.1.e-16) then
-           qPa(i,j,it)=ccntrAA_coef*tr(i,1,it)/clw(i,j)
-          else
-           qPa(i,j,it)=0.
-          endif
-        endif
-     END DO
-  END DO
-
-! calcul de q_pm en 2 parties :
-! 1) calcul de sa valeur pour un niveau z' donne
-! 2) integration sur la verticale sur z'
-     DO j=1,klev
-      DO k=1,j-1
-        DO i=1,klon
-        if(k.ge.icb(i).and.k.le.inb(i).and.& 
-           j.le.inb(i)) then
-            if(elij(i,k,j).gt.1.e-16) then
-             qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_coef*tr(i,1,it)&
-                         *(1.-sij(i,k,j))  +ccntrENV_coef&
-                         *tr(i,k,it)*sij(i,k,j)) / elij(i,k,j)
-            else
-             qMeltmp(i,j,it)=0.
-            endif
-          qpmMint(i,j,it)=qpmMint(i,j,it) + qMeltmp(i,j,it)*epmlmMm(i,j,k)
-          Mint(i,j)=Mint(i,j) + epmlmMm(i,j,k)
-        endif ! end if dans nuage
-        END DO
-     END DO
-  END DO
-
-     DO j=1,klev
-        DO i=1,klon
-          if(Mint(i,j).gt.1.e-16) then
-           qMel(i,j,it)=qpmMint(i,j,it)/Mint(i,j)
-          else
-           qMel(i,j,it)=0.
-          endif
-     END DO
-  END DO
-
-! calcul de q_d et q_p    traceurs de la descente precipitante 
-   DO j=klev-1,1,-1
-    DO i=1,klon
-     if(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then  ! detrainement
-       kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))&
-                + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-             
-     elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then! entrainement
-       if(j.eq.1) then
-        kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                 (-mp(i,2)-imp(i,j)/RG*dxpres(i,j))&
-                 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-       else
-        kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                 (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))&
-                 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-       endif
-      else
-        kappa(i,j)=1.
-      endif
-    ENDDO
-   ENDDO
-
-  DO j=klev-1,1,-1
-   DO i=1,klon
-    if (abs(kappa(i,j)).lt.1.e-25) then    !si denominateur nul (il peut y avoir des mp!=0)
-     kappa(i,j)=1.
-     if(j.eq.1) then
-       qDi(i,j,it)=qDi(i,j+1,it) !orig tr(i,j,it)   ! mp(1)=0 donc tout vient de la couche supérieure
-     elseif(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then
-       qDi(i,j,it)=qDi(i,j+1,it)
-     elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then! entrainement
-       qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
-     else  ! si  mp (i)=0 et mp(j+1)=0
-       qDi(i,j,it)=tr(i,j,it) ! orig 0.
-     endif 
-
-      if(NO_precip(i,j)) then
-       qPr(i,j,it)=0.
-      else
-       qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                   Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                   +imp(i,j)/RG*dxpres(i,j)*qDi(i,j,it))/&
-                  (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-      endif
-    else   !     denominateur non nul
-     kappa(i,j)=1./kappa(i,j)     
-! calcul de qd et qp
-!!jyg  (20130119) correction pour le sommet du nuage
-!!     if(j.ge.inb(i)) then       !au-dessus du nuage, sommet inclu
-     if(j.gt.inb(i)) then       !au-dessus du nuage
-       qDi(i,j,it)=tr(i,j,it)   ! pas de descente => environnement = descente insaturee
-       qPr(i,j,it)=0.
-
-!  vvv premiere couche du modele ou mp(1)=0  ! det tout le temps  vvv
-     elseif(j.eq.1) then 
-      if(mp(i,2).gt.1.e-10) then !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
-       if(NO_precip(i,j)) then !pas de precip en (i)
-        qDi(i,j,it)=qDi(i,j+1,it)
-        qPr(i,j,it)=0.
-       else
-        qDi(i,j,it)=kappa(i,j)*(&
-            (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-            (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-            (-mp(i,j+1)*qDi(i,j+1,it)))
-
-        qPr(i,j,it)=kappa(i,j)*(&
-            (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*&
-            ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-            +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j)))
-       endif
-
-      else !mp(2) nul -> plus de descente insaturee -> pluie agit sur environnement
-        qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
-         qPr(i,j,it)=0.
-        else
-         qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                   Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                   +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/&
-                  (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-        endif
-
-      endif  !mp(2) nul ou non
-
-! vvv  (j!=1.and.j.lt.inb(i))  en-dessous du sommet nuage   vvv
-     else 
-!------------------------------------------------------------- detrainement 
-      if(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then !mp(i,j).gt.1.e-10) then
-         if(NO_precip(i,j)) then 
-          qDi(i,j,it)=qDi(i,j+1,it)
-          qPr(i,j,it)=0.
-         else
-          qDi(i,j,it)=kappa(i,j)*(&
-            (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-            (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-            (-mp(i,j+1)*qDi(i,j+1,it)))
-!
-          qPr(i,j,it)=kappa(i,j)*(&
-            (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*&
-            ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-            +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j)))
-         endif !precip
-!------------------------------------------------------------- entrainement 
-      elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then 
-         if(NO_precip(i,j)) then
-          qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
-          qPr(i,j,it)=0.
-         else
-          qDi(i,j,it)=kappa(i,j)*(&
-            (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-            (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-            (-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it)))
-!
-          qPr(i,j,it)=kappa(i,j)*(&
-            (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))*&
-            ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-            +(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))*&
-            (imp(i,j)/RG*dxpres(i,j)))
-         endif !precip
-!------------------------------------------------------------- endif ! ent/det
-      else  !mp nul
-        qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
-         qPr(i,j,it)=0.
-        else
-         qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                   Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                   +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/&
-                  (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-        endif
-      endif ! mp nul ou non
-     endif ! condition sur j
-    endif ! kappa
-   ENDDO
-  ENDDO
-
-!! print test descente insaturee
-!  DO j=klev,1,-1
-!   DO i=1,klon
-!     if(it.eq.3) then
-!   write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') j,&
-!!         'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),&
-!          'zmfdam+zmfpsi',zmfdam(i,j,it)+zmfphi2(i,j,it),'qpmMint',qpmMint(i,j,it),&
-!          'Pm',Pm(i,j),'Mint',Mint(i,j),&
-!!          'zmfa',zmfa(i,j,it),'zmfp',zmfp(i,j,it),&
-!        'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),'zmfd1a',zmfd1a(i,j,it)
-!!          'Pa',Pa(i,j),'eplaMm',eplaMm(i,j)
-!!         'zmfd1a=da1*qa',zmfd1a(i,j,it),'Pa*qPa',wdtrainA(i,j)*qPa(i,j,it),'da1',d1a(i,j)
-!     endif
-!   ENDDO
-!  ENDDO
-
-
-! ===================================================
-! calcul final des tendances
-! ===================================================
-
-  DO k=klev-1,1,-1
-    DO i=1, klon
-! transport
-     tdcvMA=zmfd(i,k,it)+zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it)   ! double comptage des downdraft insatures
-     trsptrac=zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it)
-! lessivage courants satures
-     scavtrac=-ccntrAA_coef*zmfd1a(i,k,it)&
-               -zmfphi2(i,k,it)*ccntrENV_coef&
-               -zmfdam(i,k,it)*ccntrAA_coef
-! lessivage courants insatures
-   if(k.le.inb(i).and.k.gt.1) then   ! tendances dans le nuage
-!------------------------------------------------------------- detrainement
-      if(mp(i,k+1).gt.mp(i,k).and.mp(i,k+1).gt.1.e-10) then
-        uscavtrac= (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))&
-                   + mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
-!
-!        if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
-!                    (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
-!                    mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
-!                    'mp',mp(i,k)
-!------------------------------------------------------------- entrainement 
-      elseif(mp(i,k).gt.mp(i,k+1).and.mp(i,k).gt.1.e-10) then
-         uscavtrac= mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
-!
-!         if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-!=!------------------------------------------------------------- end ent/det 
-      else !        mp(i,k+1)=0. et mp(i,k)=0.    pluie directement sur l environnement
-
-        if(NO_precip(i,k)) then
-          uscavtrac=0.
-!         if(it.eq.3) write(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-        else
-          uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-!         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-        endif
-      endif  ! mp/det/ent
-!------------------------------------------------------------- premiere couche 
-   elseif(k.eq.1) then  !                                      mp(1)=0.
-      if(mp(i,2).gt.1.e-10) then  !detrainement
-         uscavtrac= (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it)) !&
-!                   + mp(i,2)*(0.-tr(i,k,it))
-!
-!       if(it.eq.3) write(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
-!                  (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
-!                  mp(i,2)*(0.-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
-!                   'mp',mp(i,k)
-      else   ! mp(2) = 0 = mp(1) pas de descente insaturee, rien ne se passe s'il ne pleut pas, sinon pluie->env
-        if(NO_precip(i,1)) then
-          uscavtrac=0.
-        else
-          uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-        endif
-!         if(it.eq.3) write(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-      endif
-
-   else   ! k > INB  au-dessus du nuage
-    uscavtrac=0.
-   endif
-
-! =====    tendances finales  ======
-     trsptd(i,k,it)=trsptrac*pdtimeRG/dxpres(i,k)              ! td transport sans eau dans courants satures
-     dtrSscav(i,k,it)=scavtrac*pdtimeRG/dxpres(i,k)            ! td du lessivage dans courants satures
-     dtrUscav(i,k,it)=uscavtrac*pdtimeRG/dxpres(i,k)           ! td courant insat
-     dtrsat(i,k,it)=(trsptrac+scavtrac)*pdtimeRG/dxpres(i,k)   ! td courant sat
-     dtrcv(i,k,it)=(trsptrac+scavtrac+uscavtrac)*pdtimeRG/dxpres(i,k)!dtrsat(i,k,it)+dtrUscav(i,k,it)         td conv
-!!!!!!
-     dtrcvMA(i,k,it)=tdcvMA*pdtimeRG/dxpres(i,k) ! MA tendance convection
-     ENDDO
-  ENDDO
-
-! test de conservation du traceur
-!print*,"_____________________________________________________________"
-!print*,"                                                             "
-!      conserv=0.
-!      conservMA=0.
-!      DO k= klev-1,1,-1
-!        DO i=1, klon
-!         conserv=conserv+dtrcv(i,k,it)*   &
-!        (paprs(i,k)-paprs(i,k+1))/RG
-!         conservMA=conservMA+dtrcvMA(i,k,it)*   &
-!        (paprs(i,k)-paprs(i,k+1))/RG
-!
-!      if(it.eq.3)  write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
-!         'MA td ',dtrcvMA(i,k,it)*dxpres(i,k)/RG,&
-!         ' td',dtrcv(i,k,it)*dxpres(i,k)/RG,'         conservMA ',conservMA,'conserv ',conserv
-!!
-!        ENDDO
-!      ENDDO
-!       if(it.eq.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
-
-END SUBROUTINE cvltr
+link ../phylmd/cvltr.F90
Index: LMDZ6/trunk/libf/phylmdiso/cvltr_noscav.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvltr_noscav.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvltr_noscav.F90	(revision 3940)
@@ -1,201 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE cvltr_noscav(it,pdtime,da, phi, mp,wght_cvfd,paprs,pplay,x,upd,dnd,dx)
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr
-  IMPLICIT NONE 
-!=====================================================================
-! Objet : convection des traceurs / KE
-! Auteurs: M-A Filiberti and J-Y Grandpeix
-!=====================================================================
-  include "YOMCST.h"
-  include "YOECUMF.h" 
-
-! Entree
-  REAL,INTENT(IN)                           :: pdtime
-  INTEGER, INTENT(IN)                       :: it
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: da
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: mp
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd  ! weights of the layers feeding convection
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)    :: paprs ! pression aux 1/2 couches (bas en haut)
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pplay ! pression pour le milieu de chaque couche
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)      :: x     ! q de traceur (bas en haut) 
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: upd   ! saturated updraft mass flux
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: dnd   ! saturated downdraft mass flux
-
-! Sortie
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dx ! tendance de traceur  (bas en haut)
-
-! Variables locales     
-! REAL,DIMENSION(klon,klev)       :: zed
-  REAL,DIMENSION(klon,klev,klev)  :: zmd
-  REAL,DIMENSION(klon,klev,klev)  :: za
-  REAL,DIMENSION(klon,klev)       :: zmfd,zmfa
-  REAL,DIMENSION(klon,klev)       :: zmfp,zmfu
-  REAL,DIMENSION(klon,nbtr)       :: qfeed     ! tracer concentration feeding convection
-  REAL,DIMENSION(klon,klev)       :: deltap
-  INTEGER                         :: i,k,j 
-  REAL                            :: pdtimeRG
-  REAL                            :: smallest_mp
-  real conserv
-  real smfd
-  real smfu
-  real smfa
-  real smfp
-! =========================================
-! calcul des tendances liees au downdraft
-! =========================================
-!
-  smallest_mp = tiny(mp(1,1))
-!cdir collapse
-  qfeed(:,it) = 0.
-  DO j=1,klev
-  DO i=1,klon
-!   zed(i,j)=0.
-    zmfd(i,j)=0.
-    zmfa(i,j)=0.
-    zmfu(i,j)=0.
-    zmfp(i,j)=0.
-  END DO
-  END DO
-!cdir collapse
-  DO k=1,klev
-  DO j=1,klev
-  DO i=1,klon
-    zmd(i,j,k)=0.
-    za (i,j,k)=0.
-  END DO
-  END DO
-  END DO
-! entrainement
-! DO k=1,klev-1
-!    DO i=1,klon
-!       zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
-!    END DO
-! END DO
-
-! calcul de la matrice d echange
-! matrice de distribution de la masse entrainee en k
-
-  DO k=1,klev-1
-     DO i=1,klon
-        zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1))
-     END DO
-  END DO
-  DO k=2,klev
-     DO j=k-1,1,-1
-        DO i=1,klon
-!!           if(mp(i,j+1).ne.0) then
-!!              zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
-!!           ENDif
-           zmd(i,j,k)=zmd(i,j+1,k)*mp(i,j)/max(mp(i,j),mp(i,j+1),smallest_mp)
-        END DO
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-           za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
-        END DO
-     END DO
-  END DO
-!
-! rajout du terme lie a l ascendance induite
-!
-  DO j=2,klev
-     DO i=1,klon
-        za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
-     END DO
-  END DO
-!
-! tendances
-!            
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k,it)-x(i,j,it))
-        END DO
-     END DO
-  END DO
-!
-! =========================================
-! calcul des tendances liees aux flux satures
-! =========================================
-!RL
-!  Feeding concentrations
-  DO j=1,klev
-     DO i=1,klon
-        qfeed(i,it)=qfeed(i,it)+wght_cvfd(i,j)*x(i,j,it)
-     END DO
-  END DO
-!RL
-!
-  DO j=1,klev
-     DO i=1,klon
-!RL
-!!        zmfa(i,j,it)=da(i,j)*(x(i,1,it)-x(i,j,it))                     ! da
-        zmfa(i,j)=da(i,j)*(qfeed(i,it)-x(i,j,it))                     ! da
-!RL
-     END DO
-  END DO
-!
-!!  print *,'it, qfeed(1,it), x(1,1,it) ', it, qfeed(1,it), x(1,1,it)  !jyg
-!!  print *,'wght_cvfd ', (j, wght_cvfd(1,j), j=1,5)                     !jyg
-!
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k,it)-x(i,j,it))
-        END DO
-     END DO
-  END DO
-  DO j=1,klev-1
-     DO i=1,klon
-        zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1,it)-x(i,j,it))
-     END DO
-  END DO
-  DO j=2,klev
-     DO i=1,klon
-        zmfu(i,j)=zmfu(i,j)+min(0.,upd(i,j)+dnd(i,j))*(x(i,j,it)-x(i,j-1,it))
-     END DO
-  END DO
-
-! =========================================
-! calcul final des tendances
-! =========================================
-  DO k=1, klev
-     DO i=1, klon
-        deltap(i,k)=paprs(i,k)-paprs(i,k+1)
-     ENDDO
-  ENDDO
-  pdtimeRG=pdtime*RG
-!cdir collapse
-  DO k=1, klev
-     DO i=1, klon
-        dx(i,k,it)=(zmfd(i,k)+zmfu(i,k)       &
-                +zmfa(i,k)+zmfp(i,k))*pdtimeRG/deltap(i,k)
-     ENDDO
-  ENDDO
-
-!! test de conservation du traceur
-      conserv=0.
-      smfd = 0.
-      smfu = 0.
-      smfa = 0.
-      smfp = 0.
-      DO k=1, klev
-        DO i=1, klon
-         conserv=conserv+dx(i,k,it)*   &
-          deltap(i,k)/RG
-         smfd = smfd + zmfd(i,k)*pdtime
-         smfu = smfu + zmfu(i,k)*pdtime
-         smfa = smfa + zmfa(i,k)*pdtime
-         smfp = smfp + zmfp(i,k)*pdtime
-        ENDDO
-      ENDDO
-!!      print *,'it',it,'cvltr_noscav conserv, smfd, smfu, smfa, smfp ',conserv,  &
-!!               smfd, smfu, smfa, smfp
-     
-END SUBROUTINE cvltr_noscav
+link ../phylmd/cvltr_noscav.F90
Index: LMDZ6/trunk/libf/phylmdiso/cvltr_scav.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvltr_scav.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvltr_scav.F90	(revision 3940)
@@ -1,707 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE cvltr_scav(pdtime, da, phi,phi2,d1a,dam, mpIN,epIN, &
-     sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,    &
-     pmflxrIN,pmflxsIN,ev,te,wdtrainA,wdtrainM,     &
-     paprs,it,tr,upd,dnd,inb,icb,                   &
-     ccntrAA_3d,ccntrENV_3d,coefcoli_3d,            &
-     dtrcv,trsptd,dtrSscav,dtrsat,dtrUscav,qDi,qPr, &
-     qPa,qMel,qTrdi,dtrcvMA,Mint,                   &
-     zmfd1a,zmfphi2,zmfdam)
-  !
-  USE IOIPSL 
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr,tname
-  IMPLICIT NONE 
-  !=====================================================================
-  ! Objet : convection des traceurs / KE
-  ! Auteurs: M-A Filiberti and J-Y Grandpeix
-  ! modifiee par R Pilon : lessivage des traceurs / KE
-  !=====================================================================
-
-  include "YOMCST.h"
-  include "YOECUMF.h"
-  include "conema3.h"
-  include "chem.h"
-
-  ! Entree
-  REAL,INTENT(IN)                           :: pdtime
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: da
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi
-  ! RomP
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: d1a,dam ! matrices pour simplifier
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2    ! l'ecriture des tendances
-  !
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: mpIN
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)    :: paprs  ! pression aux 1/2 couches (bas en haut)
-  INTEGER,INTENT(IN)                        :: it     ! numero du traceur
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr     ! q de traceur (bas en haut)
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: upd   ! saturated updraft mass flux
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: dnd   ! saturated downdraft mass flux
-  !
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainA   ! masses precipitantes de l'asc adiab
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainM   ! masses precipitantes des melanges
-  !JE  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pmflxrIN   ! vprecip: eau
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)      :: pmflxrIN   ! vprecip: eau
-  !JE  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pmflxsIN   ! vprecip: neige
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)      :: pmflxsIN   ! vprecip: neige
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: ev         ! evaporation cv30_routine
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: epIN
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: te 
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij        ! fraction dair de lenv
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd  ! weights of the layers feeding convection
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij       ! contenu en eau condensée spécifique/conc deau condensée massique
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm    ! eau condensee precipitee dans mel masse dair sat
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: eplaMm    ! eau condensee precipitee dans aa masse dair sat
-
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw        ! contenu en eau condensée dans lasc adiab
-  REAL,DIMENSION(klon),INTENT(IN)           :: sigd
-  INTEGER,DIMENSION(klon),INTENT(IN)        :: icb,inb
-  !
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: ccntrAA_3d
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: ccntrENV_3d
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: coefcoli_3d
-  !
-  ! Sortie
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrcv     ! tendance totale (bas en haut)
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrcvMA ! M-A Filiberti
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: trsptd    ! tendance du transport 
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrSscav  ! tendance du lessivage courant sat
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrsat    ! tendance trsp+sat scav
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrUscav  ! tendance du lessivage courant unsat
-  !
-  ! Variables locales
-  INTEGER                           :: i,j,k
-  REAL,DIMENSION(klon,klev)         :: dxpres   ! difference de pression entre niveau (j+1) et (j)
-  REAL                              :: pdtimeRG ! pas de temps * gravite
-  REAL,DIMENSION(klon,nbtr)         :: qfeed     ! tracer concentration feeding convection
-  ! variables pour les courants satures
-  REAL,DIMENSION(klon,klev,klev)    :: zmd
-  REAL,DIMENSION(klon,klev,klev)    :: za
-  REAL,DIMENSION(klon,klev,nbtr)    :: zmfd,zmfa
-  REAL,DIMENSION(klon,klev,nbtr)    :: zmfp,zmfu
-
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfd1a
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfdam
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfphi2
-
-  ! RomP ! les variables sont nettoyees des valeurs aberrantes
-  REAL,DIMENSION(klon,klev)         :: Pa, Pm  ! pluie AA et mélanges, var temporaire
-  REAL,DIMENSION(klon,klev)         :: pmflxs,pmflxr ! pmflxrIN,pmflxsIN sans valeur aberante
-  REAL,DIMENSION(klon,klev)         :: mp            ! flux de masse
-  REAL,DIMENSION(klon,klev)         :: ep            ! fraction d'eau convertie en precipitation 
-  REAL,DIMENSION(klon,klev)         :: evap          ! evaporation : variable temporaire 
-  REAL,DIMENSION(klon,klev)         :: rho    !environmental density
-
-  REAL,DIMENSION(klon,klev)         :: kappa ! denominateur du au calcul de la matrice 
-  ! pour obtenir qd et qp
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qTrdi ! traceurs descente air insature transport MA
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qDi  ! traceurs descente insaturees
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qPr  ! traceurs colonne precipitante
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qPa  ! traceurs dans les precip issues lasc. adiab.
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qMel ! traceurs dans les precip issues des melanges
-  REAL,DIMENSION(klon,klev,nbtr)                :: qMeltmp ! variable temporaire 
-  REAL,DIMENSION(klon,klev,nbtr)                :: qpmMint
-  REAL,DIMENSION(klon,klev),INTENT(OUT)         :: Mint
-  ! tendances
-  REAL                              :: tdcvMA           ! terme de transport de traceur (schema Marie Angele)
-  REAL                              :: trsptrac         ! terme de transport de traceur par l'air
-  REAL                              :: scavtrac         ! terme de lessivage courant sature
-  REAL                              :: uscavtrac        ! terme de lessivage courant insature
-  ! impaction
-!!!       Correction apres discussion Romain P. / Olivier B. 
-!!!  REAL,PARAMETER                    :: rdrop=2.5e-3     ! rayon des gouttes d'eau
-  REAL,PARAMETER                    :: rdrop=1.e-3     ! rayon des gouttes d'eau 
-!!!
-  REAL,DIMENSION(klon,klev)         :: imp              ! coefficient d'impaction
-  !
-  LOGICAL,DIMENSION(klon,klev) :: NO_precip
-  ! var tmp tests
-  REAL                           :: conserv
-  real                           :: conservMA
-
-!jyg<
-!!  ! ======================================================
-!!  ! calcul de l'impaction
-!!  ! ======================================================
-!!
-!!  ! impaction sur la surface de la colonne de la descente insaturee
-!!  ! On prend la moyenne des precip entre le niveau i+1 et i
-!!  ! I=3/4* (P(1+1)+P(i))/2 / (sigd*r*rho_l)
-!!  ! 1000kg/m3= densite de l'eau
-!!  ! 0.75e-3 = 3/4 /1000
-!!  ! Par la suite, I est tout le temps multiplie par sig_d pour avoir l'impaction sur la surface de la maille
-!!!!  ! on le neglige ici pour simplifier le code
-!!
-!!  DO j=1,klev-1
-!!     DO i=1,klon
-!!        imp(i,j) = coefcoli_3d(i,j)*0.75e-3/rdrop *&
-!!             0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
-!!     ENDDO
-!!  ENDDO
-!>jyg
-  !
-  ! initialisation pour flux de traceurs, td et autre
-  !
-  trsptrac = 0.
-  scavtrac = 0.
-  uscavtrac = 0.
-  qfeed(:,it) = 0.              !RL
-  DO j=1,klev
-     DO i=1,klon
-        zmfd(i,j,it)=0.
-        zmfa(i,j,it)=0.
-        zmfu(i,j,it)=0.
-        zmfp(i,j,it)=0.
-        zmfphi2(i,j,it)=0.
-        zmfd1a(i,j,it)=0.
-        zmfdam(i,j,it)=0.
-        qDi(i,j,it)=0.
-        qPr(i,j,it)=0.
-        qPa(i,j,it)=0.
-        qMel(i,j,it)=0.
-        qMeltmp(i,j,it)=0.
-        qTrdi(i,j,it)=0.
-        kappa(i,j)=0.
-        trsptd(i,j,it)=0.
-        dtrsat(i,j,it)=0.
-        dtrSscav(i,j,it)=0.
-        dtrUscav(i,j,it)=0.
-        dtrcv(i,j,it)=0.
-        dtrcvMA(i,j,it)=0.
-        evap(i,j)=0.
-        dxpres(i,j)=0.
-        qpmMint(i,j,it)=0.
-        Mint(i,j)=0.
-     END DO
-  END DO
-
-  ! suppression des valeurs très faibles (~1e-320)
-  ! multiplication de levaporation pour lavoir par unite de temps
-  ! et par unite de surface de la maille
-  ! -> cv30_unsat : evap : masse evaporee/s/(m2 de la descente)
-  DO j=1,klev
-     DO i=1,klon
-        IF(ev(i,j).lt.1.e-16) THEN
-           evap(i,j)=0.
-        ELSE
-           evap(i,j)=ev(i,j)*sigd(i)
-        ENDIF
-     END DO
-  END DO
-
-  DO j=1,klev
-     DO i=1,klon
-        IF(j.LT.klev) THEN
-           IF(epIN(i,j).LT.1.e-32) THEN
-              ep(i,j)=0.
-           ELSE
-              ep(i,j)=epIN(i,j)
-           ENDIF
-        ELSE
-           ep(i,j)=epmax
-        ENDIF
-        IF(mpIN(i,j).LT.1.e-32) THEN
-           mp(i,j)=0.
-        ELSE
-           mp(i,j)=mpIN(i,j)
-        ENDIF
-        IF(pmflxsIN(i,j).LT.1.e-32) THEN
-           pmflxs(i,j)=0.
-        ELSE
-           pmflxs(i,j)=pmflxsIN(i,j)
-        ENDIF
-        IF(pmflxrIN(i,j).LT.1.e-32) THEN
-           pmflxr(i,j)=0.
-        ELSE
-           pmflxr(i,j)=pmflxrIN(i,j)
-        ENDIF
-        IF(wdtrainA(i,j).LT.1.e-32) THEN
-           Pa(i,j)=0.
-        ELSE
-           Pa(i,j)=wdtrainA(i,j)
-        ENDIF
-        IF(wdtrainM(i,j).LT.1.e-32) THEN
-           Pm(i,j)=0.
-        ELSE
-           Pm(i,j)=wdtrainM(i,j)
-        ENDIF
-     END DO
-  END DO
-
-  !==========================================
-  DO j = klev-1,1,-1
-     DO i = 1,klon
-        NO_precip(i,j) = (pmflxr(i,j+1)+pmflxs(i,j+1)).LT.1.e-10&
-             .AND.Pa(i,j).LT.1.e-10.AND.Pm(i,j).LT.1.e-10
-     END DO
-  END DO
-
-!jyg<
-  ! ======================================================
-  ! calcul de l'impaction
-  ! ======================================================
-
-  ! impaction sur la surface de la colonne de la descente insaturee
-  ! On prend la moyenne des precip entre le niveau i+1 et i
-  ! I=3/4* (P(1+1)+P(i))/2 / (sigd*r*rho_l)
-  ! 1000kg/m3= densite de l'eau
-  ! 0.75e-3 = 3/4 /1000
-  ! Par la suite, I est tout le temps multiplie par sig_d pour avoir l'impaction sur la surface de la maille
-  ! on le neglige ici pour simplifier le code
-
-  DO j=1,klev-1
-     DO i=1,klon
-        imp(i,j) = coefcoli_3d(i,j)*0.75e-3/rdrop *&
-             0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
-     ENDDO
-  ENDDO
-!>jyg
-  ! =========================================
-  ! calcul des tendances liees au downdraft
-  ! =========================================
-  !cdir collapse
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmd(i,j,k)=0.
-           za (i,j,k)=0.
-        END DO
-     END DO
-  END DO
-  ! calcul de la matrice d echange
-  ! matrice de distribution de la masse entrainee en k
-  ! commmentaire RomP : mp > 0
-  DO k=1,klev-1
-     DO i=1,klon
-        zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1))   ! ~ mk(k)
-     END DO
-  END DO
-  DO k=2,klev
-     DO j=k-1,1,-1
-        DO i=1,klon
-           IF(mp(i,j+1).GT.1.e-10) THEN
-              zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1)) !det ~ mk(j)=mk(j+1)*mp(i,j)/mp(i,j+1)
-           ENDIF
-        END DO
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-           za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
-        END DO
-     END DO
-  END DO
-!!!!! quantite  de traceur dans la descente d'air insaturee  :   4 juin 2012
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-           IF(mp(i,j+1).GT.1.e-10) THEN
-              qTrdi(i,j+1,it)=qTrdi(i,j+1,it)+(zmd(i,j+1,k)/mp(i,j+1))*tr(i,k,it)
-           ELSE
-              qTrdi(i,j,it)=0.!tr(i,j,it)
-           ENDIF
-        ENDDO
-     ENDDO
-  ENDDO
-!!!!!
-  !
-  ! rajout du terme lie a l ascendance induite
-  !
-  DO j=2,klev
-     DO i=1,klon
-        za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
-     END DO
-  END DO
-  !
-  ! tendance courants insatures  ! sans lessivage ancien schema
-  !
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfd(i,j,it)=zmfd(i,j,it)+za(i,j,k)*(tr(i,k,it)-tr(i,j,it))
-        END DO
-     END DO
-  END DO
-  !
-  ! =========================================
-  ! calcul des tendances liees aux courants satures   j <-> z ; k <-> z'
-  ! =========================================
-  !RL
-  !  Feeding concentrations
-  DO j=1,klev
-     DO i=1,klon
-        qfeed(i,it)=qfeed(i,it)+wght_cvfd(i,j)*tr(i,j,it)
-     END DO
-  END DO
-  !RL
-  !
-  DO j=1,klev
-     DO i=1,klon
-        !RL
-        !!        zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it))                     ! da
-        zmfa(i,j,it)=da(i,j)*(qfeed(i,it)-tr(i,j,it))                     ! da
-        !RL
-     END DO
-  END DO
-  !
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfp(i,j,it)=zmfp(i,j,it)+phi(i,j,k)*(tr(i,k,it)-tr(i,j,it))  ! phi
-        END DO
-     END DO
-  END DO
-  ! RomP ajout des matrices liees au lessivage
-  DO j=1,klev
-     DO i=1,klon
-        zmfd1a(i,j,it)=d1a(i,j)*tr(i,1,it)   ! da1
-        zmfdam(i,j,it)=dam(i,j)*tr(i,1,it)   ! dam
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfphi2(i,j,it)=zmfphi2(i,j,it)+phi2(i,j,k)*tr(i,k,it)  ! psi
-        END DO
-     END DO
-  END DO
-  DO j=1,klev-1
-     DO i=1,klon
-        zmfu(i,j,it)=max(0.,upd(i,j+1)+dnd(i,j+1))*(tr(i,j+1,it)-tr(i,j,it))
-     END DO
-  END DO
-  DO j=2,klev
-     DO i=1,klon
-        zmfu(i,j,it)=zmfu(i,j,it)+min(0.,upd(i,j)+dnd(i,j))*(tr(i,j,it)-tr(i,j-1,it))
-     END DO
-  END DO
-  ! ===================================================
-  ! calcul des tendances liees aux courants insatures
-  ! ===================================================
-  !  pression  
-  DO k=1, klev
-     DO i=1, klon
-        dxpres(i,k)=paprs(i,k)-paprs(i,k+1)
-     ENDDO
-  ENDDO
-  pdtimeRG=pdtime*RG
-
-  ! q_pa et q_pm    traceurs issues des courants satures se retrouvant dans les precipitations
-  DO j=1,klev
-     DO i=1,klon
-        IF(j.GE.icb(i).AND.j.LE.inb(i)) THEN
-           IF(clw(i,j).GT.1.e-16) THEN
-              !JE           qPa(i,j,it)=ccntrAA_coef*tr(i,1,it)/clw(i,j)
-              qPa(i,j,it)=ccntrAA_3d(i,j)*tr(i,1,it)/clw(i,j)
-           ELSE
-              qPa(i,j,it)=0.
-           ENDIF
-        ENDIF
-     END DO
-  END DO
-
-  ! calcul de q_pm en 2 parties :
-  ! 1) calcul de sa valeur pour un niveau z' donne
-  ! 2) integration sur la verticale sur z'
-  DO j=1,klev
-     DO k=1,j-1
-        DO i=1,klon
-           IF(k.GE.icb(i).AND.k.LE.inb(i).AND.& 
-                j.LE.inb(i)) THEN
-              IF(elij(i,k,j).GT.1.e-16) THEN
-                 !JE             qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_coef*tr(i,1,it)&
-                 !JE                         *(1.-sij(i,k,j))  +ccntrENV_coef&
-                 !JE                         *tr(i,k,it)*sij(i,k,j)) / elij(i,k,j)
-                 qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_3d(i,k)*tr(i,1,it)&
-                      *(1.-sij(i,k,j))  +ccntrENV_3d(i,k)&
-                      *tr(i,k,it)*sij(i,k,j)) / elij(i,k,j)
-              ELSE
-                 qMeltmp(i,j,it)=0.
-              ENDIF
-              qpmMint(i,j,it)=qpmMint(i,j,it) + qMeltmp(i,j,it)*epmlmMm(i,j,k)
-              Mint(i,j)=Mint(i,j) + epmlmMm(i,j,k)
-           ENDIF ! end if dans nuage
-        END DO
-     END DO
-  END DO
-
-  DO j=1,klev
-     DO i=1,klon
-        IF(Mint(i,j).GT.1.e-16) THEN
-           qMel(i,j,it)=qpmMint(i,j,it)/Mint(i,j)
-        ELSE
-           qMel(i,j,it)=0.
-        ENDIF
-     END DO
-  END DO
-
-  ! calcul de q_d et q_p    traceurs de la descente precipitante 
-  DO j=klev-1,1,-1
-     DO i=1,klon
-        IF(mp(i,j+1).GT.mp(i,j).AND.mp(i,j+1).GT.1.e-10) THEN  ! detrainement
-           kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))&
-                + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-
-        ELSEIF(mp(i,j).GT.mp(i,j+1).AND.mp(i,j).GT.1.e-10) THEN! entrainement
-           IF(j.eq.1) THEN
-              kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                   (-mp(i,2)-imp(i,j)/RG*dxpres(i,j))&
-                   + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-           ELSE
-              kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                   (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))&
-                   + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-           ENDIF
-        ELSE
-           kappa(i,j)=1.
-        ENDIF
-     ENDDO
-  ENDDO
-
-  DO j=klev-1,1,-1
-     DO i=1,klon
-        IF (abs(kappa(i,j)).LT.1.e-25) THEN    !si denominateur nul (il peut y avoir des mp!=0)
-           kappa(i,j)=1.
-           IF(j.eq.1) THEN
-              qDi(i,j,it)=qDi(i,j+1,it) !orig tr(i,j,it)   ! mp(1)=0 donc tout vient de la couche supérieure
-           ELSEIF(mp(i,j+1).GT.mp(i,j).AND.mp(i,j+1).GT.1.e-10) THEN
-              qDi(i,j,it)=qDi(i,j+1,it)
-           ELSEIF(mp(i,j).GT.mp(i,j+1).AND.mp(i,j).GT.1.e-10) THEN! entrainement
-              qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
-           ELSE  ! si  mp (i)=0 et mp(j+1)=0
-              qDi(i,j,it)=tr(i,j,it) ! orig 0.
-           ENDIF
-
-           IF(NO_precip(i,j)) THEN
-              qPr(i,j,it)=0.
-           ELSE
-              qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                   Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                   +imp(i,j)/RG*dxpres(i,j)*qDi(i,j,it))/&
-                   (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-           ENDIF
-        ELSE   !     denominateur non nul
-           kappa(i,j)=1./kappa(i,j)     
-           ! calcul de qd et qp
-           !!jyg  (20130119) correction pour le sommet du nuage
-           !!     if(j.GE.inb(i)) THEN       !au-dessus du nuage, sommet inclu
-           if(j.GT.inb(i)) THEN       !au-dessus du nuage
-              qDi(i,j,it)=tr(i,j,it)   ! pas de descente => environnement = descente insaturee
-              qPr(i,j,it)=0.
-
-              !  vvv premiere couche du modele ou mp(1)=0  ! det tout le temps  vvv
-           ELSEIF(j.eq.1) THEN 
-              if(mp(i,2).GT.1.e-10) THEN !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
-                 if(NO_precip(i,j)) THEN !pas de precip en (i)
-                    qDi(i,j,it)=qDi(i,j+1,it)
-                    qPr(i,j,it)=0.
-                 ELSE
-                    qDi(i,j,it)=kappa(i,j)*(&
-                         (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-                         (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                         (-mp(i,j+1)*qDi(i,j+1,it)))
-
-                    qPr(i,j,it)=kappa(i,j)*(&
-                         (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*&
-                         ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-                         +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j)))
-                 ENDIF
-
-              ELSE !mp(2) nul -> plus de descente insaturee -> pluie agit sur environnement
-                 qDi(i,j,it)=tr(i,j,it) ! orig 0.
-                 if(NO_precip(i,j)) THEN
-                    qPr(i,j,it)=0.
-                 ELSE
-                    qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                         +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/&
-                         (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-                 ENDIF
-
-              ENDIF  !mp(2) nul ou non
-
-              ! vvv  (j!=1.AND.j.LT.inb(i))  en-dessous du sommet nuage   vvv
-           ELSE 
-              !------------------------------------------------------------- detrainement 
-              if(mp(i,j+1).GT.mp(i,j).AND.mp(i,j+1).GT.1.e-10) THEN !mp(i,j).GT.1.e-10) THEN
-                 if(NO_precip(i,j)) THEN 
-                    qDi(i,j,it)=qDi(i,j+1,it)
-                    qPr(i,j,it)=0.
-                 ELSE
-                    qDi(i,j,it)=kappa(i,j)*(&
-                         (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-                         (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                         (-mp(i,j+1)*qDi(i,j+1,it)))
-                    !
-                    qPr(i,j,it)=kappa(i,j)*(&
-                         (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*&
-                         ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-                         +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j)))
-                 ENDIF !precip
-                 !------------------------------------------------------------- entrainement 
-              ELSEIF(mp(i,j).GT.mp(i,j+1).AND.mp(i,j).GT.1.e-10) THEN 
-                 if(NO_precip(i,j)) THEN
-                    qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
-                    qPr(i,j,it)=0.
-                 ELSE
-                    qDi(i,j,it)=kappa(i,j)*(&
-                         (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-                         (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                         (-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it)))
-                    !
-                    qPr(i,j,it)=kappa(i,j)*(&
-                         (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))*&
-                         ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-                         +(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))*&
-                         (imp(i,j)/RG*dxpres(i,j)))
-                 ENDIF !precip
-                 !------------------------------------------------------------- ENDIF ! ent/det
-              ELSE  !mp nul
-                 qDi(i,j,it)=tr(i,j,it) ! orig 0.
-                 if(NO_precip(i,j)) THEN
-                    qPr(i,j,it)=0.
-                 ELSE
-                    qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                         Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                         +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/&
-                         (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-                 ENDIF
-              ENDIF ! mp nul ou non
-           ENDIF ! condition sur j
-        ENDIF ! kappa
-     ENDDO
-  ENDDO
-
-  !! print test descente insaturee
-  !  DO j=klev,1,-1
-  !   DO i=1,klon
-  !     if(it.eq.3) THEN
-  !   write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') j,&
-  !!         'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),&
-  !          'zmfdam+zmfpsi',zmfdam(i,j,it)+zmfphi2(i,j,it),'qpmMint',qpmMint(i,j,it),&
-  !          'Pm',Pm(i,j),'Mint',Mint(i,j),&
-  !!          'zmfa',zmfa(i,j,it),'zmfp',zmfp(i,j,it),&
-  !        'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),'zmfd1a',zmfd1a(i,j,it)
-  !!          'Pa',Pa(i,j),'eplaMm',eplaMm(i,j)
-  !!         'zmfd1a=da1*qa',zmfd1a(i,j,it),'Pa*qPa',wdtrainA(i,j)*qPa(i,j,it),'da1',d1a(i,j)
-  !     ENDIF
-  !   ENDDO
-  !  ENDDO
-
-
-  ! ===================================================
-  ! calcul final des tendances
-  ! ===================================================
-
-  DO k=klev-1,1,-1
-     DO i=1, klon
-        ! transport
-        tdcvMA=zmfd(i,k,it)+zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it)   ! double comptage des downdraft insatures
-        trsptrac=zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it)
-        ! lessivage courants satures
-        !JE     scavtrac=-ccntrAA_coef*zmfd1a(i,k,it)&
-        !JE               -zmfphi2(i,k,it)*ccntrENV_coef&
-        !JE               -zmfdam(i,k,it)*ccntrAA_coef
-        scavtrac=-ccntrAA_3d(i,k)*zmfd1a(i,k,it)&
-             -zmfphi2(i,k,it)*ccntrENV_3d(i,k)&
-             -zmfdam(i,k,it)*ccntrAA_3d(i,k)
-        ! lessivage courants insatures
-        if(k.LE.inb(i).AND.k.GT.1) THEN   ! tendances dans le nuage
-           !------------------------------------------------------------- detrainement
-           if(mp(i,k+1).GT.mp(i,k).AND.mp(i,k+1).GT.1.e-10) THEN
-              uscavtrac= (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))&
-                   + mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
-              !
-              !        if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
-              !                    (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
-              !                    mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
-              !                    'mp',mp(i,k)
-              !------------------------------------------------------------- entrainement 
-           ELSEIF(mp(i,k).GT.mp(i,k+1).AND.mp(i,k).GT.1.e-10) THEN
-              uscavtrac= mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
-              !
-              !         if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-              !=!------------------------------------------------------------- end ent/det 
-           ELSE !        mp(i,k+1)=0. et mp(i,k)=0.    pluie directement sur l environnement
-
-              if(NO_precip(i,k)) THEN
-                 uscavtrac=0.
-                 !         if(it.eq.3) write(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-              ELSE
-                 uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-                 !         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-                 !!JE adds
-                 !         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'imp',imp(i,k)
-                 !         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'tr',tr(i,k,it)
-                 !         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'evap',evap(i,k)
-                 !         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'qPr',qPr(i,k,it)
-                 !         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'dxpres',dxpres(i,k)
-                 !!Je end
-
-              ENDIF
-           ENDIF  ! mp/det/ent
-           !------------------------------------------------------------- premiere couche 
-        ELSEIF(k.eq.1) THEN  !                                      mp(1)=0.
-           if(mp(i,2).GT.1.e-10) THEN  !detrainement
-              uscavtrac= (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it)) !&
-              !                   + mp(i,2)*(0.-tr(i,k,it))
-              !
-              !       if(it.eq.3) write(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
-              !                  (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
-              !                  mp(i,2)*(0.-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
-              !                   'mp',mp(i,k)
-           ELSE   ! mp(2) = 0 = mp(1) pas de descente insaturee, rien ne se passe s'il ne pleut pas, sinon pluie->env
-              if(NO_precip(i,1)) THEN
-                 uscavtrac=0.
-              ELSE
-                 uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-              ENDIF
-              !         if(it.eq.3) write(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-           ENDIF
-
-        ELSE   ! k > INB  au-dessus du nuage
-           uscavtrac=0.
-        ENDIF
-
-        ! =====    tendances finales  ======
-        trsptd(i,k,it)=trsptrac*pdtimeRG/dxpres(i,k)              ! td transport sans eau dans courants satures
-        dtrSscav(i,k,it)=scavtrac*pdtimeRG/dxpres(i,k)            ! td du lessivage dans courants satures
-        dtrUscav(i,k,it)=uscavtrac*pdtimeRG/dxpres(i,k)           ! td courant insat
-        dtrsat(i,k,it)=(trsptrac+scavtrac)*pdtimeRG/dxpres(i,k)   ! td courant sat
-        dtrcv(i,k,it)=(trsptrac+scavtrac+uscavtrac)*pdtimeRG/dxpres(i,k)!dtrsat(i,k,it)+dtrUscav(i,k,it)         td conv
-!!!!!!
-        dtrcvMA(i,k,it)=tdcvMA*pdtimeRG/dxpres(i,k) ! MA tendance convection
-     ENDDO
-  ENDDO
-
-  ! test de conservation du traceur
-  !print*,"_____________________________________________________________"
-  !print*,"                                                             "
-  !      conserv=0.
-  !      conservMA=0.
-  !      DO k= klev-1,1,-1
-  !        DO i=1, klon
-  !         conserv=conserv+dtrcv(i,k,it)*   &
-  !        (paprs(i,k)-paprs(i,k+1))/RG
-  !         conservMA=conservMA+dtrcvMA(i,k,it)*   &
-  !        (paprs(i,k)-paprs(i,k+1))/RG
-  !
-  !      if(it.eq.3)  write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
-  !         'MA td ',dtrcvMA(i,k,it)*dxpres(i,k)/RG,&
-  !         ' td',dtrcv(i,k,it)*dxpres(i,k)/RG,'         conservMA ',conservMA,'conserv ',conserv
-  !!
-  !        ENDDO
-  !      ENDDO
-  !       if(it.eq.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
-
-END SUBROUTINE cvltr_scav
+link ../phylmd/cvltr_scav.F90
Index: LMDZ6/trunk/libf/phylmdiso/cvltr_spl.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvltr_spl.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvltr_spl.F90	(revision 3940)
@@ -1,841 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE cvltr_spl(pdtime, da, phi,phi2,d1a,dam, mpIN,epIN, &
-           sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,              &
-           pmflxrIN,pmflxsIN,ev,te,wdtrainA,wdtrainM,     &
-           paprs,it,tr,upd,dnd,inb,icb,                   &
-           kk,henry,zrho, ccntrAA_spla,ccntrENV_spla,coefcoli_spla, &
-           id_prec,id_fine,id_coss, id_codu, id_scdu, &
-           dtrcv,trsptd,dtrSscav,dtrsat,dtrUscav,qDi,qPr, &
-           qPa,qMel,qTrdi,dtrcvMA,Mint,                   &
-           zmfd1a,zmfphi2,zmfdam)
-  USE IOIPSL 
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr,tname
-  IMPLICIT NONE 
-!=====================================================================
-! Objet : convection des traceurs / KE
-! Auteurs: M-A Filiberti and J-Y Grandpeix
-! modifiee par R Pilon : lessivage des traceurs / KE
-!=====================================================================
-
-  include "YOMCST.h"
-  include "YOECUMF.h"
-  include "conema3.h"
-  include "chem.h"
-
-! Entree
-  REAL,INTENT(IN)                           :: pdtime
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: da
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi
-! RomP
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: d1a,dam ! matrices pour simplifier
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2    ! l'ecriture des tendances
-!
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: mpIN
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)    :: paprs  ! pression aux 1/2 couches (bas en haut)
-!  REAL,DIMENSION(klon,klev),INTENT(IN)    :: pplay ! pression aux 1/2 couches (bas en haut)
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr     ! q de traceur (bas en haut)
-  INTEGER,INTENT(IN)                        :: it 
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: upd   ! saturated updraft mass flux
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: dnd   ! saturated downdraft mass flux
-!
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainA   ! masses precipitantes de l'asc adiab
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainM   ! masses precipitantes des melanges
-!JE  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pmflxrIN   ! vprecip: eau
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)      :: pmflxrIN   ! vprecip: eau
-!JE  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pmflxsIN   ! vprecip: neige
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)      :: pmflxsIN   ! vprecip: neige
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: ev         ! evaporation cv30_routine
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: epIN
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: te 
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij        ! fraction dair de lenv
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd  ! weights of the layers feeding convection
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij       ! contenu en eau condensée spécifique/conc deau condensée massique
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm    ! eau condensee precipitee dans mel masse dair sat
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: eplaMm    ! eau condensee precipitee dans aa masse dair sat
-
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw        ! contenu en eau condensée dans lasc adiab
-  REAL,DIMENSION(klon),INTENT(IN)           :: sigd
-  INTEGER,DIMENSION(klon),INTENT(IN)        :: icb,inb
-! Sortie
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrcv     ! tendance totale (bas en haut)
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrcvMA ! M-A Filiberti
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: trsptd    ! tendance du transport 
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrSscav  ! tendance du lessivage courant sat
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrsat    ! tendance trsp+sat scav
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)     :: dtrUscav  ! tendance du lessivage courant unsat
-!
-! Variables locales
-  INTEGER                           :: i,j,k
-  REAL,DIMENSION(klon,klev)         :: dxpres   ! difference de pression entre niveau (j+1) et (j)
-  REAL                              :: pdtimeRG ! pas de temps * gravite
-  REAL,DIMENSION(klon,nbtr)         :: qfeed     ! tracer concentration feeding convection
-! variables pour les courants satures
-  REAL,DIMENSION(klon,klev,klev)    :: zmd
-  REAL,DIMENSION(klon,klev,klev)    :: za
-  REAL,DIMENSION(klon,klev,nbtr)    :: zmfd,zmfa
-  REAL,DIMENSION(klon,klev,nbtr)    :: zmfp,zmfu
-
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfd1a
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfdam
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfphi2
-
-! RomP ! les variables sont nettoyees des valeurs aberrantes
-  REAL,DIMENSION(klon,klev)         :: Pa, Pm  ! pluie AA et mélanges, var temporaire
-  REAL,DIMENSION(klon,klev)         :: pmflxs,pmflxr ! pmflxrIN,pmflxsIN sans valeur aberante
-  REAL,DIMENSION(klon,klev)         :: mp            ! flux de masse
-  REAL,DIMENSION(klon,klev)         :: ep            ! fraction d'eau convertie en precipitation 
-  REAL,DIMENSION(klon,klev)         :: evap          ! evaporation : variable temporaire 
-  REAL,DIMENSION(klon,klev)         :: rho    !environmental density
-
-  REAL,DIMENSION(klon,klev)         :: kappa ! denominateur du au calcul de la matrice 
-                                             ! pour obtenir qd et qp
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qTrdi ! traceurs descente air insature transport MA
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qDi  ! traceurs descente insaturees
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qPr  ! traceurs colonne precipitante
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qPa  ! traceurs dans les precip issues lasc. adiab.
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: qMel ! traceurs dans les precip issues des melanges
-  REAL,DIMENSION(klon,klev,nbtr)                :: qMeltmp ! variable temporaire 
-  REAL,DIMENSION(klon,klev,nbtr)                :: qpmMint
-  REAL,DIMENSION(klon,klev),INTENT(OUT)         :: Mint
-! tendances
-  REAL                              :: tdcvMA           ! terme de transport de traceur (schema Marie Angele)
-  REAL                              :: trsptrac         ! terme de transport de traceur par l'air
-  REAL                              :: scavtrac         ! terme de lessivage courant sature
-  REAL                              :: uscavtrac        ! terme de lessivage courant insature
-! impaction
-!!!       Correction apres discussion Romain P. / Olivier B. 
-!!!  REAL,PARAMETER                    :: rdrop=2.5e-3     ! rayon des gouttes d'eau
-  REAL,PARAMETER                    :: rdrop=1.e-3     ! rayon des gouttes d'eau 
-!!!
-  REAL,DIMENSION(klon,klev)         :: imp              ! coefficient d'impaction
-! parametres lessivage
-  REAL                    :: ccntrAA_coef        ! \alpha_a : fract aerosols de l'AA convertis en CCN
-  REAL                    :: ccntrENV_coef       ! \beta_m  : fract aerosols de l'env convertis en CCN
-  REAL                    :: coefcoli            ! coefficient de collision des gouttes sur les aerosols
-!
-  LOGICAL,DIMENSION(klon,klev) :: NO_precip
-!  LOGICAL                      :: scavON
-! var tmp tests
-  REAL                           :: conserv
-  real                           :: conservMA
-! JE SPLA adaptation
-
-   INTEGER :: id_prec,id_fine,id_coss, id_codu, id_scdu
-   REAL,DIMENSION(nbtr) :: ccntrAA_spla,ccntrENV_spla,coefcoli_spla
-   REAL,DIMENSION(klon,klev) :: ccntrAA_coef3d
-   REAL,DIMENSION(klon,klev) :: ccntrENV_coef3d
-   REAL,DIMENSION(klon,klev) :: coefcoli3d
-
-   REAL,DIMENSION(nbtr) :: henry         !--cste de Henry  mol/l/atm
-   REAL,DIMENSION(nbtr) :: kk            !--coefficient de var avec T (K)
-   REAL :: henry_t !--constante de Henry a T t  (mol/l/atm)
-   REAL :: f_a     !--rapport de la phase aqueuse a la phase gazeuse
-
-   REAL, PARAMETER :: ph=5.
-   REAL ::  K1, K2
-   REAL,DIMENSION(klon,klev) :: zrho
-   REAL, PARAMETER :: qliq=1.e-3 ! CONVECTIVE ONLY 
-
-! Je end 20140105
-
-!JE20140724<<
-!JE SPLA adapt:
-!
-!
-!! coefficient lessivage
-!   ccntrAA_coef     = 0.
-!   ccntrENV_coef    = 0.
-!   coefcoli         = 0.
-!
-!!$OMP MASTER
-!  call getin('ccntrAA_coef',ccntrAA_coef)
-!  call getin('ccntrENV_coef',ccntrENV_coef)
-!  call getin('coefcoli',coefcoli)
-!!$OMP END MASTER
-!!$OMP BARRIER
-!!! JE
-!  do j=1,klev
-!   do i=1,klon
-!     imp(i,j)=0.
-!     ccntrAA_coef3d(i,j)=ccntrAA_coef
-!     ccntrENV_coef3d(i,j)=ccntrENV_coef
-!     coefcoli3d(i,j)=coefcoli
-!   enddo
-!  enddo
-!
-!
-!!! for SPLA
-!!!JEend
-!  print*,'cvltr coef lessivage convectif', ccntrAA_coef,ccntrENV_coef,coefcoli
-!
-!JE20140724>>
-
-!  scavON=.TRUE.
-!  if(scavON) then
-!   ccntrAA_coef     = 1.
-!   ccntrENV_coef    = 1.
-!   coefcoli         = 1.
-!  else
-!   ccntrAA_coef     = 0.
-!   ccntrENV_coef    = 0.
-!   coefcoli         = 0.
-!  endif
-
-! ======================================================
-! calcul de l'impaction
-! ======================================================
-!initialisation
-  do j=1,klev
-   do i=1,klon
-     imp(i,j)=0.
-   enddo
-  enddo
-!JE init 20140103 
-!! impaction sur la surface de la colonne de la descente insaturee
-!! On prend la moyenne des precip entre le niveau i+1 et i
-!! I=3/4* (P(1+1)+P(i))/2 / (sigd*r*rho_l)
-!!  1000kg/m3= densité de l'eau
-!! 0.75e-3 = 3/4 /1000
-!! Par la suite, I est tout le temps multiplié par sig_d pour avoir l'impaction sur la surface de la maille
-!! on le néglige ici pour simplifier le code
-!  do j=1,klev-1
-!   do i=1,klon
-!    imp(i,j) = coefcoli*0.75e-3/rdrop *&
-!             0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
-!!    rho(i,j)=pplay(i,j)/(rd*te(i,j))
-!   enddo
-!  enddo
-!JE end 20140103
-
-!
-! initialisation pour flux de traceurs, td et autre
-   trsptrac = 0.
-   scavtrac = 0.
-   uscavtrac = 0.
-   qfeed(:,it) = 0.              !RL
-  DO j=1,klev
-   DO i=1,klon
-    zmfd(i,j,it)=0.
-    zmfa(i,j,it)=0.
-    zmfu(i,j,it)=0.
-    zmfp(i,j,it)=0.
-    zmfphi2(i,j,it)=0.
-    zmfd1a(i,j,it)=0.
-    zmfdam(i,j,it)=0.
-    qDi(i,j,it)=0.
-    qPr(i,j,it)=0.
-    qPa(i,j,it)=0.
-    qMel(i,j,it)=0.
-    qMeltmp(i,j,it)=0.
-    qTrdi(i,j,it)=0.
-    kappa(i,j)=0.
-    trsptd(i,j,it)=0.
-    dtrsat(i,j,it)=0.
-    dtrSscav(i,j,it)=0.
-    dtrUscav(i,j,it)=0.
-    dtrcv(i,j,it)=0.
-    dtrcvMA(i,j,it)=0.
-    evap(i,j)=0.
-    dxpres(i,j)=0.
-    qpmMint(i,j,it)=0.
-    Mint(i,j)=0.
-   END DO
-  END DO
-
-! suppression des valeurs très faibles (~1e-320)
-! multiplication de levaporation pour lavoir par unite de temps
-! et par unite de surface de la maille
-! -> cv30_unsat : evap : masse evaporee/s/(m2 de la descente)
-  DO j=1,klev
-   DO i=1,klon
-    if(ev(i,j).lt.1.e-16) then
-     evap(i,j)=0.
-    else
-     evap(i,j)=ev(i,j)*sigd(i)
-    endif
-   END DO
-  END DO
-
-  DO j=1,klev
-   DO i=1,klon
-   if(j.lt.klev) then
-    if(epIN(i,j).lt.1.e-32) then
-     ep(i,j)=0.
-    else
-     ep(i,j)=epIN(i,j)
-    endif
-   else
-    ep(i,j)=epmax
-   endif
-    if(mpIN(i,j).lt.1.e-32) then
-     mp(i,j)=0.
-    else
-     mp(i,j)=mpIN(i,j)
-    endif
-    if(pmflxsIN(i,j).lt.1.e-32) then
-     pmflxs(i,j)=0.
-    else
-     pmflxs(i,j)=pmflxsIN(i,j)
-    endif
-    if(pmflxrIN(i,j).lt.1.e-32) then
-     pmflxr(i,j)=0.
-    else
-     pmflxr(i,j)=pmflxrIN(i,j)
-    endif
-    if(wdtrainA(i,j).lt.1.e-32) then
-     Pa(i,j)=0.
-    else
-     Pa(i,j)=wdtrainA(i,j)
-    endif
-    if(wdtrainM(i,j).lt.1.e-32) then
-     Pm(i,j)=0.
-    else
-     Pm(i,j)=wdtrainM(i,j)
-    endif
-   END DO
-  END DO
-
-!==========================================
-  DO j = klev-1,1,-1
-   DO i = 1,klon
-     NO_precip(i,j) = (pmflxr(i,j+1)+pmflxs(i,j+1)).lt.1.e-10&
-                    .and.Pa(i,j).lt.1.e-10.and.Pm(i,j).lt.1.e-10
-   END DO
-  END DO
-!==============================================================================
-! JE SPLA: Calc of ccntrAA_coef,ccntrENV_coef, coefcoli for SPLA aerosols and
-! precursors. From SPLA code inscav_spl.F 
-!print *,'Using SPLA values for cvltr_spl ccntr and coefcoli params'
-!
-!
-!IF (it.EQ.2) THEN !--fine aerosol
-!  DO j=1,klev
-!   DO i=1,klon
-!    ccntrAA_coef3d(i,j)=0.7
-!    ccntrENV_coef3d(i,j)=0.7
-!    coefcoli3d(i,j)=0.001
-!   ENDDO
-!  ENDDO
-!ELSEIF (it.EQ.3) THEN !-- Coarse Sea salt aerosol
-!  DO j=1,klev
-!   DO i=1,klon
-!    ccntrAA_coef3d(i,j)=1.0
-!    ccntrENV_coef3d(i,j)=1.0
-!    coefcoli3d(i,j)=0.001
-!   ENDDO
-!  ENDDO
-!
-!ELSEIF (it.EQ.4) THEN !--Coarse Dust aerosol
-!  DO j=1,klev
- !  DO i=1,klon
-!    ccntrAA_coef3d(i,j)=0.7
-!    ccntrENV_coef3d(i,j)=0.7
-!    coefcoli3d(i,j)=0.001
-!
-!   ENDDO
-!  ENDDO
-! Gas precursor: Henry's law
-
-IF (it .EQ. id_prec) THEN
-      DO k=1, klev
-      DO i=1, klon
-        henry_t=henry(it)*exp(-kk(it)*(1./298.-1./te(i,k)))    !--mol/l/atm
-        K1=1.2e-2*exp(-2010*(1/298.-1/te(i,k)))
-        K2=6.6e-8*exp(-1510*(1/298.-1/te(i,k)))
-        henry_t=henry_t*(1. + K1/10.**(-ph) + K1*K2/(10.**(-ph))**2)
-        f_a=henry_t/101.325*R*te(i,k)*qliq*zrho(i,k)/rho_water
- !       scav(i,k)=f_a/(1.+f_a)
-        ccntrAA_coef3d(i,k)= f_a/(1.+f_a)
-        ccntrENV_coef3d(i,k)= f_a/(1.+f_a)
-        coefcoli3d(i,k)=0.0
-      ENDDO
-      ENDDO
- !    CALL minmaxqfi2(clw,1.e33,-1.e33,'minmax clw')
-ELSE
-  DO j=1,klev
-   DO i=1,klon
-    ccntrAA_coef3d(i,j)=ccntrAA_spla(it)
-    ccntrENV_coef3d(i,j)=ccntrENV_spla(it)
-    coefcoli3d(i,j)=coefcoli_spla(it)
-   ENDDO
-  ENDDO
-
-
-ENDIF
-
-! JE end SPLA modifs in ccn parameters
-!==============================================================================
-
-
-
-
-!JE init 20140103
-! impaction sur la surface de la colonne de la descente insaturee
-! On prend la moyenne des precip entre le niveau i+1 et i
-! I=3/4* (P(1+1)+P(i))/2 / (sigd*r*rho_l)
-!  1000kg/m3= densité de l'eau
-! 0.75e-3 = 3/4 /1000
-! Par la suite, I est tout le temps multiplié par sig_d pour avoir l'impaction sur la surface de la maille
-! on le néglige ici pour simplifier le code
-  do j=1,klev-1
-   do i=1,klon
-!JE    imp(i,j) = coefcoli*0.75e-3/rdrop *&
-!JE             0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
-    imp(i,j) = coefcoli3d(i,j)*0.75e-3/rdrop *&
-             0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
-!    rho(i,j)=pplay(i,j)/(rd*te(i,j))
-   enddo
-  enddo
-!JE end 20140103
-
-
-! =========================================
-! calcul des tendances liees au downdraft
-! =========================================
-!cdir collapse
-  DO k=1,klev
-   DO j=1,klev
-    DO i=1,klon
-     zmd(i,j,k)=0.
-     za (i,j,k)=0.
-    END DO
-   END DO
-  END DO
-! calcul de la matrice d echange
-! matrice de distribution de la masse entrainee en k
-! commmentaire RomP : mp > 0
-  DO k=1,klev-1
-     DO i=1,klon
-        zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1))   ! ~ mk(k)
-     END DO
-  END DO
-  DO k=2,klev
-     DO j=k-1,1,-1
-        DO i=1,klon
-           if(mp(i,j+1).gt.1.e-10) then
-              zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1)) !det ~ mk(j)=mk(j+1)*mp(i,j)/mp(i,j+1)
-           ENDif
-        END DO
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-           za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
-        END DO
-     END DO
-  END DO
-!!!!! quantite  de traceur dans la descente d'air insaturee  :   4 juin 2012
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-        if(mp(i,j+1).gt.1.e-10) then
-          qTrdi(i,j+1,it)=qTrdi(i,j+1,it)+(zmd(i,j+1,k)/mp(i,j+1))*tr(i,k,it)
-        else
-          qTrdi(i,j,it)=0.!tr(i,j,it)
-        endif
-        ENDDO
-     ENDDO
-  ENDDO
-!!!!!
-!
-! rajout du terme lie a l ascendance induite
-!
-  DO j=2,klev
-     DO i=1,klon
-        za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
-     END DO
-  END DO
-!
-! tendance courants insatures  ! sans lessivage ancien schema
-!
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfd(i,j,it)=zmfd(i,j,it)+za(i,j,k)*(tr(i,k,it)-tr(i,j,it))
-        END DO
-     END DO
-  END DO
-!
-! =========================================
-! calcul des tendances liees aux courants satures   j <-> z ; k <-> z'
-! =========================================
-!RL
-!  Feeding concentrations
-  DO j=1,klev
-     DO i=1,klon
-        qfeed(i,it)=qfeed(i,it)+wght_cvfd(i,j)*tr(i,j,it)
-     END DO
-  END DO
-!RL
-!
-  DO j=1,klev
-     DO i=1,klon
-!RL
-!!        zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it))                     ! da
-        zmfa(i,j,it)=da(i,j)*(qfeed(i,it)-tr(i,j,it))                     ! da
-!RL
-     END DO
-  END DO
-!
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfp(i,j,it)=zmfp(i,j,it)+phi(i,j,k)*(tr(i,k,it)-tr(i,j,it))  ! phi
-        END DO
-     END DO
-  END DO
-! RomP ajout des matrices liees au lessivage
-  DO j=1,klev
-     DO i=1,klon
-        zmfd1a(i,j,it)=d1a(i,j)*tr(i,1,it)   ! da1
-        zmfdam(i,j,it)=dam(i,j)*tr(i,1,it)   ! dam
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-          zmfphi2(i,j,it)=zmfphi2(i,j,it)+phi2(i,j,k)*tr(i,k,it)  ! psi
-        END DO
-     END DO
-  END DO
-  DO j=1,klev-1
-     DO i=1,klon
-        zmfu(i,j,it)=max(0.,upd(i,j+1)+dnd(i,j+1))*(tr(i,j+1,it)-tr(i,j,it))
-     END DO
-  END DO
-  DO j=2,klev
-     DO i=1,klon
-        zmfu(i,j,it)=zmfu(i,j,it)+min(0.,upd(i,j)+dnd(i,j))*(tr(i,j,it)-tr(i,j-1,it))
-     END DO
-  END DO
-! ===================================================
-! calcul des tendances liees aux courants insatures
-! ===================================================
-!  pression  
-  DO k=1, klev
-     DO i=1, klon
-        dxpres(i,k)=paprs(i,k)-paprs(i,k+1)
-     ENDDO
-  ENDDO
-  pdtimeRG=pdtime*RG
-
-! q_pa et q_pm    traceurs issues des courants satures se retrouvant dans les precipitations
-  DO j=1,klev
-     DO i=1,klon
-        if(j.ge.icb(i).and.j.le.inb(i)) then
-          if(clw(i,j).gt.1.e-16) then
-!           qPa(i,j,it)=ccntrAA_coef*tr(i,1,it)/clw(i,j)
-           qPa(i,j,it)=ccntrAA_coef3d(i,j)*tr(i,1,it)/clw(i,j)
-          else
-           qPa(i,j,it)=0.
-          endif
-        endif
-     END DO
-  END DO
-
-! calcul de q_pm en 2 parties :
-! 1) calcul de sa valeur pour un niveau z' donne
-! 2) integration sur la verticale sur z'
-     DO j=1,klev
-      DO k=1,j-1
-        DO i=1,klon
-        if(k.ge.icb(i).and.k.le.inb(i).and.& 
-           j.le.inb(i)) then
-            if(elij(i,k,j).gt.1.e-16) then
-!JE             qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_coef*tr(i,1,it)&
-!JE                         *(1.-sij(i,k,j))  +ccntrENV_coef&
-!JE                         *tr(i,k,it)*sij(i,k,j)) / elij(i,k,j)
-             qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_coef3d(i,k)*tr(i,1,it)&
-                         *(1.-sij(i,k,j))  +ccntrENV_coef3d(i,k)&
-                         *tr(i,k,it)*sij(i,k,j)) / elij(i,k,j)
-            else
-             qMeltmp(i,j,it)=0.
-            endif
-          qpmMint(i,j,it)=qpmMint(i,j,it) + qMeltmp(i,j,it)*epmlmMm(i,j,k)
-          Mint(i,j)=Mint(i,j) + epmlmMm(i,j,k)
-        endif ! end if dans nuage
-        END DO
-     END DO
-  END DO
-
-     DO j=1,klev
-        DO i=1,klon
-          if(Mint(i,j).gt.1.e-16) then
-           qMel(i,j,it)=qpmMint(i,j,it)/Mint(i,j)
-          else
-           qMel(i,j,it)=0.
-          endif
-     END DO
-  END DO
-
-! calcul de q_d et q_p    traceurs de la descente precipitante 
-   DO j=klev-1,1,-1
-    DO i=1,klon
-     if(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then  ! detrainement
-       kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))&
-                + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-             
-     elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then! entrainement
-       if(j.eq.1) then
-        kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                 (-mp(i,2)-imp(i,j)/RG*dxpres(i,j))&
-                 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-       else
-        kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-                 (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))&
-                 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
-       endif
-      else
-        kappa(i,j)=1.
-      endif
-    ENDDO
-   ENDDO
-
-  DO j=klev-1,1,-1
-   DO i=1,klon
-    if (abs(kappa(i,j)).lt.1.e-25) then    !si denominateur nul (il peut y avoir des mp!=0)
-     kappa(i,j)=1.
-     if(j.eq.1) then
-       qDi(i,j,it)=qDi(i,j+1,it) !orig tr(i,j,it)   ! mp(1)=0 donc tout vient de la couche supérieure
-     elseif(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then
-       qDi(i,j,it)=qDi(i,j+1,it)
-     elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then! entrainement
-       qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
-     else  ! si  mp (i)=0 et mp(j+1)=0
-       qDi(i,j,it)=tr(i,j,it) ! orig 0.
-     endif 
-
-      if(NO_precip(i,j)) then
-       qPr(i,j,it)=0.
-      else
-       qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                   Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                   +imp(i,j)/RG*dxpres(i,j)*qDi(i,j,it))/&
-                  (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-      endif
-    else   !     denominateur non nul
-     kappa(i,j)=1./kappa(i,j)     
-! calcul de qd et qp
-!!jyg  (20130119) correction pour le sommet du nuage
-!!     if(j.ge.inb(i)) then       !au-dessus du nuage, sommet inclu
-     if(j.gt.inb(i)) then       !au-dessus du nuage
-       qDi(i,j,it)=tr(i,j,it)   ! pas de descente => environnement = descente insaturee
-       qPr(i,j,it)=0.
-
-!  vvv premiere couche du modele ou mp(1)=0  ! det tout le temps  vvv
-     elseif(j.eq.1) then 
-      if(mp(i,2).gt.1.e-10) then !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
-       if(NO_precip(i,j)) then !pas de precip en (i)
-        qDi(i,j,it)=qDi(i,j+1,it)
-        qPr(i,j,it)=0.
-       else
-        qDi(i,j,it)=kappa(i,j)*(&
-            (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-            (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-            (-mp(i,j+1)*qDi(i,j+1,it)))
-
-        qPr(i,j,it)=kappa(i,j)*(&
-            (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*&
-            ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-            +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j)))
-       endif
-
-      else !mp(2) nul -> plus de descente insaturee -> pluie agit sur environnement
-        qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
-         qPr(i,j,it)=0.
-        else
-         qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                   Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                   +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/&
-                  (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-        endif
-
-      endif  !mp(2) nul ou non
-
-! vvv  (j!=1.and.j.lt.inb(i))  en-dessous du sommet nuage   vvv
-     else 
-!------------------------------------------------------------- detrainement 
-      if(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then !mp(i,j).gt.1.e-10) then
-         if(NO_precip(i,j)) then 
-          qDi(i,j,it)=qDi(i,j+1,it)
-          qPr(i,j,it)=0.
-         else
-          qDi(i,j,it)=kappa(i,j)*(&
-            (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-            (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-            (-mp(i,j+1)*qDi(i,j+1,it)))
-!
-          qPr(i,j,it)=kappa(i,j)*(&
-            (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*&
-            ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-            +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j)))
-         endif !precip
-!------------------------------------------------------------- entrainement 
-      elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then 
-         if(NO_precip(i,j)) then
-          qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
-          qPr(i,j,it)=0.
-         else
-          qDi(i,j,it)=kappa(i,j)*(&
-            (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +&
-            (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
-            (-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it)))
-!
-          qPr(i,j,it)=kappa(i,j)*(&
-            (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))*&
-            ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-            Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))&
-            +(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))*&
-            (imp(i,j)/RG*dxpres(i,j)))
-         endif !precip
-!------------------------------------------------------------- endif ! ent/det
-      else  !mp nul
-        qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
-         qPr(i,j,it)=0.
-        else
-         qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+&
-                   Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)&
-                   +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/&
-                  (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))
-        endif
-      endif ! mp nul ou non
-     endif ! condition sur j
-    endif ! kappa
-   ENDDO
-  ENDDO
-
-!! print test descente insaturee
-!  DO j=klev,1,-1
-!   DO i=1,klon
-!     if(it.eq.3) then
-!   write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') j,&
-!!         'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),&
-!          'zmfdam+zmfpsi',zmfdam(i,j,it)+zmfphi2(i,j,it),'qpmMint',qpmMint(i,j,it),&
-!          'Pm',Pm(i,j),'Mint',Mint(i,j),&
-!!          'zmfa',zmfa(i,j,it),'zmfp',zmfp(i,j,it),&
-!        'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),'zmfd1a',zmfd1a(i,j,it)
-!!          'Pa',Pa(i,j),'eplaMm',eplaMm(i,j)
-!!         'zmfd1a=da1*qa',zmfd1a(i,j,it),'Pa*qPa',wdtrainA(i,j)*qPa(i,j,it),'da1',d1a(i,j)
-!     endif
-!   ENDDO
-!  ENDDO
-
-
-! ===================================================
-! calcul final des tendances
-! ===================================================
-
-  DO k=klev-1,1,-1
-    DO i=1, klon
-! transport
-     tdcvMA=zmfd(i,k,it)+zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it)   ! double comptage des downdraft insatures
-     trsptrac=zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it)
-! lessivage courants satures
-!JE     scavtrac=-ccntrAA_coef*zmfd1a(i,k,it)&
-!JE               -zmfphi2(i,k,it)*ccntrENV_coef&
-!JE               -zmfdam(i,k,it)*ccntrAA_coef
-     scavtrac=-ccntrAA_coef3d(i,k)*zmfd1a(i,k,it)&
-               -zmfphi2(i,k,it)*ccntrENV_coef3d(i,k)&
-               -zmfdam(i,k,it)*ccntrAA_coef3d(i,k)
-! lessivage courants insatures
-   if(k.le.inb(i).and.k.gt.1) then   ! tendances dans le nuage
-!------------------------------------------------------------- detrainement
-      if(mp(i,k+1).gt.mp(i,k).and.mp(i,k+1).gt.1.e-10) then
-        uscavtrac= (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))&
-                   + mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
-!
-!        if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
-!                    (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
-!                    mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
-!                    'mp',mp(i,k)
-!------------------------------------------------------------- entrainement 
-      elseif(mp(i,k).gt.mp(i,k+1).and.mp(i,k).gt.1.e-10) then
-         uscavtrac= mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
-!
-!         if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-!=!------------------------------------------------------------- end ent/det 
-      else !        mp(i,k+1)=0. et mp(i,k)=0.    pluie directement sur l environnement
-
-        if(NO_precip(i,k)) then
-          uscavtrac=0.
-!         if(it.eq.3) write(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-        else
-          uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-!         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-!!JE adds
-!         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'imp',imp(i,k)
-!         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'tr',tr(i,k,it)
-!         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'evap',evap(i,k)
-!         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'qPr',qPr(i,k,it)
-!         if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'dxpres',dxpres(i,k)
-!!Je end
-
-        endif
-      endif  ! mp/det/ent
-!------------------------------------------------------------- premiere couche 
-   elseif(k.eq.1) then  !                                      mp(1)=0.
-      if(mp(i,2).gt.1.e-10) then  !detrainement
-         uscavtrac= (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it)) !&
-!                   + mp(i,2)*(0.-tr(i,k,it))
-!
-!       if(it.eq.3) write(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
-!                  (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
-!                  mp(i,2)*(0.-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
-!                   'mp',mp(i,k)
-      else   ! mp(2) = 0 = mp(1) pas de descente insaturee, rien ne se passe s'il ne pleut pas, sinon pluie->env
-        if(NO_precip(i,1)) then
-          uscavtrac=0.
-        else
-          uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-        endif
-!         if(it.eq.3) write(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
-      endif
-
-   else   ! k > INB  au-dessus du nuage
-    uscavtrac=0.
-   endif
-
-! =====    tendances finales  ======
-     trsptd(i,k,it)=trsptrac*pdtimeRG/dxpres(i,k)              ! td transport sans eau dans courants satures
-     dtrSscav(i,k,it)=scavtrac*pdtimeRG/dxpres(i,k)            ! td du lessivage dans courants satures
-     dtrUscav(i,k,it)=uscavtrac*pdtimeRG/dxpres(i,k)           ! td courant insat
-     dtrsat(i,k,it)=(trsptrac+scavtrac)*pdtimeRG/dxpres(i,k)   ! td courant sat
-     dtrcv(i,k,it)=(trsptrac+scavtrac+uscavtrac)*pdtimeRG/dxpres(i,k)!dtrsat(i,k,it)+dtrUscav(i,k,it)         td conv
-!!!!!!
-     dtrcvMA(i,k,it)=tdcvMA*pdtimeRG/dxpres(i,k) ! MA tendance convection
-     ENDDO
-  ENDDO
-
-! test de conservation du traceur
-!print*,"_____________________________________________________________"
-!print*,"                                                             "
-!      conserv=0.
-!      conservMA=0.
-!      DO k= klev-1,1,-1
-!        DO i=1, klon
-!         conserv=conserv+dtrcv(i,k,it)*   &
-!        (paprs(i,k)-paprs(i,k+1))/RG
-!         conservMA=conservMA+dtrcvMA(i,k,it)*   &
-!        (paprs(i,k)-paprs(i,k+1))/RG
-!
-!      if(it.eq.3)  write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
-!         'MA td ',dtrcvMA(i,k,it)*dxpres(i,k)/RG,&
-!         ' td',dtrcv(i,k,it)*dxpres(i,k)/RG,'         conservMA ',conservMA,'conserv ',conserv
-!!
-!        ENDDO
-!      ENDDO
-!       if(it.eq.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
-
-END SUBROUTINE cvltr_spl
+link ../phylmd/cvltr_spl.F90
Index: LMDZ6/trunk/libf/phylmdiso/cvltrorig.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvltrorig.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvltrorig.F90	(revision 3940)
@@ -1,166 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE cvltrorig(it,pdtime,da, phi, mp,paprs,pplay,x,upd,dnd,dx)
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr
-  IMPLICIT NONE 
-!=====================================================================
-! Objet : convection des traceurs / KE
-! Auteurs: M-A Filiberti and J-Y Grandpeix
-!=====================================================================
-  include "YOMCST.h"
-  include "YOECUMF.h" 
-
-! Entree
-  REAL,INTENT(IN)                           :: pdtime
-  INTEGER, INTENT(IN)                       :: it
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: da
-  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: mp
-  REAL,DIMENSION(klon,klev+1),INTENT(IN)    :: paprs ! pression aux 1/2 couches (bas en haut)
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pplay ! pression pour le milieu de chaque couche
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)      :: x     ! q de traceur (bas en haut) 
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: upd   ! saturated updraft mass flux
-  REAL,DIMENSION(klon,klev),INTENT(IN)      :: dnd   ! saturated downdraft mass flux
-
-! Sortie
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dx ! tendance de traceur  (bas en haut)
-
-! Variables locales     
-! REAL,DIMENSION(klon,klev)       :: zed
-  REAL,DIMENSION(klon,klev,klev)  :: zmd
-  REAL,DIMENSION(klon,klev,klev)  :: za
-  REAL,DIMENSION(klon,klev)       :: zmfd,zmfa
-  REAL,DIMENSION(klon,klev)       :: zmfp,zmfu
-  REAL,DIMENSION(klon,klev)       :: deltap
-  INTEGER                         :: i,k,j 
-  REAL                            :: pdtimeRG
-!!  real conserv
-
-! =========================================
-! calcul des tendances liees au downdraft
-! =========================================
-!cdir collapse
-  DO j=1,klev
-  DO i=1,klon
-!   zed(i,j)=0.
-    zmfd(i,j)=0.
-    zmfa(i,j)=0.
-    zmfu(i,j)=0.
-    zmfp(i,j)=0.
-  END DO
-  END DO
-!cdir collapse
-  DO k=1,klev
-  DO j=1,klev
-  DO i=1,klon
-    zmd(i,j,k)=0.
-    za (i,j,k)=0.
-  END DO
-  END DO
-  END DO
-! entrainement
-! DO k=1,klev-1
-!    DO i=1,klon
-!       zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
-!    END DO
-! END DO
-
-! calcul de la matrice d echange
-! matrice de distribution de la masse entrainee en k
-
-  DO k=1,klev-1
-     DO i=1,klon
-        zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1))
-     END DO
-  END DO
-  DO k=2,klev
-     DO j=k-1,1,-1
-        DO i=1,klon
-           if(mp(i,j+1).ne.0) then
-              zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
-           ENDif
-        END DO
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev-1
-        DO i=1,klon
-           za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
-        END DO
-     END DO
-  END DO
-!
-! rajout du terme lie a l ascendance induite
-!
-  DO j=2,klev
-     DO i=1,klon
-        za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
-     END DO
-  END DO
-!
-! tendances
-!            
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k,it)-x(i,j,it))
-        END DO
-     END DO
-  END DO
-!
-! =========================================
-! calcul des tendances liees aux flux satures
-! =========================================
-  DO j=1,klev
-     DO i=1,klon
-        zmfa(i,j)=da(i,j)*(x(i,1,it)-x(i,j,it))
-     END DO
-  END DO
-  DO k=1,klev
-     DO j=1,klev
-        DO i=1,klon
-           zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k,it)-x(i,j,it))
-        END DO
-     END DO
-  END DO
-  DO j=1,klev-1
-     DO i=1,klon
-        zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1,it)-x(i,j,it))
-     END DO
-  END DO
-  DO j=2,klev
-     DO i=1,klon
-        zmfu(i,j)=zmfu(i,j)+min(0.,upd(i,j)+dnd(i,j))*(x(i,j,it)-x(i,j-1,it))
-     END DO
-  END DO
-
-! =========================================
-! calcul final des tendances
-! =========================================
-  DO k=1, klev
-     DO i=1, klon
-        deltap(i,k)=paprs(i,k)-paprs(i,k+1)
-     ENDDO
-  ENDDO
-  pdtimeRG=pdtime*RG
-!cdir collapse
-  DO k=1, klev
-     DO i=1, klon
-        dx(i,k,it)=(zmfd(i,k)+zmfu(i,k)       &
-                +zmfa(i,k)+zmfp(i,k))*pdtimeRG/deltap(i,k)
-     ENDDO
-  ENDDO
-
-! test de conservation du traceur
-!      conserv=0.
-!      DO k=1, klev
-!        DO i=1, klon
-!         conserv=conserv+dx(i,k,it)*   &
-!          deltap(i,k)/RG
-!        ENDDO
-!      ENDDO
-!      print *,'it',it,'cvltrorig conserv',conserv
-     
-END SUBROUTINE cvltrorig
+link ../phylmd/cvltrorig.F90
Index: LMDZ6/trunk/libf/phylmdiso/cvparam.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvparam.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvparam.h	(revision 3940)
@@ -1,29 +1,1 @@
-!
-! $Header$
-!
-!------------------------------------------------------------
-! Parameters for convectL:
-! (includes - microphysical parameters, 
-!			- parameters that control the rate of approach 
-!               to quasi-equilibrium)
-!			- noff & minorig (previously in input of convect1)
-!------------------------------------------------------------
-
-      integer noff, minorig, nl, nlp, nlm
-      real elcrit, tlcrit
-      real entp
-      real sigs, sigd
-      real omtrain, omtsnow, coeffr, coeffs
-      real dtmax
-      real cu
-      real betad
-      real alpha, damp
-      real delta
-
-      COMMON /cvparam/ noff, minorig, nl, nlp, nlm &
-                      ,elcrit, tlcrit &
-                      ,entp, sigs, sigd &
-                      ,omtrain, omtsnow, coeffr, coeffs &
-                      ,dtmax, cu, betad, alpha, damp, delta
-
-!$OMP THREADPRIVATE(/cvparam/)
+link ../phylmd/cvparam.h
Index: LMDZ6/trunk/libf/phylmdiso/cvthermo.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/cvthermo.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/cvthermo.h	(revision 3940)
@@ -1,16 +1,1 @@
-!
-! $Header$
-!
-! Thermodynamical constants for convectL:
-
-      real cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0
-      real clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl, clmci
-      real eps, epsi, epsim1
-      real ginv, hrd
-      real grav
-
-      COMMON /cvthermo/ cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl &
-                       ,t0, clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl  &
-                       ,clmci, eps, epsi, epsim1, ginv, hrd, grav
-
-!$OMP THREADPRIVATE(/cvthermo/)
+link ../phylmd/cvthermo.h
Index: LMDZ6/trunk/libf/phylmdiso/declare_STDlev.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/declare_STDlev.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/declare_STDlev.h	(revision 3940)
@@ -1,61 +1,1 @@
-!IM for NMC files
-!      real twriteSTD(klon,nlevSTD,nfiles)
-!      real qwriteSTD(klon,nlevSTD,nfiles)
-!      real rhwriteSTD(klon,nlevSTD,nfiles)
-!      real phiwriteSTD(klon,nlevSTD,nfiles)
-!      real uwriteSTD(klon,nlevSTD,nfiles)
-!      real vwriteSTD(klon,nlevSTD,nfiles)
-!      real wwriteSTD(klon,nlevSTD,nfiles)
-
-      real twriteSTD3(klon,nlevSTD3)
-      real qwriteSTD3(klon,nlevSTD3)
-      real rhwriteSTD3(klon,nlevSTD3)
-      real phiwriteSTD3(klon,nlevSTD3)
-      real uwriteSTD3(klon,nlevSTD3)
-      real vwriteSTD3(klon,nlevSTD3)
-      real wwriteSTD3(klon,nlevSTD3)
-
-      real tnondefSTD8(klon,nlevSTD8)
-      real twriteSTD8(klon,nlevSTD8)
-      real qwriteSTD8(klon,nlevSTD8)
-      real rhwriteSTD8(klon,nlevSTD8)
-      real phiwriteSTD8(klon,nlevSTD8)
-      real uwriteSTD8(klon,nlevSTD8)
-      real vwriteSTD8(klon,nlevSTD8)
-      real wwriteSTD8(klon,nlevSTD8)
-
-      real, save :: rlevSTD(nlevSTD)
-      DATA rlevSTD/100000., 92500., 85000., 70000., &
-      60000., 50000., 40000., 30000., 25000., 20000., &
-      15000., 10000., 7000., 5000., 3000., 2000., 1000./
-!$OMP THREADPRIVATE(rlevstd)
-
-      CHARACTER*4, SAVE :: clevSTD(nlevSTD)
-      DATA clevSTD/'1000','925 ','850 ','700 ','600 ', &
-      '500 ','400 ','300 ','250 ','200 ','150 ','100 ', &
-      '70  ','50  ','30  ','20  ','10  '/
-!$OMP THREADPRIVATE(clevSTD)
-
-      real, save :: rlevSTD3(nlevSTD3)
-      DATA rlevSTD3/85000., 50000., 25000./
-!$OMP THREADPRIVATE(rlevSTD3)
-
-      real, save :: rlevSTD8(nlevSTD8)
-      DATA rlevSTD8/100000., 85000., 70000., 50000., 25000., 10000., &
-           5000., 1000./
-!$OMP THREADPRIVATE(rlevSTD8) 
-!
-      REAL geo500(klon)
-
-! nout : niveau de output des variables a une pression donnee
-      logical oknondef(klon,nlevSTD,nout)
-!
-! les produits uvSTD, vqSTD, .., T2STD sont calcules
-! a partir des valeurs instantannees toutes les 6 h
-! qui sont moyennees sur le mois
-
-      REAL zx_tmp_fiNC(klon,nlevSTD)
-
-!     REAL missing_val
-      REAL, SAVE :: freq_moyNMC(nout)
-!$OMP THREADPRIVATE(freq_moyNMC)
+link ../phylmd/declare_STDlev.h
Index: LMDZ6/trunk/libf/phylmdiso/diag_slp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/diag_slp.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/diag_slp.F90	(revision 3940)
@@ -1,45 +1,1 @@
-SUBROUTINE diag_slp(nlon,t,pab,pal,pphis,tasfc,tastd,pmer)
- USE dimphy
- USE phys_output_write_mod
- USE phys_output_ctrlout_mod
- USE phys_local_var_mod
- IMPLICIT NONE
-  !>======================================================================
-  !!
-  !! Auteur(s) I.Musat (LMD/CNRS) date: 20151106
-  !!
-  !! Objet: Calcul pression au niveau de la mer cf. Arpege-IFS 
-  !! ctstar: calcule la temperature de l'air a la surface (tasfc) et
-  !!                 la temperature de l'air standard a la surface (tastd)
-  !! pppmer: calcule la slp a partir de tasfc, tastd, de la pression a la surface (pab1)
-  !!                 et du geopotentiel de la surface
-  !!======================================================================
-  !! nlon--input-R-temperature au milieu de chaque couche (en K)
-  !! t--input-R-temperature au milieu de chaque couche (en K)
-  !! pab--input-R-pression pour chaque inter-couche (en Pa)
-  !! pal---input-R-pression pour le mileu de chaque couche (en Pa)
-  !! pphis---input-R-geopotentiel du sol (en m2/s2)
-  !! tasfc---output-R-temperature air au sol (en K)
-  !! tastd---output-R-temperature air 'standard' au sol (en K)
-  !! pmer---output-R-pression au niveau de la mer (en Pa)
-  !!======================================================================
-  INTEGER nlon
-  REAL t(nlon,klev)
-  REAL pab(nlon,klev+1)
-  REAL pal(nlon,klev)
-  REAL pphis(nlon)
-  REAL tasfc(nlon), tastd(nlon)
-  REAL pmer(nlon)
-!!!
-!!! calcul tasfc et tastd
-  tal1(:)=t(:,1)
-  pab2(:)=pab(:,2)
-  pal1(:)=pal(:,1)
-  CALL ctstar(nlon,1,nlon,tal1,pab2,pal1,pphis,tasfc,tastd)
-!!!
-!!! calcul slp
-  pab1(:)=pab(:,1)
-  CALL pppmer(nlon,1,nlon,pab1,pphis,tasfc,tastd,pmer)
-!
-  RETURN
-  END
+link ../phylmd/diag_slp.F90
Index: LMDZ6/trunk/libf/phylmdiso/diagphy.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/diagphy.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/diagphy.F90	(revision 3940)
@@ -1,402 +1,1 @@
-
-! $Header$
-
-SUBROUTINE diagphy(airephy, tit, iprt, tops, topl, sols, soll, sens, evap, &
-    rain_fall, snow_fall, ts, d_etp_tot, d_qt_tot, d_ec_tot, fs_bound, &
-    fq_bound)
-  ! ======================================================================
-
-  ! Purpose:
-  ! Compute the thermal flux and the watter mass flux at the atmosphere
-  ! boundaries. Print them and also the atmospheric enthalpy change and
-  ! the  atmospheric mass change.
-
-  ! Arguments:
-  ! airephy-------input-R-  grid area
-  ! tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)
-  ! iprt--------input-I-  PRINT level ( <=0 : no PRINT)
-  ! tops(klon)--input-R-  SW rad. at TOA (W/m2), positive up.
-  ! topl(klon)--input-R-  LW rad. at TOA (W/m2), positive down
-  ! sols(klon)--input-R-  Net SW flux above surface (W/m2), positive up
-  ! (i.e. -1 * flux absorbed by the surface)
-  ! soll(klon)--input-R-  Net LW flux above surface (W/m2), positive up
-  ! (i.e. flux emited - flux absorbed by the surface)
-  ! sens(klon)--input-R-  Sensible Flux at surface  (W/m2), positive down
-  ! evap(klon)--input-R-  Evaporation + sublimation watter vapour mass flux
-  ! (kg/m2/s), positive up
-  ! rain_fall(klon)
-  ! --input-R- Liquid  watter mass flux (kg/m2/s), positive down
-  ! snow_fall(klon)
-  ! --input-R- Solid  watter mass flux (kg/m2/s), positive down
-  ! ts(klon)----input-R- Surface temperature (K)
-  ! d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy
-  ! change (W/m2)
-  ! d_qt_tot----input-R- Mass flux equivalent to atmospheric watter mass
-  ! change (kg/m2/s)
-  ! d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy
-  ! change (W/m2)
-
-  ! fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)
-  ! fq_bound---output-R- Watter mass flux at the atmosphere boundaries
-  ! (kg/m2/s)
-
-  ! J.L. Dufresne, July 2002
-  ! Version prise sur
-  ! ~rlmd833/LMDZOR_201102/modipsl/modeles/LMDZ.3.3/libf/phylmd
-  ! le 25 Novembre 2002.
-  ! ======================================================================
-
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-
-  ! Input variables
-  REAL airephy(klon)
-  CHARACTER *15 tit
-  INTEGER iprt
-  REAL tops(klon), topl(klon), sols(klon), soll(klon)
-  REAL sens(klon), evap(klon), rain_fall(klon), snow_fall(klon)
-  REAL ts(klon)
-  REAL d_etp_tot, d_qt_tot, d_ec_tot
-  ! Output variables
-  REAL fs_bound, fq_bound
-
-  ! Local variables
-  REAL stops, stopl, ssols, ssoll
-  REAL ssens, sfront, slat
-  REAL airetot, zcpvap, zcwat, zcice
-  REAL rain_fall_tot, snow_fall_tot, evap_tot
-
-  INTEGER i
-
-  INTEGER pas
-  SAVE pas
-  DATA pas/0/
-  !$OMP THREADPRIVATE(pas)
-
-  pas = pas + 1
-  stops = 0.
-  stopl = 0.
-  ssols = 0.
-  ssoll = 0.
-  ssens = 0.
-  sfront = 0.
-  evap_tot = 0.
-  rain_fall_tot = 0.
-  snow_fall_tot = 0.
-  airetot = 0.
-
-  ! Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de
-  ! la glace, on travaille par difference a la chaleur specifique de l'
-  ! air sec. En effet, comme on travaille a niveau de pression donne,
-  ! toute variation de la masse d'un constituant est totalement
-  ! compense par une variation de masse d'air.
-
-  zcpvap = rcpv - rcpd
-  zcwat = rcw - rcpd
-  zcice = rcs - rcpd
-
-  DO i = 1, klon
-    stops = stops + tops(i)*airephy(i)
-    stopl = stopl + topl(i)*airephy(i)
-    ssols = ssols + sols(i)*airephy(i)
-    ssoll = ssoll + soll(i)*airephy(i)
-    ssens = ssens + sens(i)*airephy(i)
-    sfront = sfront + (evap(i)*zcpvap-rain_fall(i)*zcwat-snow_fall(i)*zcice)* &
-      ts(i)*airephy(i)
-    evap_tot = evap_tot + evap(i)*airephy(i)
-    rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)
-    snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)
-    airetot = airetot + airephy(i)
-  END DO
-  stops = stops/airetot
-  stopl = stopl/airetot
-  ssols = ssols/airetot
-  ssoll = ssoll/airetot
-  ssens = ssens/airetot
-  sfront = sfront/airetot
-  evap_tot = evap_tot/airetot
-  rain_fall_tot = rain_fall_tot/airetot
-  snow_fall_tot = snow_fall_tot/airetot
-
-  slat = rlvtt*rain_fall_tot + rlstt*snow_fall_tot
-  ! Heat flux at atm. boundaries
-  fs_bound = stops - stopl - (ssols+ssoll) + ssens + sfront + slat
-  ! Watter flux at atm. boundaries
-  fq_bound = evap_tot - rain_fall_tot - snow_fall_tot
-
-  IF (iprt>=1) WRITE (6, 6666) tit, pas, fs_bound, d_etp_tot, fq_bound, &
-    d_qt_tot
-
-  IF (iprt>=1) WRITE (6, 6668) tit, pas, d_etp_tot + d_ec_tot - fs_bound, &
-    d_qt_tot - fq_bound
-
-  IF (iprt>=2) WRITE (6, 6667) tit, pas, stops, stopl, ssols, ssoll, ssens, &
-    slat, evap_tot, rain_fall_tot + snow_fall_tot
-
-  RETURN
-
-6666 FORMAT ('Phys. Flux Budget ', A15, 1I6, 2F8.2, 2(1PE13.5))
-6667 FORMAT ('Phys. Boundary Flux ', A15, 1I6, 6F8.2, 2(1PE13.5))
-6668 FORMAT ('Phys. Total Budget ', A15, 1I6, F8.2, 2(1PE13.5))
-
-END SUBROUTINE diagphy
-
-! ======================================================================
-SUBROUTINE diagetpq(airephy, tit, iprt, idiag, idiag2, dtime, t, q, ql, qs, &
-    u, v, paprs, pplay, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-  ! ======================================================================
-
-  ! Purpose:
-  ! Calcul la difference d'enthalpie et de masse d'eau entre 2 appels,
-  ! et calcul le flux de chaleur et le flux d'eau necessaire a ces
-  ! changements. Ces valeurs sont moyennees sur la surface de tout
-  ! le globe et sont exprime en W/2 et kg/s/m2
-  ! Outil pour diagnostiquer la conservation de l'energie
-  ! et de la masse dans la physique. Suppose que les niveau de
-  ! pression entre couche ne varie pas entre 2 appels.
-
-  ! Plusieurs de ces diagnostics peuvent etre fait en parallele: les
-  ! bilans sont sauvegardes dans des tableaux indices. On parlera
-  ! "d'indice de diagnostic"
-
-
-  ! ======================================================================
-  ! Arguments:
-  ! airephy-------input-R-  grid area
-  ! tit-----imput-A15- Comment added in PRINT (CHARACTER*15)
-  ! iprt----input-I-  PRINT level ( <=1 : no PRINT)
-  ! idiag---input-I- indice dans lequel sera range les nouveaux
-  ! bilans d' entalpie et de masse
-  ! idiag2--input-I-les nouveaux bilans d'entalpie et de masse
-  ! sont compare au bilan de d'enthalpie de masse de
-  ! l'indice numero idiag2
-  ! Cas parriculier : si idiag2=0, pas de comparaison, on
-  ! sort directement les bilans d'enthalpie et de masse
-  ! dtime----input-R- time step (s)
-  ! t--------input-R- temperature (K)
-  ! q--------input-R- vapeur d'eau (kg/kg)
-  ! ql-------input-R- liquid watter (kg/kg)
-  ! qs-------input-R- solid watter (kg/kg)
-  ! u--------input-R- vitesse u
-  ! v--------input-R- vitesse v
-  ! paprs----input-R- pression a intercouche (Pa)
-  ! pplay----input-R- pression au milieu de couche (Pa)
-
-  ! the following total value are computed by UNIT of earth surface
-
-  ! d_h_vcol--output-R- Heat flux (W/m2) define as the Enthalpy
-  ! change (J/m2) during one time step (dtime) for the whole
-  ! atmosphere (air, watter vapour, liquid and solid)
-  ! d_qt------output-R- total water mass flux (kg/m2/s) defined as the
-  ! total watter (kg/m2) change during one time step (dtime),
-  ! d_qw------output-R- same, for the watter vapour only (kg/m2/s)
-  ! d_ql------output-R- same, for the liquid watter only (kg/m2/s)
-  ! d_qs------output-R- same, for the solid watter only (kg/m2/s)
-  ! d_ec------output-R- Cinetic Energy Budget (W/m2) for vertical air column
-
-  ! other (COMMON...)
-  ! RCPD, RCPV, ....
-
-  ! J.L. Dufresne, July 2002
-  ! ======================================================================
-
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-
-  ! Input variables
-  REAL airephy(klon)
-  CHARACTER *15 tit
-  INTEGER iprt, idiag, idiag2
-  REAL dtime
-  REAL t(klon, klev), q(klon, klev), ql(klon, klev), qs(klon, klev)
-  REAL u(klon, klev), v(klon, klev)
-  REAL paprs(klon, klev+1), pplay(klon, klev)
-  ! Output variables
-  REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
-
-  ! Local variables
-
-  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_vcol_tot--  total enthalpy of vertical air column
-  ! (air with watter vapour, liquid and solid) (J/m2)
-  ! h_dair_tot-- total enthalpy of dry air (J/m2)
-  ! h_qw_tot----  total enthalpy of watter vapour (J/m2)
-  ! h_ql_tot----  total enthalpy of liquid watter (J/m2)
-  ! h_qs_tot----  total enthalpy of solid watter  (J/m2)
-  ! qw_tot------  total mass of watter vapour (kg/m2)
-  ! ql_tot------  total mass of liquid watter (kg/m2)
-  ! qs_tot------  total mass of solid watter (kg/m2)
-  ! ec_tot------  total cinetic energy (kg/m2)
-
-  REAL zairm(klon, klev) ! layer air mass (kg/m2)
-  REAL zqw_col(klon)
-  REAL zql_col(klon)
-  REAL zqs_col(klon)
-  REAL zec_col(klon)
-  REAL zh_dair_col(klon)
-  REAL zh_qw_col(klon), zh_ql_col(klon), zh_qs_col(klon)
-
-  REAL d_h_dair, d_h_qw, d_h_ql, d_h_qs
-
-  REAL airetot, zcpvap, zcwat, zcice
-
-  INTEGER i, k
-
-  INTEGER ndiag ! max number of diagnostic in parallel
-  PARAMETER (ndiag=10)
-  INTEGER pas(ndiag)
-  SAVE pas
-  DATA pas/ndiag*0/
-  !$OMP THREADPRIVATE(pas)
-
-  REAL h_vcol_pre(ndiag), h_dair_pre(ndiag), h_qw_pre(ndiag), &
-    h_ql_pre(ndiag), h_qs_pre(ndiag), qw_pre(ndiag), ql_pre(ndiag), &
-    qs_pre(ndiag), ec_pre(ndiag)
-  SAVE h_vcol_pre, h_dair_pre, h_qw_pre, h_ql_pre, h_qs_pre, qw_pre, ql_pre, &
-    qs_pre, ec_pre
-  !$OMP THREADPRIVATE(h_vcol_pre, h_dair_pre, h_qw_pre, h_ql_pre)
-  !$OMP THREADPRIVATE(h_qs_pre, qw_pre, ql_pre, qs_pre , ec_pre)
-  ! ======================================================================
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ! layer air mass
-      zairm(i, k) = (paprs(i,k)-paprs(i,k+1))/rg
-    END DO
-  END DO
-
-  ! Reset variables
-  DO i = 1, klon
-    zqw_col(i) = 0.
-    zql_col(i) = 0.
-    zqs_col(i) = 0.
-    zec_col(i) = 0.
-    zh_dair_col(i) = 0.
-    zh_qw_col(i) = 0.
-    zh_ql_col(i) = 0.
-    zh_qs_col(i) = 0.
-  END DO
-
-  zcpvap = rcpv
-  zcwat = rcw
-  zcice = rcs
-
-  ! Compute vertical sum for each atmospheric column
-  ! ================================================
-  DO k = 1, klev
-    DO i = 1, klon
-      ! Watter mass
-      zqw_col(i) = zqw_col(i) + q(i, k)*zairm(i, k)
-      zql_col(i) = zql_col(i) + ql(i, k)*zairm(i, k)
-      zqs_col(i) = zqs_col(i) + qs(i, k)*zairm(i, k)
-      ! Cinetic Energy
-      zec_col(i) = zec_col(i) + 0.5*(u(i,k)**2+v(i,k)**2)*zairm(i, k)
-      ! Air enthalpy
-      zh_dair_col(i) = zh_dair_col(i) + rcpd*(1.-q(i,k)-ql(i,k)-qs(i,k))* &
-        zairm(i, k)*t(i, k)
-      zh_qw_col(i) = zh_qw_col(i) + zcpvap*q(i, k)*zairm(i, k)*t(i, k)
-      zh_ql_col(i) = zh_ql_col(i) + zcwat*ql(i, k)*zairm(i, k)*t(i, k) - &
-        rlvtt*ql(i, k)*zairm(i, k)
-      zh_qs_col(i) = zh_qs_col(i) + zcice*qs(i, k)*zairm(i, k)*t(i, k) - &
-        rlstt*qs(i, k)*zairm(i, k)
-
-    END DO
-  END DO
-
-  ! Mean over the planete surface
-  ! =============================
-  qw_tot = 0.
-  ql_tot = 0.
-  qs_tot = 0.
-  ec_tot = 0.
-  h_vcol_tot = 0.
-  h_dair_tot = 0.
-  h_qw_tot = 0.
-  h_ql_tot = 0.
-  h_qs_tot = 0.
-  airetot = 0.
-
-  DO i = 1, klon
-    qw_tot = qw_tot + zqw_col(i)*airephy(i)
-    ql_tot = ql_tot + zql_col(i)*airephy(i)
-    qs_tot = qs_tot + zqs_col(i)*airephy(i)
-    ec_tot = ec_tot + zec_col(i)*airephy(i)
-    h_dair_tot = h_dair_tot + zh_dair_col(i)*airephy(i)
-    h_qw_tot = h_qw_tot + zh_qw_col(i)*airephy(i)
-    h_ql_tot = h_ql_tot + zh_ql_col(i)*airephy(i)
-    h_qs_tot = h_qs_tot + zh_qs_col(i)*airephy(i)
-    airetot = airetot + airephy(i)
-  END DO
-
-  qw_tot = qw_tot/airetot
-  ql_tot = ql_tot/airetot
-  qs_tot = qs_tot/airetot
-  ec_tot = ec_tot/airetot
-  h_dair_tot = h_dair_tot/airetot
-  h_qw_tot = h_qw_tot/airetot
-  h_ql_tot = h_ql_tot/airetot
-  h_qs_tot = h_qs_tot/airetot
-
-  h_vcol_tot = h_dair_tot + h_qw_tot + h_ql_tot + h_qs_tot
-
-  ! Compute the change of the atmospheric state compare to the one
-  ! stored in "idiag2", and convert it in flux. THis computation
-  ! is performed IF idiag2 /= 0 and IF it is not the first CALL
-  ! for "idiag"
-  ! ===================================
-
-  IF ((idiag2>0) .AND. (pas(idiag2)/=0)) THEN
-    d_h_vcol = (h_vcol_tot-h_vcol_pre(idiag2))/dtime
-    d_h_dair = (h_dair_tot-h_dair_pre(idiag2))/dtime
-    d_h_qw = (h_qw_tot-h_qw_pre(idiag2))/dtime
-    d_h_ql = (h_ql_tot-h_ql_pre(idiag2))/dtime
-    d_h_qs = (h_qs_tot-h_qs_pre(idiag2))/dtime
-    d_qw = (qw_tot-qw_pre(idiag2))/dtime
-    d_ql = (ql_tot-ql_pre(idiag2))/dtime
-    d_qs = (qs_tot-qs_pre(idiag2))/dtime
-    d_ec = (ec_tot-ec_pre(idiag2))/dtime
-    d_qt = d_qw + d_ql + d_qs
-  ELSE
-    d_h_vcol = 0.
-    d_h_dair = 0.
-    d_h_qw = 0.
-    d_h_ql = 0.
-    d_h_qs = 0.
-    d_qw = 0.
-    d_ql = 0.
-    d_qs = 0.
-    d_ec = 0.
-    d_qt = 0.
-  END IF
-
-  IF (iprt>=2) THEN
-    WRITE (6, 9000) tit, pas(idiag), d_qt, d_qw, d_ql, d_qs
-9000 FORMAT ('Phys. Watter Mass Budget (kg/m2/s)', A15, 1I6, 10(1PE14.6))
-    WRITE (6, 9001) tit, pas(idiag), d_h_vcol
-9001 FORMAT ('Phys. Enthalpy Budget (W/m2) ', A15, 1I6, 10(F8.2))
-    WRITE (6, 9002) tit, pas(idiag), d_ec
-9002 FORMAT ('Phys. Cinetic Energy Budget (W/m2) ', A15, 1I6, 10(F8.2))
-  END IF
-
-  ! Store the new atmospheric state in "idiag"
-
-  pas(idiag) = pas(idiag) + 1
-  h_vcol_pre(idiag) = h_vcol_tot
-  h_dair_pre(idiag) = h_dair_tot
-  h_qw_pre(idiag) = h_qw_tot
-  h_ql_pre(idiag) = h_ql_tot
-  h_qs_pre(idiag) = h_qs_tot
-  qw_pre(idiag) = qw_tot
-  ql_pre(idiag) = ql_tot
-  qs_pre(idiag) = qs_tot
-  ec_pre(idiag) = ec_tot
-
-  RETURN
-END SUBROUTINE diagetpq
+link ../phylmd/diagphy.F90
Index: LMDZ6/trunk/libf/phylmdiso/dimpft.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/dimpft.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/dimpft.h	(revision 3940)
@@ -1,6 +1,1 @@
-!
-! $Id$
-!
-      INTEGER nvm_lmdz
-!      PARAMETER (nvm_lmdz=13)
-      COMMON /dimpft/ nvm_lmdz
+link ../phylmd/dimpft.h
Index: LMDZ6/trunk/libf/phylmdiso/dimphy.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/dimphy.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/dimphy.F90	(revision 3940)
@@ -1,62 +1,1 @@
-!
-! $Id: dimphy.F90 3442 2019-01-25 10:12:29Z fairhead $
-!
-  MODULE dimphy
-  
-  INTEGER,SAVE :: klon
-  INTEGER,SAVE :: kdlon
-  INTEGER,SAVE :: kfdia
-  INTEGER,SAVE :: kidia
-  INTEGER,SAVE :: klev
-  INTEGER,SAVE :: klevp1
-  INTEGER,SAVE :: klevm1
-  INTEGER,SAVE :: kflev
-
-!$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon)
-  REAL,save,allocatable,dimension(:) :: zmasq
-!$OMP THREADPRIVATE(zmasq)   
-
-CONTAINS
-  
-  SUBROUTINE Init_dimphy(klon0,klev0)
-  IMPLICIT NONE
-  
-    INTEGER, INTENT(in) :: klon0
-    INTEGER, INTENT(in) :: klev0
-    
-    klon=klon0
-    kdlon=klon
-    kidia=1
-    kfdia=klon
-!$OMP MASTER 
-    klev=klev0
-    klevp1=klev+1
-    klevm1=klev-1
-    kflev=klev
-!$OMP END MASTER    
-    ALLOCATE(zmasq(klon))    
-    zmasq=0.
-    
-  END SUBROUTINE Init_dimphy
-
-  SUBROUTINE Init_dimphy1D(klon0,klev0)
-! 1D special version of dimphy without ALLOCATE(zmasq)
-! which will be allocated in iniphysiq
-  IMPLICIT NONE
-  
-    INTEGER, INTENT(in) :: klon0
-    INTEGER, INTENT(in) :: klev0
-    
-    klon=klon0
-    kdlon=klon
-    kidia=1
-    kfdia=klon
-    klev=klev0
-    klevp1=klev+1
-    klevm1=klev-1
-    kflev=klev
-    
-  END SUBROUTINE Init_dimphy1D
-
-  
-END MODULE dimphy
+link ../phylmd/dimphy.F90
Index: LMDZ6/trunk/libf/phylmdiso/dimsoil.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/dimsoil.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/dimsoil.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER nsoilmx
-      PARAMETER (nsoilmx=11)
+link ../phylmd/dimsoil.h
Index: LMDZ6/trunk/libf/phylmdiso/ener_conserv.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ener_conserv.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ener_conserv.F90	(revision 3940)
@@ -1,259 +1,1 @@
-subroutine ener_conserv(klon,klev,pdtphys, &
- &                      puo,pvo,pto,pqo,pql0,pqs0, &
- &                      pun,pvn,ptn,pqn,pqln,pqsn,dtke,masse,exner,d_t_ec)
-
-!=============================================================
-! Energy conservation
-! Based on the TKE equation
-! The M2 and N2 terms at the origin of TKE production are
-! concerted into heating in the d_t_ec term
-! Option 1 is the standard
-!        101 is for M2 term only
-!        101 for N2 term only
-!         -1 is a previours treatment for kinetic energy only
-!  FH (hourdin@lmd.jussieu.fr), 2013/04/25
-!=============================================================
-
-!=============================================================
-! Declarations
-!=============================================================
-
-! From module
-USE phys_local_var_mod, ONLY : d_u_vdf,d_v_vdf,d_t_vdf,d_u_ajs,d_v_ajs,d_t_ajs, &
- &                             d_u_con,d_v_con,d_t_con,d_t_diss
-USE phys_local_var_mod, ONLY : d_t_eva,d_t_lsc,d_q_eva,d_q_lsc
-USE phys_local_var_mod, ONLY : d_u_oro,d_v_oro,d_u_lif,d_v_lif
-USE phys_local_var_mod, ONLY : du_gwd_hines,dv_gwd_hines,dv_gwd_front,dv_gwd_rando
-USE phys_state_var_mod, ONLY : du_gwd_front,du_gwd_rando
-USE phys_output_var_mod, ONLY : bils_ec,bils_ech,bils_tke,bils_kinetic,bils_enthalp,bils_latent,bils_diss
-USE add_phys_tend_mod, ONLY : fl_cor_ebil 
-
-
-IMPLICIT none
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "clesphys.h"
-#include "compbl.h"
-
-! Arguments
-INTEGER, INTENT(IN) :: klon,klev
-REAL, INTENT(IN) :: pdtphys
-REAL, DIMENSION(klon,klev), INTENT(IN)      :: puo,pvo,pto,pqo,pql0,pqs0
-REAL, DIMENSION(klon,klev), INTENT(IN)      :: pun,pvn,ptn,pqn,pqln,pqsn
-REAL, DIMENSION(klon,klev), INTENT(IN)      :: masse,exner
-REAL, DIMENSION(klon,klev+1), INTENT(IN)    :: dtke
-!
-REAL, DIMENSION(klon,klev), INTENT(OUT)     :: d_t_ec
-
-! Local
-      integer k,i
-REAL, DIMENSION(klon,klev+1) :: fluxu,fluxv,fluxt
-REAL, DIMENSION(klon,klev+1) :: dddu,dddv,dddt
-REAL, DIMENSION(klon,klev) :: d_u,d_v,d_t,zv,zu,d_t_ech
-REAL ZRCPD
-
-character*80 abort_message
-character*20 :: modname
-
-
-modname='ener_conser'
-d_t_ec(:,:)=0.
-
-IF (iflag_ener_conserv==-1) THEN
-!+jld ec_conser
-   DO k = 1, klev
-   DO i = 1, klon
-     IF (fl_cor_ebil .GT. 0) then
-       ZRCPD = RCPD*(1.0+RVTMP2*(pqn(i,k)+pqln(i,k)+pqsn(i,k)))
-     ELSE
-       ZRCPD = RCPD*(1.0+RVTMP2*pqn(i,k))
-     ENDIF
-     d_t_ec(i,k)=0.5/ZRCPD &
- &     *(puo(i,k)**2+pvo(i,k)**2-pun(i,k)**2-pvn(i,k)**2)
-   ENDDO
-   ENDDO
-!-jld ec_conser
-
-
-
-ELSEIF (iflag_ener_conserv>=1) THEN
-
-   IF (iflag_ener_conserv<=2) THEN
-!     print*,'ener_conserv pbl=',iflag_pbl
-      IF (iflag_pbl>=20 .AND. iflag_pbl<=27) THEN !d_t_diss accounts for conserv
-         d_t(:,:)=d_t_ajs(:,:)   ! d_t_ajs = adjust + thermals
-         d_u(:,:)=d_u_ajs(:,:)+d_u_con(:,:)
-         d_v(:,:)=d_v_ajs(:,:)+d_v_con(:,:)
-      ELSE
-         d_t(:,:)=d_t_vdf(:,:)+d_t_ajs(:,:)   ! d_t_ajs = adjust + thermals
-         d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)+d_u_con(:,:)
-         d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)+d_v_con(:,:)
-      ENDIF
-   ELSEIF (iflag_ener_conserv==101) THEN
-      d_t(:,:)=0.
-      d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)+d_u_con(:,:)
-      d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)+d_v_con(:,:)
-   ELSEIF (iflag_ener_conserv==110) THEN
-      d_t(:,:)=d_t_vdf(:,:)+d_t_ajs(:,:)
-      d_u(:,:)=0.
-      d_v(:,:)=0.
-
-   ELSEIF (iflag_ener_conserv==3) THEN
-      d_t(:,:)=0.
-      d_u(:,:)=0.
-      d_v(:,:)=0.
-   ELSEIF (iflag_ener_conserv==4) THEN
-      d_t(:,:)=0.
-      d_u(:,:)=d_u_vdf(:,:)
-      d_v(:,:)=d_v_vdf(:,:)
-   ELSEIF (iflag_ener_conserv==5) THEN
-      d_t(:,:)=d_t_vdf(:,:)
-      d_u(:,:)=d_u_vdf(:,:)
-      d_v(:,:)=d_v_vdf(:,:)
-   ELSEIF (iflag_ener_conserv==6) THEN
-      d_t(:,:)=d_t_vdf(:,:)
-      d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)
-      d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)
-   ELSEIF (iflag_ener_conserv==7) THEN
-      d_t(:,:)=d_t_vdf(:,:)+d_t_ajs(:,:)
-      d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)
-      d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)
-   ELSEIF (iflag_ener_conserv==8) THEN
-      d_t(:,:)=d_t_vdf(:,:)
-      d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)+d_u_con(:,:)
-      d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)+d_v_con(:,:)
-   ELSEIF (iflag_ener_conserv==9) THEN
-      d_t(:,:)=d_t_vdf(:,:)
-      d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)+d_u_con(:,:)+d_u_oro(:,:)
-      d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)+d_v_con(:,:)+d_v_oro(:,:)
-   ELSEIF (iflag_ener_conserv==10) THEN
-      d_t(:,:)=d_t_vdf(:,:)
-      d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)+d_u_con(:,:)+d_u_oro(:,:)+d_u_lif(:,:)
-      d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)+d_v_con(:,:)+d_v_oro(:,:)+d_v_lif(:,:)
-   ELSEIF (iflag_ener_conserv==11) THEN
-      d_t(:,:)=d_t_vdf(:,:)
-      d_u(:,:)=d_u_vdf(:,:)+d_u_ajs(:,:)+d_u_con(:,:)+d_u_oro(:,:)+d_u_lif(:,:)
-      d_v(:,:)=d_v_vdf(:,:)+d_v_ajs(:,:)+d_v_con(:,:)+d_v_oro(:,:)+d_v_lif(:,:) 
-      IF (ok_hines) THEN
-         d_u_vdf(:,:)=d_u_vdf(:,:)+du_gwd_hines(:,:)
-         d_v_vdf(:,:)=d_v_vdf(:,:)+dv_gwd_hines(:,:)
-      ENDIF
-      IF (.not. ok_hines .and. ok_gwd_rando) THEN
-         d_u_vdf(:,:)=d_u_vdf(:,:)+du_gwd_front(:,:)
-         d_v_vdf(:,:)=d_v_vdf(:,:)+dv_gwd_front(:,:)
-      ENDIF
-      IF (ok_gwd_rando) THEN
-         d_u_vdf(:,:)=d_u_vdf(:,:)+du_gwd_rando(:,:)
-         d_v_vdf(:,:)=d_v_vdf(:,:)+dv_gwd_rando(:,:)
-      ENDIF
-   ELSE
-      abort_message = 'iflag_ener_conserv non prevu'
-      CALL abort_physic (modname,abort_message,1)
-   ENDIF
-
-!----------------------------------------------------------------------------
-! Two options wether we consider time integration in the energy conservation
-!----------------------------------------------------------------------------
-
-   if (iflag_ener_conserv==2) then
-      zu(:,:)=puo(:,:)
-      zv(:,:)=pvo(:,:)
-   else
-      IF (iflag_pbl>=20 .AND. iflag_pbl<=27) THEN
-         zu(:,:)=puo(:,:)+d_u_vdf(:,:)+0.5*d_u(:,:)
-         zv(:,:)=pvo(:,:)+d_v_vdf(:,:)+0.5*d_v(:,:)
-      ELSE
-         zu(:,:)=puo(:,:)+0.5*d_u(:,:)
-         zv(:,:)=pvo(:,:)+0.5*d_v(:,:)
-      ENDIF
-   endif
-
-   fluxu(:,klev+1)=0.
-   fluxv(:,klev+1)=0.
-   fluxt(:,klev+1)=0.
-
-   do k=klev,1,-1
-      fluxu(:,k)=fluxu(:,k+1)+masse(:,k)*d_u(:,k)
-      fluxv(:,k)=fluxv(:,k+1)+masse(:,k)*d_v(:,k)
-      fluxt(:,k)=fluxt(:,k+1)+masse(:,k)*d_t(:,k)/exner(:,k)
-   enddo
-
-   dddu(:,1)=2*zu(:,1)*fluxu(:,1)
-   dddv(:,1)=2*zv(:,1)*fluxv(:,1)
-   dddt(:,1)=(exner(:,1)-1.)*fluxt(:,1)
-
-   do k=2,klev
-      dddu(:,k)=(zu(:,k)-zu(:,k-1))*fluxu(:,k)
-      dddv(:,k)=(zv(:,k)-zv(:,k-1))*fluxv(:,k)
-      dddt(:,k)=(exner(:,k)-exner(:,k-1))*fluxt(:,k)
-   enddo
-   dddu(:,klev+1)=0.
-   dddv(:,klev+1)=0.
-   dddt(:,klev+1)=0.
-
-   do k=1,klev
-      d_t_ech(:,k)=-(rcpd*(dddt(:,k)+dddt(:,k+1)))/(2.*rcpd*masse(:,k))
-      d_t_ec(:,k)=-(dddu(:,k)+dddu(:,k+1)+dddv(:,k)+dddv(:,k+1))/(2.*rcpd*masse(:,k))+d_t_ech(:,k)
-   enddo
-
-ENDIF
-
-!================================================================
-!  Computation of integrated enthalpie and kinetic energy variation
-!  FH (hourdin@lmd.jussieu.fr), 2013/04/25
-!  bils_ec : energie conservation term
-!  bils_ech : part of this term linked to temperature
-!  bils_tke : change of TKE
-!  bils_diss : dissipation of TKE (when activated)
-!  bils_kinetic : change of kinetic energie of the column
-!  bils_enthalp : change of enthalpie
-!  bils_latent  : change of latent heat. Computed between
-!          after reevaporation (at the beginning of the physics)
-!          and before large scale condensation (fisrtilp)
-!================================================================
-
-      bils_ec(:)=0.
-      bils_ech(:)=0.
-      bils_tke(:)=0.
-      bils_diss(:)=0.
-      bils_kinetic(:)=0.
-      bils_enthalp(:)=0.
-      bils_latent(:)=0.
-      DO k=1,klev
-        bils_ec(:)=bils_ec(:)-d_t_ec(:,k)*masse(:,k)
-        bils_diss(:)=bils_diss(:)-d_t_diss(:,k)*masse(:,k)
-        bils_kinetic(:)=bils_kinetic(:)+masse(:,k)* &
-     &           (pun(:,k)*pun(:,k)+pvn(:,k)*pvn(:,k) &
-     &            -puo(:,k)*puo(:,k)-pvo(:,k)*pvo(:,k))
-        bils_enthalp(:)= &
-     &  bils_enthalp(:)+masse(:,k)*(ptn(:,k)-pto(:,k)+d_t_ec(:,k)-d_t_eva(:,k)-d_t_lsc(:,k))
-!    &  bils_enthalp(:)+masse(:,k)*(ptn(:,k)-pto(:,k)+d_t_ec(:,k))
-        bils_latent(:)=bils_latent(:)+masse(:,k)* &
-!    &             (pqn(:,k)-pqo(:,k))
-     &             (pqn(:,k)-pqo(:,k)-d_q_eva(:,k)-d_q_lsc(:,k))
-      ENDDO
-      bils_ec(:)=rcpd*bils_ec(:)/pdtphys
-      bils_diss(:)=rcpd*bils_diss(:)/pdtphys
-      bils_kinetic(:)= 0.5*bils_kinetic(:)/pdtphys
-      bils_enthalp(:)=rcpd*bils_enthalp(:)/pdtphys
-      bils_latent(:)=rlvtt*bils_latent(:)/pdtphys
-!jyg<
-      IF (iflag_pbl > 1) THEN
-        DO k=1,klev
-          bils_tke(:)=bils_tke(:)+0.5*(dtke(:,k)+dtke(:,k+1))*masse(:,k)
-        ENDDO
-        bils_tke(:)=bils_tke(:)/pdtphys
-      ENDIF  ! (iflag_pbl > 1)
-!>jyg
-
-IF (iflag_ener_conserv>=1) THEN
-      bils_ech(:)=0.
-      DO k=1,klev
-        bils_ech(:)=bils_ech(:)-d_t_ech(:,k)*masse(:,k)
-      ENDDO
-      bils_ech(:)=rcpd*bils_ech(:)/pdtphys
-ENDIF
-
-RETURN
-
-END
+link ../phylmd/ener_conserv.F90
Index: LMDZ6/trunk/libf/phylmdiso/evappot.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/evappot.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/evappot.F90	(revision 3940)
@@ -1,42 +1,1 @@
-SUBROUTINE evappot(klon,nbsrf,ftsol,pplay,cdragh,  &
-       &    t_seri,q_seri,u_seri,v_seri,evap_pot)
-
-IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-
-
-INTEGER :: klon, nbsrf
-REAL, DIMENSION(klon,nbsrf) :: ftsol,evap_pot
-REAL, DIMENSION(klon) :: pplay,t_seri,wind,q_seri,u_seri,v_seri,cdragh
-
-INTEGER :: nsrf,i
-REAL, DIMENSION(klon,nbsrf) :: qsat_ftsol
-REAL, DIMENSION(klon) :: rhos, norme_u
-REAL :: t_coup
-
-      t_coup=234.   ! Quelle horreur !!!!!
-
-DO nsrf = 1, nbsrf
-   DO i = 1, klon
-      IF (ftsol(i,nsrf).LT.t_coup) THEN
-         qsat_ftsol(i,nsrf) = qsats(ftsol(i,nsrf))/pplay(i)
-      ELSE
-         qsat_ftsol(i,nsrf) = qsatl(ftsol(i,nsrf))/pplay(i)
-      ENDIF
-   ENDDO
-ENDDO
-! ========================================================== c
-! Calcul de l'evaporation Potentielle
-
-
-rhos(:) = pplay(:)/(RD*t_seri(:))
-norme_u(:)=1.+sqrt(u_seri(:)*u_seri(:)+v_seri(:)*v_seri(:))
-DO nsrf = 1, nbsrf
-  evap_pot(:,nsrf)=rhos(:)*cdragh(:)*norme_u(:)*(qsat_ftsol(:,nsrf)-q_seri(:))
-ENDDO
-RETURN
-
-END
+link ../phylmd/evappot.F90
Index: LMDZ6/trunk/libf/phylmdiso/fcg_gcssold.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/fcg_gcssold.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/fcg_gcssold.h	(revision 3940)
@@ -1,46 +1,1 @@
-!
-! $Id: fcg_gcssold.h 2010-08-10 17:02:56Z lahellec $
-!
-      logical :: imp_fcg_gcssold,ts_fcg_gcssold,Tp_fcg_gcssold
-      logical :: Tp_ini_gcssold
-      logical :: xTurb_fcg_gcssold
-
-      common /fcg_gcssold/imp_fcg_gcssold,ts_fcg_gcssold,Tp_fcg_gcssold,        & 
-     & Tp_ini_gcssold,                                                          &
-     & xTurb_fcg_gcssold
-
-!$OMP THREADPRIVATE(/fcg_gcssold/)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+link ../phylmd/fcg_gcssold.h
Index: LMDZ6/trunk/libf/phylmdiso/fcg_racmo.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/fcg_racmo.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/fcg_racmo.h	(revision 3940)
@@ -1,45 +1,1 @@
-!
-! $Id: fcg_racmo.h 2011-02-16 17:02:56Z cheruy $
-!
-      real   :: a_guide 
-      logical :: ok_invertp 
-      integer :: forc_trb
-      character*31 :: fich_racmo
-
-      common /fcg_racmo/forc_trb,ok_invertp,a_guide,fich_racmo
-
-!$OMP THREADPRIVATE(/fcg_racmo/)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+link ../phylmd/fcg_racmo.h
Index: LMDZ6/trunk/libf/phylmdiso/fisrtilp.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/fisrtilp.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/fisrtilp.h	(revision 3940)
@@ -1,32 +1,1 @@
-!
-! $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)
-!
-      REAL cld_lc_lsc,cld_lc_con
-      REAL cld_tau_lsc,cld_tau_con
-      REAL ffallv_lsc,ffallv_con
-      REAL coef_eva
-      LOGICAL reevap_ice
-      INTEGER iflag_pdf
-      INTEGER iflag_fisrtilp_qsat
-      INTEGER iflag_bergeron
-
-      common/comfisrtilp/                                               &
-     &     cld_lc_lsc                                                   &
-     &     ,cld_lc_con                                                  &
-     &     ,cld_tau_lsc                                                 &
-     &     ,cld_tau_con                                                 &
-     &     ,ffallv_lsc                                                  &
-     &     ,ffallv_con                                                  &
-     &     ,coef_eva                                                    &
-     &     ,reevap_ice                                                  &
-     &     ,iflag_fisrtilp_qsat                                         &
-     &     ,iflag_bergeron                                              &
-     &     ,iflag_pdf        
-
-!$OMP THREADPRIVATE(/comfisrtilp/)
+link ../phylmd/fisrtilp.h
Index: LMDZ6/trunk/libf/phylmdiso/fisrtilp_tr.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/fisrtilp_tr.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/fisrtilp_tr.F90	(revision 3940)
@@ -1,429 +1,1 @@
-
-! $Id: fisrtilp_tr.F90 2346 2015-08-21 15:13:46Z emillour $
-
-
-SUBROUTINE fisrtilp_tr(dtime, paprs, pplay, t, q, ratqs, d_t, d_q, d_ql, &
-    rneb, radliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, &
-    frac_nucl, prfl, psfl, rhcl) ! relative humidity in clear sky (needed for aer optical
-  ! properties; aeropt.F)
-
-
-  USE dimphy
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS)
-  ! Date: le 20 mars 1995
-  ! Objet: condensation et precipitation stratiforme.
-  ! schema de nuage
-  ! ======================================================================
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! Arguments:
-
-  REAL dtime ! intervalle du temps (s)
-  REAL paprs(klon, klev+1) ! pression a inter-couche
-  REAL pplay(klon, klev) ! pression au milieu de couche
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! humidite specifique (kg/kg)
-  REAL d_t(klon, klev) ! incrementation de la temperature (K)
-  REAL d_q(klon, klev) ! incrementation de la vapeur d'eau
-  REAL d_ql(klon, klev) ! incrementation de l'eau liquide
-  REAL rneb(klon, klev) ! fraction nuageuse
-  REAL radliq(klon, klev) ! eau liquide utilisee dans rayonnements
-  REAL rain(klon) ! pluies (mm/s)
-  REAL snow(klon) ! neige (mm/s)
-  REAL prfl(klon, klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-  REAL psfl(klon, klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-
-  ! jq   For aerosol opt properties needed (see aeropt.F)
-  REAL rhcl(klon, klev)
-
-  ! AA
-  ! Coeffients de fraction lessivee : pour OFF-LINE
-
-  REAL pfrac_nucl(klon, klev)
-  REAL pfrac_1nucl(klon, klev)
-  REAL pfrac_impa(klon, klev)
-
-  ! Fraction d'aerosols lessivee par impaction et par nucleation
-  ! POur ON-LINE
-
-  REAL frac_impa(klon, klev)
-  REAL frac_nucl(klon, klev)
-  ! AA
-
-  ! Options du programme:
-
-  REAL seuil_neb ! un nuage existe vraiment au-dela
-  PARAMETER (seuil_neb=0.001)
-  REAL ct ! inverse du temps pour qu'un nuage precipite
-  PARAMETER (ct=1./1800.)
-  REAL cl ! seuil de precipitation
-  PARAMETER (cl=2.6E-4)
-  ! cc      PARAMETER (cl=2.3e-4)
-  ! cc      PARAMETER (cl=2.0e-4)
-  INTEGER ninter ! sous-intervals pour la precipitation
-  PARAMETER (ninter=5)
-  LOGICAL evap_prec ! evaporation de la pluie
-  PARAMETER (evap_prec=.TRUE.)
-  REAL coef_eva
-  PARAMETER (coef_eva=2.0E-05)
-  LOGICAL calcrat ! calculer ratqs au lieu de fixer sa valeur
-  REAL ratqs(klon, klev) ! determine la largeur de distribution de vapeur
-  PARAMETER (calcrat=.TRUE.)
-  REAL zx_min, rat_max
-  PARAMETER (zx_min=1.0, rat_max=0.01)
-  REAL zx_max, rat_min
-  PARAMETER (zx_max=0.1, rat_min=0.3)
-  REAL zx
-
-  LOGICAL cpartiel ! condensation partielle
-  PARAMETER (cpartiel=.TRUE.)
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-
-  ! Variables locales:
-
-  INTEGER i, k, n, kk
-  REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5
-  REAL zrfl(klon), zrfln(klon), zqev, zqevt
-  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
-  REAL ztglace, zt(klon)
-  INTEGER nexpo ! exponentiel pour glace/eau
-  REAL zdz(klon), zrho(klon), ztot(klon), zrhol(klon)
-  REAL zchau(klon), zfroi(klon), zfice(klon), zneb(klon)
-
-  LOGICAL appel1er
-  SAVE appel1er
-  !$OMP THREADPRIVATE(appel1er)
-
-  ! ---------------------------------------------------------------
-
-  ! AA Variables traceurs:
-  ! AA  Provisoire !!! Parametres alpha du lessivage
-  ! AA  A priori on a 4 scavenging # possibles
-
-  REAL a_tr_sca(4)
-  SAVE a_tr_sca
-  !$OMP THREADPRIVATE(a_tr_sca)
-
-  ! Variables intermediaires
-
-  REAL zalpha_tr
-  REAL zfrac_lessi
-  REAL zprec_cond(klon)
-  ! AA
-  ! ---------------------------------------------------------------
-
-  ! Fonctions en ligne:
-
-  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)
-  ! cc      fallv (zzz) = 3.29 * ((zzz)**0.16)
-
-  DATA appel1er/.TRUE./
-
-  IF (appel1er) THEN
-
-    WRITE (lunout, *) 'fisrtilp, calcrat:', calcrat
-    WRITE (lunout, *) 'fisrtilp, ninter:', ninter
-    WRITE (lunout, *) 'fisrtilp, evap_prec:', evap_prec
-    WRITE (lunout, *) 'fisrtilp, cpartiel:', cpartiel
-    IF (abs(dtime/real(ninter)-360.0)>0.001) THEN
-      WRITE (lunout, *) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
-      WRITE (lunout, *) 'Je prefere un sous-intervalle de 6 minutes'
-      CALL abort
-    END IF
-    appel1er = .FALSE.
-
-    ! AA initialiation provisoire
-    a_tr_sca(1) = -0.5
-    a_tr_sca(2) = -0.5
-    a_tr_sca(3) = -0.5
-    a_tr_sca(4) = -0.5
-
-    ! AA Initialisation a 1 des coefs des fractions lessivees
-
-    DO k = 1, klev
-      DO i = 1, klon
-        pfrac_nucl(i, k) = 1.
-        pfrac_1nucl(i, k) = 1.
-        pfrac_impa(i, k) = 1.
-      END DO
-    END DO
-
-  END IF !  test sur appel1er
-
-  ! MAf Initialisation a 0 de zoliq
-  DO i = 1, klon
-    zoliq(i) = 0.
-  END DO
-  ! Determiner les nuages froids par leur temperature
-
-  ztglace = rtt - 15.0
-  nexpo = 6
-  ! cc      nexpo = 1
-
-  ! Initialiser les sorties:
-
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      prfl(i, k) = 0.0
-      psfl(i, k) = 0.0
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_q(i, k) = 0.0
-      d_ql(i, k) = 0.0
-      rneb(i, k) = 0.0
-      radliq(i, k) = 0.0
-      frac_nucl(i, k) = 1.
-      frac_impa(i, k) = 1.
-    END DO
-  END DO
-  DO i = 1, klon
-    rain(i) = 0.0
-    snow(i) = 0.0
-  END DO
-
-  ! Initialiser le flux de precipitation a zero
-
-  DO i = 1, klon
-    zrfl(i) = 0.0
-    zneb(i) = seuil_neb
-  END DO
-
-
-  ! AA Pour plus de securite
-
-  zalpha_tr = 0.
-  zfrac_lessi = 0.
-
-  ! AA----------------------------------------------------------
-
-  ! Boucle verticale (du haut vers le bas)
-
-  DO k = klev, 1, -1
-
-    ! AA----------------------------------------------------------
-
-    DO i = 1, klon
-      zt(i) = t(i, k)
-      zq(i) = q(i, k)
-    END DO
-
-    ! Calculer l'evaporation de la precipitation
-
-    IF (evap_prec) THEN
-      DO i = 1, klon
-        IF (zrfl(i)>0.) THEN
-          IF (thermcep) THEN
-            zdelta = max(0., sign(1.,rtt-zt(i)))
-            zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)
-            zqs(i) = min(0.5, zqs(i))
-            zcor = 1./(1.-retv*zqs(i))
-            zqs(i) = zqs(i)*zcor
-          ELSE
-            IF (zt(i)<t_coup) THEN
-              zqs(i) = qsats(zt(i))/pplay(i, k)
-            ELSE
-              zqs(i) = qsatl(zt(i))/pplay(i, k)
-            END IF
-          END IF
-          zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))
-          zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &
-            (paprs(i,k)-paprs(i,k+1))/pplay(i, k)*zt(i)*rd/rg
-          zqevt = max(0.0, min(zqevt,zrfl(i)))*rg*dtime/ &
-            (paprs(i,k)-paprs(i,k+1))
-          zqev = min(zqev, zqevt)
-          zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))/rg/dtime
-          zq(i) = zq(i) - (zrfln(i)-zrfl(i))*(rg/(paprs(i,k)-paprs(i, &
-            k+1)))*dtime
-          zt(i) = zt(i) + (zrfln(i)-zrfl(i))*(rg/(paprs(i,k)-paprs(i, &
-            k+1)))*dtime*rlvtt/rcpd/(1.0+rvtmp2*zq(i))
-          zrfl(i) = zrfln(i)
-        END IF
-      END DO
-    END IF
-
-    ! Calculer Qs et L/Cp*dQs/dT:
-
-    IF (thermcep) THEN
-      DO i = 1, klon
-        zdelta = max(0., sign(1.,rtt-zt(i)))
-        zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta
-        zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))
-        zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)
-        zqs(i) = min(0.5, zqs(i))
-        zcor = 1./(1.-retv*zqs(i))
-        zqs(i) = zqs(i)*zcor
-        zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)
-      END DO
-    ELSE
-      DO i = 1, klon
-        IF (zt(i)<t_coup) THEN
-          zqs(i) = qsats(zt(i))/pplay(i, k)
-          zdqs(i) = dqsats(zt(i), zqs(i))
-        ELSE
-          zqs(i) = qsatl(zt(i))/pplay(i, k)
-          zdqs(i) = dqsatl(zt(i), zqs(i))
-        END IF
-      END DO
-    END IF
-
-    ! Determiner la condensation partielle et calculer la quantite
-    ! de l'eau condensee:
-
-    IF (cpartiel) THEN
-      DO i = 1, klon
-
-        zdelq = ratqs(i, k)*zq(i)
-        rneb(i, k) = (zq(i)+zdelq-zqs(i))/(2.0*zdelq)
-        zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
-        IF (rneb(i,k)<=0.0) zqn(i) = 0.0
-        IF (rneb(i,k)>=1.0) zqn(i) = zq(i)
-        rneb(i, k) = max(0.0, min(1.0,rneb(i,k)))
-        zcond(i) = max(0.0, zqn(i)-zqs(i))*rneb(i, k)/(1.+zdqs(i))
-
-        ! --Olivier
-        rhcl(i, k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i)
-        IF (rneb(i,k)<=0.0) rhcl(i, k) = zq(i)/zqs(i)
-        IF (rneb(i,k)>=1.0) rhcl(i, k) = 1.0
-        ! --fin
-
-      END DO
-    ELSE
-      DO i = 1, klon
-        IF (zq(i)>zqs(i)) THEN
-          rneb(i, k) = 1.0
-        ELSE
-          rneb(i, k) = 0.0
-        END IF
-        zcond(i) = max(0.0, zq(i)-zqs(i))/(1.+zdqs(i))
-      END DO
-    END IF
-
-    DO i = 1, klon
-      zq(i) = zq(i) - zcond(i)
-      zt(i) = zt(i) + zcond(i)*rlvtt/rcpd
-    END DO
-
-    ! Partager l'eau condensee en precipitation et eau liquide nuageuse
-
-    DO i = 1, klon
-      IF (rneb(i,k)>0.0) THEN
-        zoliq(i) = zcond(i)
-        zrho(i) = pplay(i, k)/zt(i)/rd
-        zdz(i) = (paprs(i,k)-paprs(i,k+1))/(zrho(i)*rg)
-        zfice(i) = 1.0 - (zt(i)-ztglace)/(273.13-ztglace)
-        zfice(i) = min(max(zfice(i),0.0), 1.0)
-        zfice(i) = zfice(i)**nexpo
-        zneb(i) = max(rneb(i,k), seuil_neb)
-        radliq(i, k) = zoliq(i)/real(ninter+1)
-      END IF
-    END DO
-
-    DO n = 1, ninter
-      DO i = 1, klon
-        IF (rneb(i,k)>0.0) THEN
-          zchau(i) = ct*dtime/real(ninter)*zoliq(i)* &
-            (1.0-exp(-(zoliq(i)/zneb(i)/cl)**2))*(1.-zfice(i))
-          zrhol(i) = zrho(i)*zoliq(i)/zneb(i)
-          zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)*fallv(zrhol(i))* &
-            zfice(i)
-          ztot(i) = zchau(i) + zfroi(i)
-          IF (zneb(i)==seuil_neb) ztot(i) = 0.0
-          ztot(i) = min(max(ztot(i),0.0), zoliq(i))
-          zoliq(i) = max(zoliq(i)-ztot(i), 0.0)
-          radliq(i, k) = radliq(i, k) + zoliq(i)/real(ninter+1)
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (rneb(i,k)>0.0) THEN
-        d_ql(i, k) = zoliq(i)
-        zrfl(i) = zrfl(i) + max(zcond(i)-zoliq(i), 0.0)*(paprs(i,k)-paprs(i,k &
-          +1))/(rg*dtime)
-      END IF
-      IF (zt(i)<rtt) THEN
-        psfl(i, k) = zrfl(i)
-      ELSE
-        prfl(i, k) = zrfl(i)
-      END IF
-    END DO
-
-    ! Calculer les tendances de q et de t:
-
-    DO i = 1, klon
-      d_q(i, k) = zq(i) - q(i, k)
-      d_t(i, k) = zt(i) - t(i, k)
-    END DO
-
-    ! AA--------------- Calcul du lessivage stratiforme  -------------
-
-    DO i = 1, klon
-
-      zprec_cond(i) = max(zcond(i)-zoliq(i), 0.0)*(paprs(i,k)-paprs(i,k+1))/ &
-        rg
-      IF (rneb(i,k)>0.0 .AND. zprec_cond(i)>0.) THEN
-        ! AA lessivage nucleation LMD5 dans la couche elle-meme
-        IF (t(i,k)>=ztglace) THEN
-          zalpha_tr = a_tr_sca(3)
-        ELSE
-          zalpha_tr = a_tr_sca(4)
-        END IF
-        zfrac_lessi = 1. - exp(zalpha_tr*zprec_cond(i)/zneb(i))
-        pfrac_nucl(i, k) = pfrac_nucl(i, k)*(1.-zneb(i)*zfrac_lessi)
-        frac_nucl(i, k) = 1. - zneb(i)*zfrac_lessi
-
-        ! nucleation avec un facteur -1 au lieu de -0.5
-        zfrac_lessi = 1. - exp(-zprec_cond(i)/zneb(i))
-        pfrac_1nucl(i, k) = pfrac_1nucl(i, k)*(1.-zneb(i)*zfrac_lessi)
-      END IF
-
-    END DO ! boucle sur i
-
-    ! AA Lessivage par impaction dans les couches en-dessous
-    DO kk = k - 1, 1, -1
-      DO i = 1, klon
-        IF (rneb(i,k)>0.0 .AND. zprec_cond(i)>0.) THEN
-          IF (t(i,kk)>=ztglace) THEN
-            zalpha_tr = a_tr_sca(1)
-          ELSE
-            zalpha_tr = a_tr_sca(2)
-          END IF
-          zfrac_lessi = 1. - exp(zalpha_tr*zprec_cond(i)/zneb(i))
-          pfrac_impa(i, kk) = pfrac_impa(i, kk)*(1.-zneb(i)*zfrac_lessi)
-          frac_impa(i, kk) = 1. - zneb(i)*zfrac_lessi
-        END IF
-      END DO
-    END DO
-
-    ! AA----------------------------------------------------------
-    ! FIN DE BOUCLE SUR K
-  END DO
-
-  ! AA-----------------------------------------------------------
-
-  ! Pluie ou neige au sol selon la temperature de la 1ere couche
-
-  DO i = 1, klon
-    IF ((t(i,1)+d_t(i,1))<rtt) THEN
-      snow(i) = zrfl(i)
-    ELSE
-      rain(i) = zrfl(i)
-    END IF
-  END DO
-
-  RETURN
-END SUBROUTINE fisrtilp_tr
+link ../phylmd/fisrtilp_tr.F90
Index: LMDZ6/trunk/libf/phylmdiso/flott_gwd_rando_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/flott_gwd_rando_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/flott_gwd_rando_m.F90	(revision 3940)
@@ -1,460 +1,1 @@
-!
-! $Id: flott_gwd_rando_m.F90 3531 2019-06-06 15:08:45Z fairhead $
-!
-module FLOTT_GWD_rando_m
-
-  implicit none
-
-contains
-
-  SUBROUTINE FLOTT_GWD_rando(DTIME, pp, tt, uu, vv, prec, zustr, zvstr, d_u, &
-       d_v,east_gwstress,west_gwstress)
-
-    ! Parametrization of the momentum flux deposition due to a discrete
-    ! number of gravity waves. 
-    ! Author: F. Lott
-    ! July, 12th, 2012
-    ! Gaussian distribution of the source, source is precipitation
-    ! Reference: Lott (JGR, vol 118, page 8897, 2013)
-
-    !ONLINE:
-      use dimphy, only: klon, klev
-      use assert_m, only: assert
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-      USE vertical_layers_mod, ONLY : presnivs
-      CHARACTER (LEN=20) :: modname='flott_gwd_rando'
-      CHARACTER (LEN=80) :: abort_message
-
-      include "YOMCST.h"
-      include "clesphys.h"
-    ! OFFLINE:
-    ! include "dimensions.h"
-    ! include "dimphy.h"
-    ! END OF DIFFERENCE ONLINE-OFFLINE
-    include "YOEGWD.h"
-
-    ! 0. DECLARATIONS:
-
-    ! 0.1 INPUTS
-    REAL, intent(in)::DTIME ! Time step of the Physics
-    REAL, intent(in):: pp(:, :) ! (KLON, KLEV) Pressure at full levels
-    REAL, intent(in):: prec(:) ! (klon) Precipitation (kg/m^2/s) 
-    REAL, intent(in):: TT(:, :) ! (KLON, KLEV) Temp at full levels 
-    REAL, intent(in):: UU(:, :) ! (KLON, KLEV) Zonal wind at full levels
-    REAL, intent(in):: VV(:, :) ! (KLON, KLEV) Merid wind at full levels
-
-    ! 0.2 OUTPUTS
-    REAL, intent(out):: zustr(:), zvstr(:) ! (KLON) Surface Stresses
-
-    REAL, intent(inout):: d_u(:, :), d_v(:, :) 
-    REAL, intent(inout):: east_gwstress(:, :) !  Profile of eastward stress
-    REAL, intent(inout):: west_gwstress(:, :) !  Profile of westward stress 
-
-    ! (KLON, KLEV) tendencies on winds
-
-    ! O.3 INTERNAL ARRAYS
-    REAL BVLOW(klon)
-    REAL DZ   !  Characteristic depth of the Source
-
-    INTEGER II, JJ, LL
-
-    ! 0.3.0 TIME SCALE OF THE LIFE CYCLE OF THE WAVES PARAMETERIZED
-
-    REAL DELTAT
-
-    ! 0.3.1 GRAVITY-WAVES SPECIFICATIONS
-
-    INTEGER, PARAMETER:: NK = 2, NP = 2, NO = 2, NW = NK * NP * NO
-    INTEGER JK, JP, JO, JW
-    INTEGER, PARAMETER:: NA = 5  !number of realizations to get the phase speed
-    REAL KMIN, KMAX ! Min and Max horizontal wavenumbers
-    REAL CMAX ! standard deviation of the phase speed distribution
-    REAL RUWMAX,SAT  ! ONLINE SPECIFIED IN run.def
-    REAL CPHA ! absolute PHASE VELOCITY frequency
-    REAL ZK(NW, KLON) ! Horizontal wavenumber amplitude
-    REAL ZP(NW, KLON) ! Horizontal wavenumber angle 
-    REAL ZO(NW, KLON) ! Absolute frequency !
-
-    ! Waves Intr. freq. at the 1/2 lev surrounding the full level
-    REAL ZOM(NW, KLON), ZOP(NW, KLON)
-
-    ! Wave EP-fluxes at the 2 semi levels surrounding the full level
-    REAL WWM(NW, KLON), WWP(NW, KLON)
-
-    REAL RUW0(NW, KLON) ! Fluxes at launching level
-
-    REAL RUWP(NW, KLON), RVWP(NW, KLON)
-    ! Fluxes X and Y for each waves at 1/2 Levels
-
-    INTEGER LAUNCH, LTROP ! Launching altitude and tropo altitude
-
-    REAL XLAUNCH ! Controle the launching altitude
-    REAL XTROP ! SORT of Tropopause altitude 
-    REAL RUW(KLON, KLEV + 1) ! Flux x at semi levels
-    REAL RVW(KLON, KLEV + 1) ! Flux y at semi levels
-
-    REAL PRMAX ! Maximum value of PREC, and for which our linear formula
-    ! for GWs parameterisation apply
-
-    ! 0.3.2 PARAMETERS OF WAVES DISSIPATIONS
-
-    REAL RDISS, ZOISEC ! COEFF DE DISSIPATION, SECURITY FOR INTRINSIC FREQ
-
-    ! 0.3.3 BACKGROUND FLOW AT 1/2 LEVELS AND VERTICAL COORDINATE
-
-    REAL H0 ! Characteristic Height of the atmosphere
-    REAL PR, TR ! Reference Pressure and Temperature
-
-    REAL ZH(KLON, KLEV + 1) ! Log-pressure altitude
-
-    REAL UH(KLON, KLEV + 1), VH(KLON, KLEV + 1) ! Winds at 1/2 levels
-    REAL PH(KLON, KLEV + 1) ! Pressure at 1/2 levels
-    REAL PSEC ! Security to avoid division by 0 pressure
-    REAL BV(KLON, KLEV + 1) ! Brunt Vaisala freq. (BVF) at 1/2 levels
-    REAL BVSEC ! Security to avoid negative BVF
-    REAL RAN_NUM_1,RAN_NUM_2,RAN_NUM_3
-
-    REAL, DIMENSION(klev+1) ::HREF
-
-    LOGICAL, SAVE :: gwd_reproductibilite_mpiomp=.true.
-    LOGICAL, SAVE :: firstcall = .TRUE.
-  !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp)
-
-
-  IF (firstcall) THEN
-    ! Cle introduite pour resoudre un probleme de non reproductibilite
-    ! Le but est de pouvoir tester de revenir a la version precedenete
-    ! A eliminer rapidement
-    CALL getin_p('gwd_reproductibilite_mpiomp',gwd_reproductibilite_mpiomp)
-    IF (NW+3*NA>=KLEV) THEN
-       abort_message = 'NW+3*NA>=KLEV Probleme pour generation des ondes'
-       CALL abort_physic (modname,abort_message,1)
-    ENDIF
-    firstcall=.false.
-  ENDIF
-
-
-    !-----------------------------------------------------------------
-
-    ! 1. INITIALISATIONS
-
-    ! 1.1 Basic parameter
-
-    ! Are provided from elsewhere (latent heat of vaporization, dry
-    ! gaz constant for air, gravity constant, heat capacity of dry air
-    ! at constant pressure, earth rotation rate, pi).
-
-    ! 1.2 Tuning parameters of V14
-
-    
-    RDISS = 0.5 ! Diffusion parameter
-    ! ONLINE 
-      RUWMAX=GWD_RANDO_RUWMAX
-      SAT=gwd_rando_sat
-    !END ONLINE
-    ! OFFLINE
-    ! RUWMAX= 1.75    ! Launched flux
-    ! SAT=0.25     ! Saturation parameter
-    ! END OFFLINE
-
-    PRMAX = 20. / 24. /3600.
-    ! maximum of rain for which our theory applies (in kg/m^2/s)
-
- ! Characteristic depth of the source
-    DZ = 1000.
-    XLAUNCH=0.5 ! Parameter that control launching altitude
-    XTROP=0.2 ! Parameter that control tropopause altitude
-    DELTAT=24.*3600. ! Time scale of the waves (first introduced in 9b)
-    !  OFFLINE
-    !  DELTAT=DTIME
-    !  END OFFLINE
-
-    KMIN = 2.E-5
-    ! minimum horizontal wavenumber (inverse of the subgrid scale resolution)
-
-    KMAX = 1.E-3 ! Max horizontal wavenumber
-    CMAX = 30. ! Max phase speed velocity
-
-    TR = 240. ! Reference Temperature
-    PR = 101300. ! Reference pressure
-    H0 = RD * TR / RG ! Characteristic vertical scale height
-
-    BVSEC = 5.E-3 ! Security to avoid negative BVF 
-    PSEC = 1.E-6 ! Security to avoid division by 0 pressure
-    ZOISEC = 1.E-6 ! Security FOR 0 INTRINSIC FREQ
-
-IF (1==0) THEN
-    !ONLINE
-        call assert(klon == (/size(pp, 1), size(tt, 1), size(uu, 1), &
-         size(vv, 1), size(zustr), size(zvstr), size(d_u, 1), &
-         size(d_v, 1), &
-         size(east_gwstress, 1), size(west_gwstress, 1) /), &
-         "FLOTT_GWD_RANDO klon")
-     call assert(klev == (/size(pp, 2), size(tt, 2), size(uu, 2), &
-          size(vv, 2), size(d_u, 2), size(d_v, 2), &
-          size(east_gwstress,2), size(west_gwstress,2) /), &
-          "FLOTT_GWD_RANDO klev")
-    !END ONLINE
-ENDIF
-
-    IF(DELTAT < DTIME)THEN
-       abort_message='flott_gwd_rando: deltat < dtime!'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    IF (KLEV < NW) THEN
-       abort_message='flott_gwd_rando: you will have problem with random numbers'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    ! 2. EVALUATION OF THE BACKGROUND FLOW AT SEMI-LEVELS
-
-    ! Pressure and Inv of pressure
-    DO LL = 2, KLEV
-       PH(:, LL) = EXP((LOG(PP(:, LL)) + LOG(PP(:, LL - 1))) / 2.)
-    end DO
-    PH(:, KLEV + 1) = 0. 
-    PH(:, 1) = 2. * PP(:, 1) - PH(:, 2)
-
-    ! Launching altitude
-
-    !Pour revenir a la version non reproductible en changeant le nombre de process
-    IF (gwd_reproductibilite_mpiomp) THEN
-       ! Reprend la formule qui calcule PH en fonction de PP=play
-       DO LL = 2, KLEV
-          HREF(LL) = EXP((LOG(presnivs(LL)) + LOG(presnivs(LL - 1))) / 2.)
-       end DO
-       HREF(KLEV + 1) = 0.
-       HREF(1) = 2. * presnivs(1) - HREF(2)
-    ELSE
-       HREF(1:KLEV)=PH(KLON/2,1:KLEV)
-    ENDIF
-
-    LAUNCH=0
-    LTROP =0
-    DO LL = 1, KLEV
-       IF (HREF(LL) / HREF(1) > XLAUNCH) LAUNCH = LL
-    ENDDO
-    DO LL = 1, KLEV
-       IF (HREF(LL) / HREF(1) > XTROP) LTROP = LL
-    ENDDO
-    !LAUNCH=22 ; LTROP=33
-!   print*,'LAUNCH=',LAUNCH,'LTROP=',LTROP
-
-    ! Log pressure vert. coordinate
-    DO LL = 1, KLEV + 1 
-       ZH(:, LL) = H0 * LOG(PR / (PH(:, LL) + PSEC))
-    end DO
-
-    ! BV frequency
-    DO LL = 2, KLEV
-       ! BVSEC: BV Frequency (UH USED IS AS A TEMPORARY ARRAY DOWN TO WINDS)
-       UH(:, LL) = 0.5 * (TT(:, LL) + TT(:, LL - 1)) &
-            * RD**2 / RCPD / H0**2 + (TT(:, LL) &
-            - TT(:, LL - 1)) / (ZH(:, LL) - ZH(:, LL - 1)) * RD / H0
-    end DO
-    BVLOW(:) = 0.5 * (TT(:, LTROP )+ TT(:, LAUNCH)) &
-         * RD**2 / RCPD / H0**2 + (TT(:, LTROP ) &
-         - TT(:, LAUNCH))/(ZH(:, LTROP )- ZH(:, LAUNCH)) * RD / H0
-
-    UH(:, 1) = UH(:, 2)
-    UH(:, KLEV + 1) = UH(:, KLEV)
-    BV(:, 1) = UH(:, 2)
-    BV(:, KLEV + 1) = UH(:, KLEV)
-    ! SMOOTHING THE BV HELPS
-    DO LL = 2, KLEV
-       BV(:, LL)=(UH(:, LL+1)+2.*UH(:, LL)+UH(:, LL-1))/4.
-    end DO
-
-    BV=MAX(SQRT(MAX(BV, 0.)), BVSEC)
-    BVLOW=MAX(SQRT(MAX(BVLOW, 0.)), BVSEC)
-
-
-    ! WINDS
-    DO LL = 2, KLEV
-       UH(:, LL) = 0.5 * (UU(:, LL) + UU(:, LL - 1)) ! Zonal wind
-       VH(:, LL) = 0.5 * (VV(:, LL) + VV(:, LL - 1)) ! Meridional wind
-    end DO
-    UH(:, 1) = 0.
-    VH(:, 1) = 0.
-    UH(:, KLEV + 1) = UU(:, KLEV)
-    VH(:, KLEV + 1) = VV(:, KLEV)
-
-    ! 3 WAVES CHARACTERISTICS CHOSEN RANDOMLY AT THE LAUNCH ALTITUDE
-
-    ! The mod functions of weird arguments are used to produce the
-    ! waves characteristics in an almost stochastic way
-
-    DO JW = 1, NW
-             ! Angle
-             DO II = 1, KLON
-                ! Angle (0 or PI so far)
-                RAN_NUM_1=MOD(TT(II, JW) * 10., 1.)
-                RAN_NUM_2= MOD(TT(II, JW) * 100., 1.)
-                ZP(JW, II) = (SIGN(1., 0.5 - RAN_NUM_1) + 1.) &
-                     * RPI / 2.
-                ! Horizontal wavenumber amplitude
-                ZK(JW, II) = KMIN + (KMAX - KMIN) *RAN_NUM_2
-                ! Horizontal phase speed
-                CPHA = 0.
-                DO JJ = 1, NA
-                    RAN_NUM_3=MOD(TT(II, JW+3*JJ)**2, 1.)
-                    CPHA = CPHA + &
-                    CMAX*2.*(RAN_NUM_3 -0.5)*SQRT(3.)/SQRT(NA*1.)
-                END DO
-                IF (CPHA.LT.0.)  THEN
-                   CPHA = -1.*CPHA
-                   ZP(JW,II) = ZP(JW,II) + RPI
-                ENDIF
-                ! Absolute frequency is imposed
-                ZO(JW, II) = CPHA * ZK(JW, II) 
-                ! Intrinsic frequency is imposed
-                ZO(JW, II) = ZO(JW, II) &
-                     + ZK(JW, II) * COS(ZP(JW, II)) * UH(II, LAUNCH) &
-                     + ZK(JW, II) * SIN(ZP(JW, II)) * VH(II, LAUNCH)
-                ! Momentum flux at launch lev 
-                RUW0(JW, II) = RUWMAX
-             ENDDO
-    ENDDO
-
-    ! 4. COMPUTE THE FLUXES
-
-    ! 4.1 Vertical velocity at launching altitude to ensure 
-    ! the correct value to the imposed fluxes.
-
-    DO JW = 1, NW
-
-       ! Evaluate intrinsic frequency at launching altitude:
-       ZOP(JW, :) = ZO(JW, :) &
-            - ZK(JW, :) * COS(ZP(JW, :)) * UH(:, LAUNCH) &
-            - ZK(JW, :) * SIN(ZP(JW, :)) * VH(:, LAUNCH) 
-
-       ! VERSION WITH CONVECTIVE SOURCE
-
-       ! Vertical velocity at launch level, value to ensure the
-       ! imposed factor related to the convective forcing:
-       ! precipitations.
-
-       ! tanh limitation to values above prmax:
-       WWP(JW, :) = RUW0(JW, :) &
-            * (RD / RCPD / H0 * RLVTT * PRMAX * TANH(PREC(:) / PRMAX))**2
-
-       ! Factor related to the characteristics of the waves:
-       WWP(JW, :) = WWP(JW, :) * ZK(JW, :)**3 / KMIN / BVLOW(:)  &
-            / MAX(ABS(ZOP(JW, :)), ZOISEC)**3 
-
-       ! Moderation by the depth of the source (dz here):
-       WWP(JW, :) = WWP(JW, :) &
-            * EXP(- BVLOW(:)**2 / MAX(ABS(ZOP(JW, :)), ZOISEC)**2 * ZK(JW, :)**2 &
-            * DZ**2)
-
-       ! Put the stress in the right direction:
-       RUWP(JW, :) = ZOP(JW, :) / MAX(ABS(ZOP(JW, :)), ZOISEC)**2 &
-            * BV(:, LAUNCH) * COS(ZP(JW, :)) * WWP(JW, :)**2
-       RVWP(JW, :) = ZOP(JW, :) / MAX(ABS(ZOP(JW, :)), ZOISEC)**2 &
-            * BV(:, LAUNCH) * SIN(ZP(JW, :)) * WWP(JW, :)**2
-    end DO
-
-
-    ! 4.2 Uniform values below the launching altitude
-
-    DO LL = 1, LAUNCH
-       RUW(:, LL) = 0
-       RVW(:, LL) = 0
-       DO JW = 1, NW
-          RUW(:, LL) = RUW(:, LL) + RUWP(JW, :)
-          RVW(:, LL) = RVW(:, LL) + RVWP(JW, :)
-       end DO
-    end DO
-
-    ! 4.3 Loop over altitudes, with passage from one level to the next
-    ! done by i) conserving the EP flux, ii) dissipating a little,
-    ! iii) testing critical levels, and vi) testing the breaking.
-
-    DO LL = LAUNCH, KLEV - 1
-       ! Warning: all the physics is here (passage from one level
-       ! to the next)
-       DO JW = 1, NW
-          ZOM(JW, :) = ZOP(JW, :)
-          WWM(JW, :) = WWP(JW, :)
-          ! Intrinsic Frequency
-          ZOP(JW, :) = ZO(JW, :) - ZK(JW, :) * COS(ZP(JW, :)) * UH(:, LL + 1) &
-               - ZK(JW, :) * SIN(ZP(JW, :)) * VH(:, LL + 1) 
-
-          ! No breaking (Eq.6)
-          ! Dissipation (Eq. 8)
-          WWP(JW, :) = WWM(JW, :) * EXP(- 4. * RDISS * PR / (PH(:, LL + 1) &
-               + PH(:, LL)) * ((BV(:, LL + 1) + BV(:, LL)) / 2.)**3 &
-               / MAX(ABS(ZOP(JW, :) + ZOM(JW, :)) / 2., ZOISEC)**4 &
-               * ZK(JW, :)**3 * (ZH(:, LL + 1) - ZH(:, LL)))
-
-          ! Critical levels (forced to zero if intrinsic frequency changes sign)
-          ! Saturation (Eq. 12)
-          WWP(JW, :) = min(WWP(JW, :), MAX(0., &
-               SIGN(1., ZOP(JW, :) * ZOM(JW, :))) * ABS(ZOP(JW, :))**3 &
-               / BV(:, LL + 1) * EXP(- ZH(:, LL + 1) / H0) * KMIN**2  &
-               * SAT**2 / ZK(JW, :)**4)
-       end DO
-
-       ! Evaluate EP-flux from Eq. 7 and give the right orientation to
-       ! the stress
-
-       DO JW = 1, NW
-          RUWP(JW, :) = SIGN(1., ZOP(JW, :))*COS(ZP(JW, :)) * WWP(JW, :)
-          RVWP(JW, :) = SIGN(1., ZOP(JW, :))*SIN(ZP(JW, :)) * WWP(JW, :)
-       end DO
-
-       RUW(:, LL + 1) = 0.
-       RVW(:, LL + 1) = 0.
-
-       DO JW = 1, NW
-          RUW(:, LL + 1) = RUW(:, LL + 1) + RUWP(JW, :) 
-          RVW(:, LL + 1) = RVW(:, LL + 1) + RVWP(JW, :) 
-          EAST_GWSTRESS(:, LL)=EAST_GWSTRESS(:, LL)+MAX(0.,RUWP(JW,:))/FLOAT(NW)
-          WEST_GWSTRESS(:, LL)=WEST_GWSTRESS(:, LL)+MIN(0.,RUWP(JW,:))/FLOAT(NW)
-       end DO
-    end DO
-! OFFLINE ONLY
-!   PRINT *,'SAT PROFILE:'
-!   DO LL=1,KLEV
-!   PRINT *,ZH(KLON/2,LL)/1000.,SAT*(2.+TANH(ZH(KLON/2,LL)/H0-8.))
-!   ENDDO
-
-    ! 5 CALCUL DES TENDANCES:
-
-    ! 5.1 Rectification des flux au sommet et dans les basses couches
-
-    RUW(:, KLEV + 1) = 0.
-    RVW(:, KLEV + 1) = 0.
-    RUW(:, 1) = RUW(:, LAUNCH)
-    RVW(:, 1) = RVW(:, LAUNCH)
-    DO LL = 1, LAUNCH
-       RUW(:, LL) = RUW(:, LAUNCH+1)
-       RVW(:, LL) = RVW(:, LAUNCH+1)
-       EAST_GWSTRESS(:, LL)  = EAST_GWSTRESS(:, LAUNCH)
-       WEST_GWSTRESS(:, LL)  = WEST_GWSTRESS(:, LAUNCH)
-    end DO
-
-    ! AR-1 RECURSIVE FORMULA (13) IN VERSION 4
-    DO LL = 1, KLEV
-       D_U(:, LL) = (1.-DTIME/DELTAT) * D_U(:, LL) + DTIME/DELTAT/REAL(NW) * &
-            RG * (RUW(:, LL + 1) - RUW(:, LL)) &
-            / (PH(:, LL + 1) - PH(:, LL)) * DTIME
-       ! NO AR-1 FOR MERIDIONAL TENDENCIES
-       D_V(:, LL) =                                            1./REAL(NW) * &
-            RG * (RVW(:, LL + 1) - RVW(:, LL)) &
-            / (PH(:, LL + 1) - PH(:, LL)) * DTIME
-    ENDDO
-
-    ! Cosmetic: evaluation of the cumulated stress
-    ZUSTR = 0.
-    ZVSTR = 0.
-    DO LL = 1, KLEV
-       ZUSTR = ZUSTR + D_U(:, LL) / RG * (PH(:, LL + 1) - PH(:, LL))/DTIME
-       ZVSTR = ZVSTR + D_V(:, LL) / RG * (PH(:, LL + 1) - PH(:, LL))/DTIME
-    ENDDO
-
-
-  END SUBROUTINE FLOTT_GWD_RANDO
-
-end module FLOTT_GWD_rando_m
+link ../phylmd/flott_gwd_rando_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/flux_arp.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/flux_arp.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/flux_arp.h	(revision 3940)
@@ -1,17 +1,1 @@
-!
-! $Id: flux_arp.h 2010-08-04 17:02:56Z lahellec $
-!
-      logical :: ok_flux_surf
-      logical :: ok_prescr_ust !for prescribed ustar
-      real :: fsens
-      real :: flat
-      real :: ust
-      real :: tg
-
-      common /flux_arp/fsens,flat,ust,tg,ok_flux_surf,ok_prescr_ust
-
-!$OMP THREADPRIVATE(/flux_arp/)
-
-
-
-
+link ../phylmd/flux_arp.h
Index: LMDZ6/trunk/libf/phylmdiso/flxtr.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/flxtr.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/flxtr.F90	(revision 3940)
@@ -1,202 +1,1 @@
-
-! $Header$
-
-SUBROUTINE flxtr(pdtime, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, pt, pplay, &
-    paprs, kcbot, kctop, kdtop, x, dx)
-  USE dimphy
-  IMPLICIT NONE
-  ! =====================================================================
-  ! Objet : Melange convectif de traceurs a partir des flux de masse
-  ! Date : 13/12/1996 -- 13/01/97
-  ! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
-  ! Brinkop et Sausen (1996) et Boucher et al. (1996).
-  ! ATTENTION : meme si cette routine se veut la plus generale possible,
-  ! elle a herite de certaines notations et conventions du
-  ! schema de Tiedtke (1993).
-  ! --En particulier, les couches sont numerotees de haut en bas !!!
-  ! Ceci est valable pour les flux, kcbot, kctop et kdtop
-  ! mais pas pour les entrees x, pplay, paprs !!!!
-  ! --Un schema amont est choisi pour calculer les flux pour s'assurer
-  ! de la positivite des valeurs de traceurs, cela implique des eqs
-  ! differentes pour les flux de traceurs montants et descendants.
-  ! --pmfu est positif, pmfd est negatif
-  ! --Tous les flux d'entrainements et de detrainements sont positifs
-  ! contrairement au schema de Tiedtke d'ou les changements de signe!!!!
-  ! =====================================================================
-
-  include "YOMCST.h"
-  include "YOECUMF.h"
-
-  REAL pdtime
-  ! --les flux sont definis au 1/2 niveaux
-  ! --pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
-  REAL pmfu(klon, klev) ! flux de masse dans le panache montant
-  REAL pmfd(klon, klev) ! flux de masse dans le panache descendant
-  REAL pen_u(klon, klev) ! flux entraine dans le panache montant
-  REAL pde_u(klon, klev) ! flux detraine dans le panache montant
-  REAL pen_d(klon, klev) ! flux entraine dans le panache descendant
-  REAL pde_d(klon, klev) ! flux detraine dans le panache descendant
-  ! --idem mais en variables locales
-  REAL zpen_u(klon, klev)
-  REAL zpde_u(klon, klev)
-  REAL zpen_d(klon, klev)
-  REAL zpde_d(klon, klev)
-
-  REAL pplay(klon, klev) ! pression aux couches (bas en haut)
-  REAL pap(klon, klev) ! pression aux couches (haut en bas)
-  REAL pt(klon, klev) ! temperature aux couches (bas en haut)
-  REAL zt(klon, klev) ! temperature aux couches (haut en bas)
-  REAL paprs(klon, klev+1) ! pression aux 1/2 couches (bas en haut)
-  REAL paph(klon, klev+1) ! pression aux 1/2 couches (haut en bas)
-  INTEGER kcbot(klon) ! niveau de base de la convection
-  INTEGER kctop(klon) ! niveau du sommet de la convection +1
-  INTEGER kdtop(klon) ! niveau de sommet du panache descendant
-  REAL x(klon, klev) ! q de traceur (bas en haut)
-  REAL zx(klon, klev) ! q de traceur (haut en bas)
-  REAL dx(klon, klev) ! tendance de traceur  (bas en haut)
-
-  ! --variables locales
-  ! --les flux de x sont definis aux 1/2 niveaux
-  ! --xu et xd sont definis aux niveaux complets
-  REAL xu(klon, klev) ! q de traceurs dans le panache montant
-  REAL xd(klon, klev) ! q de traceurs dans le panache descendant
-  REAL xe(klon, klev) ! q de traceurs dans l'environnement
-  REAL zmfux(klon, klev+1) ! flux de x dans le panache montant
-  REAL zmfdx(klon, klev+1) ! flux de x dans le panache descendant
-  REAL zmfex(klon, klev+1) ! flux de x dans l'environnement
-  INTEGER i, k
-  REAL zmfmin
-  PARAMETER (zmfmin=1.E-10)
-
-  ! On remet les taux d'entrainement et de detrainement dans le panache
-  ! descendant a des valeurs positives.
-  ! On ajuste les valeurs de pen_u, pen_d pde_u et pde_d pour que la
-  ! conservation de la masse soit realisee a chaque niveau dans les 2
-  ! panaches.
-  DO k = 1, klev
-    DO i = 1, klon
-      zpen_u(i, k) = pen_u(i, k)
-      zpde_u(i, k) = pde_u(i, k)
-    END DO
-  END DO
-
-  DO k = 1, klev - 1
-    DO i = 1, klon
-      zpen_d(i, k) = -pen_d(i, k+1)
-      zpde_d(i, k) = -pde_d(i, k+1)
-    END DO
-  END DO
-
-  DO i = 1, klon
-    zpen_d(i, klev) = 0.0
-    zpde_d(i, klev) = -pmfd(i, klev)
-    ! Correction 03 11 97
-    ! zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)-pmfd(i,kdtop(i))
-    IF (kdtop(i)==klev+1) THEN
-      zpen_d(i, kdtop(i)-1) = pmfd(i, kdtop(i)-1)
-    ELSE
-      zpen_d(i, kdtop(i)-1) = pmfd(i, kdtop(i)-1) - pmfd(i, kdtop(i))
-    END IF
-
-    zpde_u(i, kctop(i)-2) = pmfu(i, kctop(i)-1)
-    zpen_u(i, klev) = pmfu(i, klev)
-  END DO
-
-  DO i = 1, klon
-    DO k = kcbot(i), klev - 1
-      zpen_u(i, k) = pmfu(i, k) - pmfu(i, k+1)
-    END DO
-  END DO
-
-  ! conversion des sens de notations bas-haut et haut-bas
-
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      paph(i, klev+2-k) = paprs(i, k)
-    END DO
-  END DO
-
-  DO i = 1, klon
-    DO k = 1, klev
-      pap(i, klev+1-k) = pplay(i, k)
-      zt(i, klev+1-k) = pt(i, k)
-      zx(i, klev+1-k) = x(i, k)
-    END DO
-  END DO
-
-  ! --initialisations des flux de traceurs aux extremites de la colonne
-
-  DO i = 1, klon
-    zmfux(i, klev+1) = 0.0
-    zmfdx(i, 1) = 0.0
-    zmfex(i, 1) = 0.0
-  END DO
-
-  ! --calcul des flux dans le panache montant
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      IF (k>=kcbot(i)) THEN
-        xu(i, k) = zx(i, k)
-        zmfux(i, k) = pmfu(i, k)*xu(i, k)
-      ELSE
-        zmfux(i, k) = (zmfux(i,k+1)+zpen_u(i,k)*zx(i,k))/ &
-          (1.+zpde_u(i,k)/max(zmfmin,pmfu(i,k)))
-        xu(i, k) = zmfux(i, k)/max(zmfmin, pmfu(i,k))
-      END IF
-    END DO
-  END DO
-
-  ! --calcul des flux dans le panache descendant
-
-  DO k = 1, klev - 1
-    DO i = 1, klon
-      IF (k<=kdtop(i)-1) THEN
-        xd(i, k) = (zx(i,k)+xu(i,k))/2.
-        zmfdx(i, k+1) = pmfd(i, k+1)*xd(i, k)
-      ELSE
-        zmfdx(i, k+1) = (zmfdx(i,k)-zpen_d(i,k)*zx(i,k))/ &
-          (1.-zpde_d(i,k)/min(-zmfmin,pmfd(i,k+1)))
-        xd(i, k) = zmfdx(i, k+1)/min(-zmfmin, pmfd(i,k+1))
-      END IF
-    END DO
-  END DO
-  DO i = 1, klon
-    zmfdx(i, klev+1) = 0.0
-    xd(i, klev) = (zpen_d(i,klev)*zx(i,klev)-zmfdx(i,klev))/ &
-      max(zmfmin, zpde_d(i,klev))
-  END DO
-
-  ! --introduction du flux de retour dans l'environnement
-
-  DO k = 1, klev - 1
-    DO i = 1, klon
-      IF (k<=kctop(i)-3) THEN
-        xe(i, k) = zx(i, k)
-        zmfex(i, k+1) = -(pmfu(i,k+1)+pmfd(i,k+1))*xe(i, k)
-      ELSE
-        zmfex(i, k+1) = (zmfex(i,k)-(zpde_u(i,k)*xu(i,k)+zpde_d(i,k)*xd(i, &
-          k)))/(1.-(zpen_d(i,k)+zpen_u(i,k))/min(-zmfmin,-pmfu(i,k+1)-pmfd(i, &
-          k+1)))
-        xe(i, k) = zmfex(i, k+1)/min(-zmfmin, -pmfu(i,k+1)-pmfd(i,k+1))
-      END IF
-    END DO
-  END DO
-  DO i = 1, klon
-    zmfex(i, klev+1) = 0.0
-    xe(i, klev) = (zpde_u(i,klev)*xu(i,klev)+zpde_d(i,klev)*xd(i,klev)-zmfex( &
-      i,klev))/max(zmfmin, zpen_u(i,klev)+zpen_d(i,klev))
-  END DO
-
-  ! --calcul final des tendances
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dx(i, klev+1-k) = rg/(paph(i,k+1)-paph(i,k))*pdtime* &
-        (zmfux(i,k+1)-zmfux(i,k)+zmfdx(i,k+1)-zmfdx(i,k)+zmfex(i,k+1)- &
-        zmfex(i,k))
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE flxtr
+link ../phylmd/flxtr.F90
Index: LMDZ6/trunk/libf/phylmdiso/fonte_neige_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/fonte_neige_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/fonte_neige_mod.F90	(revision 3940)
@@ -28,11 +28,11 @@
   REAL, PRIVATE                               :: tau_calv  
   !$OMP THREADPRIVATE(tau_calv)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: ffonte_global
+  REAL, ALLOCATABLE, DIMENSION(:,:)           :: ffonte_global
   !$OMP THREADPRIVATE(ffonte_global)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqfonte_global
+  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqfonte_global
   !$OMP THREADPRIVATE(fqfonte_global)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqcalving_global
+  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqcalving_global
   !$OMP THREADPRIVATE(fqcalving_global)
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE  :: runofflic_global
+  REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
   !$OMP THREADPRIVATE(runofflic_global)
 #ifdef ISO
@@ -60,5 +60,4 @@
 ! The variable run_off_lic_0 is initialized to the field read from
 ! restart file. The other variables are initialized to zero.
-
 !
 !****************************************************************************************
@@ -84,5 +83,4 @@
     run_off_lic_0(:) = restart_runoff(:) 
 
-
 !****************************************************************************************
 ! Allocate other variables and initilize to zero
@@ -130,6 +128,4 @@
     ENDIF
     runofflic_global(:) = 0.0
-
-
 
 !****************************************************************************************
@@ -348,5 +344,5 @@
 
     snow_evap = 0.
-    
+  
 #ifdef ISOVERIF
         write(*,*) 'klon,snow_evap(413)=',klon,snow_evap(413)
@@ -406,5 +402,5 @@
        ! Y'a-t-il fonte de neige?
        neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
-       IF (neige_fond) THEN   
+       IF (neige_fond) THEN
           fq_fonte     = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
           ffonte(i)    = fq_fonte * RLMLT/dtime
@@ -412,5 +408,5 @@
           snow(i)      = MAX(0., snow(i) - fq_fonte)
           bil_eau_s(i) = bil_eau_s(i) + fq_fonte 
-          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno   
+          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno  
 #ifdef ISO
         fq_fonte_diag(i)=fq_fonte
Index: LMDZ6/trunk/libf/phylmdiso/freinage.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/freinage.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/freinage.F90	(revision 3940)
@@ -1,134 +1,1 @@
-!
-! $Id$
-!
-  SUBROUTINE freinage(knon, uu, vv,  &
-       tt,veget,lai, height,ypaprs,ypplay,drag_pro,d_u,d_v)
-
-    !ONLINE:
-    use dimphy, only: klon, klev
-!    USE control, ONLY: nvm
-!    USE indice_sol_mod, only : nvm_orch
-
-    IMPLICIT NONE
-
-
-    include "YOMCST.h"
-    include "clesphys.h"
-    include "YOEGWD.h"
-!FC 
-    include "dimpft.h"
-    include "compbl.h"
-
-    ! 0. DECLARATIONS:
-
-    ! 0.1 INPUTS
-
-    REAL, DIMENSION(klon,klev), INTENT(IN)         :: ypplay
-    REAL, DIMENSION(klon,klev+1), INTENT(IN)       :: ypaprs
-
-
-     REAL, DIMENSION(klon, klev), INTENT(IN)     :: uu
-     REAL, DIMENSION(klon, klev), INTENT(IN)     :: vv
-     REAL, DIMENSION(klon, klev), INTENT(IN)     :: tt
-     REAL, DIMENSION(klon,nvm_lmdz), INTENT(IN)          :: veget,lai
-     REAL, DIMENSION(klon,nvm_lmdz), INTENT(IN)          :: height
-
-     REAL, DIMENSION(klon,klev)         :: wind
-     REAL, DIMENSION(klon, klev)        :: yzlay
-     INTEGER knon
-
-    ! 0.2 OUTPUTS
-
-      REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_v        ! change in v
-      REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_u        ! change in v
-    !knon nombre de points concernes 
-      REAL, DIMENSION(klon,klev)         :: sumveg        ! change in v
-    
-     REAL,  DIMENSION(klon,klev), INTENT(OUT)          :: drag_pro
-    ! (KLON, KLEV) tendencies on winds
-
-
-    INTEGER k,jv,i
-
-
-!FCCCC    REAL Cd_frein
-
-    ! 0.3.1 LOCAL VARIABLE
-
-
-    !-----------------------------------------------------------------
-
-    ! 1. INITIALISATIONS
-
-    
-!    Cd_frein = 7.5E-2 ! (0.075) ! Drag from MASSON 2009
-!FC ESSAI
-!    Cd_frein = 1.5E-2 ! (0.075) ! Drag from MASSON 2009
-!    Cd_frein = 0.005 ! (0.075) ! Drag from MASSON 2009
-
-! initialisation 
-      d_u(:,:) =0.
-      d_v(:,:) =0.
-      drag_pro(:,:) =0.
-      sumveg(:,:) =0.
-!!        print*, "Cd_frein" , Cd_frein
-      
-       wind(:,:)= sqrt(uu(:,:)*uu(:,:)+vv(:,:)*vv(:,:))
-
-       yzlay(1:knon,1)= &
-            RD*tt(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
-             yzlay(1:knon,k)= &
-                  yzlay(1:knon,k-1)+RD*0.5*(tt(1:knon,k-1)+tt(1:knon,k)) &
-                  /ypaprs(1:knon,k)*(ypplay(1:knon,k-1)-ypplay(1:knon,k))/RG
-       END DO
-
-!    verifier les indexes ..... 
-!!       print*, " calcul de drag_pro FC "
-   
-      do k= 1,klev
-
-      do jv=2,nvm_lmdz   !   (on peut faire 9 ?)
-
-      do i=1,knon
-
-      sumveg(i,k)= sumveg(i,k)+ veget(i,jv)
-
-!      if  ( (height(i,jv) .gt. yzlay(i,k)) .AND. (height(i,jv) .gt. 0.1) .and. LAI(i,jv).gt.0. ) then                     
-      if  ( (height(i,jv) .gt. yzlay(i,k)) .AND. (height(i,jv) .gt. 0.1) ) then                     
-!FC attention veut on le test sur le LAI ?
-         if (ifl_pbltree.eq.1) then
-      drag_pro(i,k)= drag_pro(i,k)+ &
-      veget(i,jv)
-          elseif (ifl_pbltree.eq.2) then
-      drag_pro(i,k)= drag_pro(i,k)+ &
-      6*LAI(i,jv)*veget(i,jv)*( yzlay(i,k)*(height(i,jv)-yzlay(i,k))/(height(i,jv)*height(i,jv)+ 0.01))
-          elseif (ifl_pbltree.eq.3) then
-      drag_pro(i,k)= drag_pro(i,k)+ &
-      veget(i,jv)*( yzlay(i,k)*(height(i,jv)-yzlay(i,k))/(height(i,jv)*height(i,jv)+ 0.01))
-          elseif (ifl_pbltree.eq.0) then
-          drag_pro(i,k)=0.0
-           endif
-      else
-      drag_pro(i,k)= drag_pro(i,k)
-      endif
-
-
-      enddo
-      enddo
-     enddo 
-      do k=1,klev
-        where (sumveg(1:knon,k) > 0.05 ) 
-!        drag_pro(1:knon,k)=Cd_frein*drag_pro(1:knon,k)/sumveg(1:knon,k)
-        drag_pro(1:knon,k)=Cd_frein*drag_pro(1:knon,k)
-        elsewhere
-        drag_pro(1:knon,k)=0.0
-       endwhere
-        d_u(1:knon,k) =(-1)*drag_pro(1:knon,k)*uu(1:knon,k)*wind(1:knon,k)
-        d_v(1:knon,k) =(-1)*drag_pro(1:knon,k)*vv(1:knon,k)*wind(1:knon,k)
-      enddo
-      return
-
- END SUBROUTINE freinage
-
+link ../phylmd/freinage.F90
Index: LMDZ6/trunk/libf/phylmdiso/geo2atm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/geo2atm.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/geo2atm.F90	(revision 3940)
@@ -1,80 +1,1 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/geo2atm.F90,v 1.1 2008-12-05 17:56:40 lsce Exp $
-!
-SUBROUTINE geo2atm(im, jm, px, py, pz, plon, plat, pu, pv, pr)
-  USE dimphy
-  USE mod_phys_lmdz_para
-  USE mod_grid_phy_lmdz, only: grid_type, unstructured, regular_lonlat
-  IMPLICIT NONE
-  INCLUDE 'YOMCST.h'
-  CHARACTER (len = 6)                :: clmodnam
-  CHARACTER (len = 20)               :: modname = 'geo2atm'
-  CHARACTER (len = 80)               :: abort_message
-
-! Change wind coordinates from cartesian geocentric to local spherical
-! NB! Fonctionne probablement uniquement en MPI seul (sans OpenMP)
-!
-! Geocentric :
-  ! axe x is eastward : crosses (0N,90E) point.
-  ! axe y  crosses (0N,180E) point.
-  ! axe z is 'up' : crosses north pole.
-!
-! NB! Aux poles, fonctionne probablement uniquement en MPI seul (sans OpenMP)
-
-  INTEGER, INTENT (IN)                 :: im, jm
-  REAL, DIMENSION (im,jm), INTENT(IN)  :: px, py, pz
-  REAL, DIMENSION (im,jm), INTENT(IN)  :: plon, plat
-  REAL, DIMENSION (im,jm), INTENT(OUT) :: pu, pv, pr
-
-  REAL :: rad,reps
-
-
-  rad = rpi / 180.0E0
-  reps = 1.0e-5
-
-  pu(:,:) = &
-       - px(:,:) * SIN(rad * plon(:,:)) &
-       + py(:,:) * COS(rad * plon(:,:))
-
-  pv(:,:) = &
-       - px(:,:) * SIN(rad * plat(:,:)) * COS(rad * plon(:,:)) &
-       - py(:,:) * SIN(rad * plat(:,:)) * SIN(rad * plon(:,:)) &
-       + pz(:,:) * COS(rad * plat(:,:))  
-
-  pr(:,:) = &
-       + px(:,:) * COS(rad * plat(:,:)) * COS(rad * plon(:,:)) &
-       + py(:,:) * COS(rad * plat(:,:)) * SIN(rad * plon(:,:)) &
-       + pz(:,:) * SIN(rad * plat(:,:))
-
-  IF (grid_type==regular_lonlat) THEN
-    ! Value at North Pole
-    IF (is_north_pole_dyn) THEN
-       pu(:, 1) = -px (1,1)
-       pv(:, 1) = -py (1,1)
-       pr(:, 1) = 0.0
-    ENDIF
-  
-    ! Value at South Pole     
-    IF (is_south_pole_dyn) THEN
-       pu(:,jm) = -px (1,jm)
-       pv(:,jm) = -py (1,jm)
-       pr(:,jm) = 0.0
-    ENDIF
-
-  ELSE IF (grid_type==unstructured) THEN
-     ! Pole nord pour Dynamico
-     WHERE ( plat(:,:) >= 90.0-reps )
-        pu(:,:) =  py(:,:)
-        pv(:,:) = -px(:,:)
-        pr(:,:) = 0.0e0
-     END WHERE
-
-  ELSE
-     abort_message='Problem: unknown grid type'
-     CALL abort_physic(modname,abort_message,1)
-  END IF
-
-  
-  
-  
-END SUBROUTINE geo2atm
+link ../phylmd/geo2atm.F90
Index: LMDZ6/trunk/libf/phylmdiso/global_mean.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/global_mean.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/global_mean.F90	(revision 3940)
@@ -1,63 +1,1 @@
-  subroutine global_mean(field,airephy,laire,mfield)
-!
-! I.Musat: 05.2011
-! calcul moyenne globale d'un champ pondere par l'aire de la maille
-! (laire=.TRUE.) ou somme globale du champ (laire=.FALSE.)
-!
-  USE dimphy
-  USE mod_phys_lmdz_para, only: is_sequential
-  USE mod_phys_lmdz_transfert_para, only: reduce_sum
-  use mod_phys_lmdz_mpi_data, only: is_mpi_root
-  USE ioipsl
-  implicit none
-
-  real,dimension(klon),intent(in) :: field
-  real,dimension(klon),intent(in) :: airephy
-  LOGICAL, intent(in) :: laire
-  REAL, intent(out) :: mfield
-  REAL :: airetot     ! Total area the earth
-  REAL :: sumtmp
-  INTEGER :: i
-
-  if (is_sequential) then
-
-   airetot = 0.
-   sumtmp = 0.
-   DO i=1, klon
-    airetot = airetot + airephy(i)
-    sumtmp = sumtmp + field(i)
-   END DO
-   if (laire) THEN
-    if(airetot.NE.0.) THEN
-     mfield=sumtmp/airetot
-    endif
-   else
-    mfield=sumtmp
-   endif
-
-  else
-
-   CALL reduce_sum(SUM(airephy),airetot)
-   CALL reduce_sum(SUM(field),sumtmp)
-
-!$OMP MASTER
-  if (is_mpi_root) THEN
-  if (laire) THEN
-!  print*,'gmean airetot=',airetot
-   if(airetot.NE.0.) THEN
-    mfield=sumtmp/airetot
-!  else
-!   mfield=sumtmp
-   endif
-  else
-   mfield=sumtmp
-  endif
-
-! print*,'gmean sumtmp mfield=',sumtmp,mfield
-
-  endif !(is_mpi_root) THEN
-!$OMP END MASTER
-
-  endif
-
-  end subroutine global_mean
+link ../phylmd/global_mean.F90
Index: LMDZ6/trunk/libf/phylmdiso/gr_fi_ecrit.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/gr_fi_ecrit.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/gr_fi_ecrit.F90	(revision 3940)
@@ -1,24 +1,1 @@
-SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
-  IMPLICIT none
-  !
-  ! Tranformer une variable de la grille physique a
-  ! la grille d'ecriture
-  !
-  ! WARNING: This only works on the full global grid
-  !          (ie for GCM in serial mode)
-  INTEGER nfield,nlon,iim,jjmp1, jjm
-  REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
-  !
-  INTEGER i, n, ig
-  !
-  jjm = jjmp1 - 1
-  DO n = 1, nfield
-     DO i=1,iim
-        ecrit(i,n) = fi(1,n)
-        ecrit(i+jjm*iim,n) = fi(nlon,n)
-     ENDDO
-     DO ig = 1, nlon - 2
-        ecrit(iim+ig,n) = fi(1+ig,n)
-     ENDDO
-  ENDDO
-END SUBROUTINE gr_fi_ecrit
+link ../phylmd/gr_fi_ecrit.F90
Index: LMDZ6/trunk/libf/phylmdiso/grid_noro_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/grid_noro_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/grid_noro_m.F90	(revision 3940)
@@ -1,579 +1,1 @@
-!
-! $Id$
-!
-MODULE grid_noro_m
-!
-!*******************************************************************************
-
-  USE print_control_mod, ONLY: lunout
-  USE assert_eq_m,       ONLY: assert_eq
-  PRIVATE
-  PUBLIC :: grid_noro, grid_noro0, read_noro
-
-
-CONTAINS
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE grid_noro(xd,yd,zd,x,y,zphi,zmea,zstd,zsig,zgam,zthe,zpic,zval,mask)
-!
-!-------------------------------------------------------------------------------
-! Author: F. Lott (see also Z.X. Li, A. Harzallah et L. Fairhead)
-!-------------------------------------------------------------------------------
-! Purpose: Compute the Parameters of the SSO scheme as described in LOTT &MILLER
-!         (1997) and LOTT(1999).
-!-------------------------------------------------------------------------------
-! Comments:
-!  * Target points are on a rectangular grid:
-!      iim+1 latitudes including North and South Poles;
-!      jjm+1 longitudes, with periodicity jjm+1=1.
-!  * At the poles, the fields value is repeated jjm+1 time.
-!  * The parameters a,b,c,d represent the limits of the target gridpoint region.
-!    The means over this region are calculated from USN data, ponderated by a
-!    weight proportional to the surface occupated by the data inside the model
-!    gridpoint area. In most circumstances, this weight is the ratio between the
-!    surfaces of the USN gridpoint area and the model gridpoint area. 
-!
-!           (c)
-!        ----d-----
-!        | . . . .|
-!        |        |
-!     (b)a . * . .b(a)
-!        |        |
-!        | . . . .|
-!        ----c-----
-!           (d)
-!  * Hard-coded US Navy dataset dimensions (imdp=2160 ; jmdp=1080) have been
-!    removed (ALLOCATABLE used).
-!  * iext (currently 10% of imdp) represents the margin to ensure output cells
-!    on the edge are contained in input cells.
-!===============================================================================
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)  :: xd(:), yd(:)  !--- INPUT  COORDINATES     (imdp) (jmdp)
-  REAL, INTENT(IN)  :: zd(:,:)       !--- INPUT  FIELD           (imdp,jmdp)
-  REAL, INTENT(IN)  :: x(:), y(:)    !--- OUTPUT COORDINATES     (imar+1) (jmar)
-  REAL, INTENT(OUT) :: zphi(:,:)     !--- GEOPOTENTIAL           (imar+1,jmar)
-  REAL, INTENT(OUT) :: zmea(:,:)     !--- MEAN OROGRAPHY         (imar+1,jmar)
-  REAL, INTENT(OUT) :: zstd(:,:)     !--- STANDARD DEVIATION     (imar+1,jmar)
-  REAL, INTENT(OUT) :: zsig(:,:)     !--- SLOPE                  (imar+1,jmar)
-  REAL, INTENT(OUT) :: zgam(:,:)     !--- ANISOTROPY             (imar+1,jmar)
-  REAL, INTENT(OUT) :: zthe(:,:)     !--- SMALL AXIS ORIENTATION (imar+1,jmar)
-  REAL, INTENT(OUT) :: zpic(:,:)     !--- MAXIMUM ALTITITUDE     (imar+1,jmar)
-  REAL, INTENT(OUT) :: zval(:,:)     !--- MINIMUM ALTITITUDE     (imar+1,jmar)
-  REAL, INTENT(OUT) :: mask(:,:)     !--- MASK                   (imar+1,jmar)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname="grid_noro"
-  REAL, ALLOCATABLE :: xusn(:), yusn(:)           ! dim (imdp+2*iext) (jmdp+2)
-  REAL, ALLOCATABLE :: zusn(:,:)                  ! dim (imdp+2*iext,jmdp+2)
-! CORRELATIONS OF OROGRAPHY GRADIENT              ! dim (imar+1,jmar)
-  REAL, ALLOCATABLE :: ztz(:,:), zxtzx(:,:), zytzy(:,:), zxtzy(:,:), weight(:,:)
-! CORRELATIONS OF USN OROGRAPHY GRADIENTS         ! dim (imar+2*iext,jmdp+2)
-  REAL, ALLOCATABLE :: zxtzxusn(:,:), zytzyusn(:,:), zxtzyusn(:,:)
-  REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imar+1,jmar)
-  REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imar+1)
-  REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmar)
-  LOGICAL :: masque_lu
-  INTEGER :: i, ii, imdp, imar, iext
-  INTEGER :: j, jj, jmdp, jmar, nn
-  REAL    :: xpi, zdeltax, zlenx, weighx, xincr,  zweinor, xk, xl, xm
-  REAL    :: rad, zdeltay, zleny, weighy, masque, zweisud, xp, xq, xw
-
-
-
-!-------------------------------------------------------------------------------
-  imdp=assert_eq(SIZE(xd),SIZE(zd,1),TRIM(modname)//" imdp")
-  jmdp=assert_eq(SIZE(yd),SIZE(zd,2),TRIM(modname)//" jmdp")
-  imar=assert_eq([SIZE(x),SIZE(zphi,1),SIZE(zmea,1),SIZE(zstd,1),SIZE(zsig,1), &
-                          SIZE(zgam,1),SIZE(zthe,1),SIZE(zpic,1),SIZE(zval,1), &
-                          SIZE(mask,1)],TRIM(modname)//" imar")-1
-  jmar=assert_eq([SIZE(y),SIZE(zphi,2),SIZE(zmea,2),SIZE(zstd,2),SIZE(zsig,2), &
-                          SIZE(zgam,2),SIZE(zthe,2),SIZE(zpic,2),SIZE(zval,2), &
-                          SIZE(mask,2)],TRIM(modname)//" jmar")
-!  IF(imar/=iim)   CALL abort_physic(TRIM(modname),'imar/=iim'  ,1)
-!  IF(jmar/=jjm+1) CALL abort_physic(TRIM(modname),'jmar/=jjm+1',1)
-  iext=imdp/10                                !--- OK up to 36 degrees cell
-  xpi = ACOS(-1.)
-  rad = 6371229.
-  zdeltay=2.*xpi/REAL(jmdp)*rad
-  WRITE(lunout,*)"*** Orography parameters at sub-cell scale ***"
-
-!--- ARE WE USING A READ MASK ?
-  masque_lu=ANY(mask/=-99999.); IF(.NOT.masque_lu) mask=0.0
-  WRITE(lunout,*)'Masque lu: ',masque_lu
-
-!--- EXTENSION OF THE INPUT DATABASE TO PROCEED COMPUTATIONS AT BOUNDARIES:
-  ALLOCATE(xusn(imdp+2*iext))
-  xusn(1     +iext:imdp  +iext)=xd(:)
-  xusn(1          :       iext)=xd(1+imdp-iext:imdp)-2.*xpi
-  xusn(1+imdp+iext:imdp+2*iext)=xd(1          :iext)+2.*xpi
-
-  ALLOCATE(yusn(jmdp+2))
-  yusn(1       )=yd(1)   +(yd(1)   -yd(2))
-  yusn(2:jmdp+1)=yd(:)
-  yusn(  jmdp+2)=yd(jmdp)+(yd(jmdp)-yd(jmdp-1))
-
-  ALLOCATE(zusn(imdp+2*iext,jmdp+2))
-  zusn(1       +iext:imdp  +iext,2:jmdp+1)=zd  (:                   ,     :)
-  zusn(1            :       iext,2:jmdp+1)=zd  (imdp-iext+1:imdp    ,     :)
-  zusn(1+imdp  +iext:imdp+2*iext,2:jmdp+1)=zd  (1:iext              ,     :)
-  zusn(1            :imdp/2+iext,       1)=zusn(1+imdp/2:imdp  +iext,     2)
-  zusn(1+imdp/2+iext:imdp+2*iext,       1)=zusn(1       :imdp/2+iext,     2)
-  zusn(1            :imdp/2+iext,  jmdp+2)=zusn(1+imdp/2:imdp  +iext,jmdp+1)
-  zusn(1+imdp/2+iext:imdp+2*iext,  jmdp+2)=zusn(1       :imdp/2+iext,jmdp+1)
-
-!--- COMPUTE LIMITS OF MODEL GRIDPOINT AREA (REGULAR GRID)
-  ALLOCATE(a(imar+1),b(imar+1))
-  b(1:imar)=(x(1:imar  )+ x(2:imar+1))/2.0
-  b(imar+1)= x(  imar+1)+(x(  imar+1)-x(imar))/2.0
-  a(1)=x(1)-(x(2)-x(1))/2.0
-  a(2:imar+1)= b(1:imar)
-
-  ALLOCATE(c(jmar),d(jmar))
-  d(1:jmar-1)=(y(1:jmar-1)+ y(2:jmar))/2.0
-  d(  jmar  )= y(  jmar  )+(y(  jmar)-y(jmar-1))/2.0
-  c(1)=y(1)-(y(2)-y(1))/2.0
-  c(2:jmar)=d(1:jmar-1)
-
-!--- INITIALIZATIONS:
-  ALLOCATE(weight(imar+1,jmar)); weight(:,:)= 0.0
-  ALLOCATE(zxtzx (imar+1,jmar)); zxtzx (:,:)= 0.0
-  ALLOCATE(zytzy (imar+1,jmar)); zytzy (:,:)= 0.0
-  ALLOCATE(zxtzy (imar+1,jmar)); zxtzy (:,:)= 0.0
-  ALLOCATE(ztz   (imar+1,jmar)); ztz   (:,:)= 0.0
-  zmea(:,:)= 0.0
-  zpic(:,:)=-1.E+10
-  zval(:,:)= 1.E+10
-
-!--- COMPUTE SLOPES CORRELATIONS ON USN GRID
-! CORRELATIONS OF USN OROGRAPHY GRADIENTS  ! dim (imdp+2*iext,jmdp+2)
-  ALLOCATE(zytzyusn(imdp+2*iext,jmdp+2)); zytzyusn(:,:)=0.0
-  ALLOCATE(zxtzxusn(imdp+2*iext,jmdp+2)); zxtzxusn(:,:)=0.0
-  ALLOCATE(zxtzyusn(imdp+2*iext,jmdp+2)); zxtzyusn(:,:)=0.0
-  DO j = 2, jmdp+1
-    zdeltax=zdeltay*cos(yusn(j))
-    DO i = 2, imdp+2*iext-1
-      zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-      zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
-      zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))   /zdeltay  &
-     &             *(zusn(i+1,j)-zusn(i-1,j))   /zdeltax
-    END DO
-  END DO
-
-!--- SUMMATION OVER GRIDPOINT AREA
-  zleny=xpi/REAL(jmdp)*rad
-  xincr=xpi/REAL(jmdp)/2.
-  ALLOCATE(num_tot(imar+1,jmar)); num_tot(:,:)=0.
-  ALLOCATE(num_lan(imar+1,jmar)); num_lan(:,:)=0.
-  DO ii = 1, imar+1
-    DO jj = 1, jmar
-      DO j = 2,jmdp+1 
-        zlenx=zleny*COS(yusn(j))
-        zdeltax=zdeltay*COS(yusn(j))
-        weighy=(xincr+AMIN1(c(jj)-yusn(j),yusn(j)-d(jj)))*rad
-        weighy=AMAX1(0.,AMIN1(weighy,zleny))
-
-        IF(weighy==0.) CYCLE
-        DO i = 2, imdp+2*iext-1
-          weighx=(xincr+AMIN1(xusn(i)-a(ii),b(ii)-xusn(i)))*rad*COS(yusn(j))
-          weighx=AMAX1(0.,AMIN1(weighx,zlenx))
-
-          IF(weighx==0.) CYCLE
-          num_tot(ii,jj)=num_tot(ii,jj)+1.0
-          IF(zusn(i,j)>=1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
-          weight(ii,jj)=weight(ii,jj)+weighx*weighy
-          zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
-          zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
-          zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
-          ztz  (ii,jj)=  ztz(ii,jj)+zusn(i,j)*zusn(i,j)*weighx*weighy
-          zmea (ii,jj)= zmea(ii,jj)+zusn(i,j)*weighx*weighy !--- MEAN
-          zpic (ii,jj)=AMAX1(zpic(ii,jj),zusn(i,j))         !--- PEAKS
-          zval (ii,jj)=AMIN1(zval(ii,jj),zusn(i,j))         !--- VALLEYS
-        END DO
-      END DO
-    END DO
-  END DO
-
-!--- COMPUTE PARAMETERS NEEDED BY LOTT & MILLER (1997) AND LOTT (1999) SSO SCHEME
-  IF(.NOT.masque_lu) THEN
-    WHERE(weight(:,:)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
-  END IF
-  nn=COUNT(weight(:,:)==0.0)
-  IF(nn/=0) WRITE(lunout,*)'Problem with weight ; vanishing occurrences: ',nn
-  WHERE(weight(:,:)/=0.0)
-    zmea (:,:)=zmea (:,:)/weight(:,:)
-    zxtzx(:,:)=zxtzx(:,:)/weight(:,:)
-    zytzy(:,:)=zytzy(:,:)/weight(:,:)
-    zxtzy(:,:)=zxtzy(:,:)/weight(:,:)
-    ztz  (:,:)=ztz  (:,:)/weight(:,:)
-    zstd (:,:)=ztz  (:,:)-zmea(:,:)**2
-  END WHERE
-  WHERE(zstd(:,:)<0) zstd(:,:)=0.
-  zstd (:,:)=SQRT(zstd(:,:))
-
-!--- CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
-  zxtzx(:,   1)=zxtzx(:,     2)
-  zxtzx(:,jmar)=zxtzx(:,jmar-1)
-  zxtzy(:,   1)=zxtzy(:,     2)
-  zxtzy(:,jmar)=zxtzy(:,jmar-1)
-  zytzy(:,   1)=zytzy(:,     2)
-  zytzy(:,jmar)=zytzy(:,jmar-1)
-
-!=== FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
-!--- FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
-!-------------------------------------------------------------------------------
-  zphi(:,:)=zmea(:,:)                           ! GK211005 (CG) UNSMOOTHED TOPO
-
-  CALL MVA9(zmea);  CALL MVA9(zstd);  CALL MVA9(zpic);  CALL MVA9(zval)
-  CALL MVA9(zxtzx); CALL MVA9(zxtzy); CALL MVA9(zytzy)
-
-!--- MASK BASED ON GROUND MAXIMUM, 10% THRESHOLD. (SURFACE PARAMS MEANINGLESS)
-  WHERE(weight(:,:)==0.0.OR.mask<0.1)
-    zphi(:,:)=0.0; zmea(:,:)=0.0; zpic(:,:)=0.0; zval(:,:)=0.0; zstd(:,:)=0.0
-  END WHERE
-  DO ii = 1, imar
-    DO jj = 1, jmar
-      IF(weight(ii,jj)==0.0) CYCLE
-    !--- Coefficients K, L et M:
-      xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
-      xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
-      xm=zxtzy(ii,jj)
-      xp=xk-SQRT(xl**2+xm**2)
-      xq=xk+SQRT(xl**2+xm**2)
-      xw=1.e-8
-      IF(xp<=xw) xp=0.
-      IF(xq<=xw) xq=xw
-      IF(ABS(xm)<=xw) xm=xw*SIGN(1.,xm)
-    !--- SLOPE, ANISOTROPY AND THETA ANGLE
-      zsig(ii,jj)=SQRT(xq)
-      zgam(ii,jj)=xp/xq
-      zthe(ii,jj)=90.*ATAN2(xm,xl)/xpi
-    END DO
-  END DO
-  WHERE(weight(:,:)==0.0.OR.mask<0.1)
-    zsig(:,:)=0.0; zgam(:,:)=0.0; zthe(:,:)=0.0
-  END WHERE
-
-  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zmea)
-  WRITE(lunout,*)'  ST. DEV.:' ,MAXVAL(zstd)
-  WRITE(lunout,*)'  PENTE:'    ,MAXVAL(zsig)
-  WRITE(lunout,*)'  ANISOTROP:',MAXVAL(zgam)
-  WRITE(lunout,*)'  ANGLE:'    ,MINVAL(zthe),MAXVAL(zthe)
-  WRITE(lunout,*)'  pic:'      ,MAXVAL(zpic)
-  WRITE(lunout,*)'  val:'      ,MAXVAL(zval)
-      
-!--- Values at redundant longitude
-  zmea(imar+1,:)=zmea(1,:)
-  zphi(imar+1,:)=zphi(1,:)
-  zpic(imar+1,:)=zpic(1,:)
-  zval(imar+1,:)=zval(1,:)
-  zstd(imar+1,:)=zstd(1,:)
-  zsig(imar+1,:)=zsig(1,:)
-  zgam(imar+1,:)=zgam(1,:)
-  zthe(imar+1,:)=zthe(1,:)
-
-!--- Values at north pole
-  zweinor  =SUM(weight(1:imar,1))
-  zmea(:,1)=SUM(weight(1:imar,1)*zmea(1:imar,1))/zweinor
-  zphi(:,1)=SUM(weight(1:imar,1)*zphi(1:imar,1))/zweinor
-  zpic(:,1)=SUM(weight(1:imar,1)*zpic(1:imar,1))/zweinor
-  zval(:,1)=SUM(weight(1:imar,1)*zval(1:imar,1))/zweinor
-  zstd(:,1)=SUM(weight(1:imar,1)*zstd(1:imar,1))/zweinor
-  zsig(:,1)=SUM(weight(1:imar,1)*zsig(1:imar,1))/zweinor
-  zgam(:,1)=1.; zthe(:,1)=0.
-
-!--- Values at south pole
-  zweisud     =SUM(weight(1:imar,jmar),DIM=1)
-  zmea(:,jmar)=SUM(weight(1:imar,jmar)*zmea(1:imar,jmar))/zweisud
-  zphi(:,jmar)=SUM(weight(1:imar,jmar)*zphi(1:imar,jmar))/zweisud
-  zpic(:,jmar)=SUM(weight(1:imar,jmar)*zpic(1:imar,jmar))/zweisud
-  zval(:,jmar)=SUM(weight(1:imar,jmar)*zval(1:imar,jmar))/zweisud
-  zstd(:,jmar)=SUM(weight(1:imar,jmar)*zstd(1:imar,jmar))/zweisud
-  zsig(:,jmar)=SUM(weight(1:imar,jmar)*zsig(1:imar,jmar))/zweisud
-  zgam(:,jmar)=1.; zthe(:,jmar)=0.
-
-END SUBROUTINE grid_noro
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE grid_noro0(xd,yd,zd,x,y,zphi,mask)
-!
-!===============================================================================
-! Purpose: Extracted from grid_noro to provide geopotential height for dynamics
-!          without any call to physics subroutines.
-!===============================================================================
-  IMPLICIT NONE 
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)  :: xd(:), yd(:) !--- INPUT  COORDINATES     (imdp) (jmdp)
-  REAL, INTENT(IN)  :: zd(:,:)      !--- INPUT  FIELD           (imdp,  jmdp)
-  REAL, INTENT(IN)  :: x(:), y(:)   !--- OUTPUT COORDINATES     (imar+1) (jmar)
-  REAL, INTENT(OUT) :: zphi(:,:)    !--- GEOPOTENTIAL           (imar+1,jmar)
-  REAL, INTENT(OUT) :: mask(:,:)    !--- MASK                   (imar+1,jmar)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname="grid_noro0"
-  REAL, ALLOCATABLE :: xusn(:), yusn(:)           ! dim (imdp+2*iext) (jmdp+2)
-  REAL, ALLOCATABLE :: zusn(:,:)                  ! dim (imdp+2*iext,  jmdp+2)
-  REAL, ALLOCATABLE :: weight(:,:)                ! dim (imar+1,jmar)
-  REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imar+1,jmar)
-  REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imar+1)
-  REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmar)
-
-  LOGICAL :: masque_lu
-  INTEGER :: i, ii, imdp, imar, iext
-  INTEGER :: j, jj, jmdp, jmar, nn
-  REAL    :: xpi, zlenx, zleny, weighx, weighy, xincr, masque, rad
-
-!-------------------------------------------------------------------------------
-  imdp=assert_eq(SIZE(xd),SIZE(zd,1),TRIM(modname)//" imdp")
-  jmdp=assert_eq(SIZE(yd),SIZE(zd,2),TRIM(modname)//" jmdp")
-  imar=assert_eq(SIZE(x),SIZE(zphi,1),SIZE(mask,1),TRIM(modname)//" imar")-1
-  jmar=assert_eq(SIZE(y),SIZE(zphi,2),SIZE(mask,2),TRIM(modname)//" jmar")
-  iext=imdp/10
-  xpi = ACOS(-1.)
-  rad = 6371229.
-
-!--- ARE WE USING A READ MASK ?
-  masque_lu=ANY(mask/=-99999.); IF(.NOT.masque_lu) mask=0.0
-  WRITE(lunout,*)'Masque lu: ',masque_lu
-
-!--- EXTENSION OF THE INPUT DATABASE TO PROCEED COMPUTATIONS AT BOUNDARIES:
-  ALLOCATE(xusn(imdp+2*iext))
-  xusn(1     +iext:imdp  +iext)=xd(:)
-  xusn(1          :       iext)=xd(1+imdp-iext:imdp)-2.*xpi
-  xusn(1+imdp+iext:imdp+2*iext)=xd(1          :iext)+2.*xpi
-
-  ALLOCATE(yusn(jmdp+2))
-  yusn(1       )=yd(1)   +(yd(1)   -yd(2))
-  yusn(2:jmdp+1)=yd(:)
-  yusn(  jmdp+2)=yd(jmdp)+(yd(jmdp)-yd(jmdp-1))
-
-  ALLOCATE(zusn(imdp+2*iext,jmdp+2))
-  zusn(1       +iext:imdp  +iext,2:jmdp+1)=zd  (:                   ,     :)
-  zusn(1            :       iext,2:jmdp+1)=zd  (imdp-iext+1:imdp    ,     :)
-  zusn(1+imdp  +iext:imdp+2*iext,2:jmdp+1)=zd  (1:iext              ,     :)
-  zusn(1            :imdp/2+iext,       1)=zusn(1+imdp/2:imdp  +iext,     2)
-  zusn(1+imdp/2+iext:imdp+2*iext,       1)=zusn(1       :imdp/2+iext,     2)
-  zusn(1            :imdp/2+iext,  jmdp+2)=zusn(1+imdp/2:imdp  +iext,jmdp+1)
-  zusn(1+imdp/2+iext:imdp+2*iext,  jmdp+2)=zusn(1       :imdp/2+iext,jmdp+1)
-
-!--- COMPUTE LIMITS OF MODEL GRIDPOINT AREA (REGULAR GRID)
-  ALLOCATE(a(imar+1),b(imar+1))
-  b(1:imar)=(x(1:imar  )+ x(2:imar+1))/2.0
-  b(imar+1)= x(  imar+1)+(x(  imar+1)-x(imar))/2.0
-  a(1)=x(1)-(x(2)-x(1))/2.0
-  a(2:imar+1)= b(1:imar)
-
-  ALLOCATE(c(jmar),d(jmar))
-  d(1:jmar-1)=(y(1:jmar-1)+ y(2:jmar))/2.0
-  d(  jmar  )= y(  jmar  )+(y(  jmar)-y(jmar-1))/2.0
-  c(1)=y(1)-(y(2)-y(1))/2.0
-  c(2:jmar)=d(1:jmar-1)
-
-!--- INITIALIZATIONS:
-  ALLOCATE(weight(imar+1,jmar)); weight(:,:)=0.0; zphi(:,:)=0.0
-
-!--- SUMMATION OVER GRIDPOINT AREA
-  zleny=xpi/REAL(jmdp)*rad
-  xincr=xpi/REAL(jmdp)/2.
-  ALLOCATE(num_tot(imar+1,jmar)); num_tot(:,:)=0.
-  ALLOCATE(num_lan(imar+1,jmar)); num_lan(:,:)=0.
-  DO ii = 1, imar+1
-    DO jj = 1, jmar
-      DO j = 2,jmdp+1 
-        zlenx=zleny*COS(yusn(j))
-        weighy=(xincr+AMIN1(c(jj)-yusn(j),yusn(j)-d(jj)))*rad
-        weighy=AMAX1(0.,AMIN1(weighy,zleny))
-        IF(weighy/=0) CYCLE
-        DO i = 2, imdp+2*iext-1
-          weighx=(xincr+AMIN1(xusn(i)-a(ii),b(ii)-xusn(i)))*rad*COS(yusn(j))
-          weighx=AMAX1(0.,AMIN1(weighx,zlenx))
-          IF(weighx/=0) CYCLE
-          num_tot(ii,jj)=num_tot(ii,jj)+1.0
-          IF(zusn(i,j)>=1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
-          weight(ii,jj)=weight(ii,jj)+weighx*weighy
-          zphi  (ii,jj)=zphi  (ii,jj)+zusn(i,j)*weighx*weighy !--- MEAN
-        END DO
-      END DO
-    END DO
-  END DO
-
-!--- COMPUTE PARAMETERS NEEDED BY LOTT & MILLER (1997) AND LOTT (1999) SSO SCHEME
-  IF(.NOT.masque_lu) THEN
-    WHERE(weight(:,:)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
-  END IF
-  nn=COUNT(weight(:,:)==0.0)
-  IF(nn/=0) WRITE(lunout,*)'Problem with weight ; vanishing occurrences: ',nn
-  WHERE(weight/=0.0) zphi(:,:)=zphi(:,:)/weight(:,:)
-
-!--- MASK BASED ON GROUND MAXIMUM, 10% THRESHOLD (<10%: SURF PARAMS MEANINGLESS)
-  WHERE(weight(:,:)==0.0.OR.mask<0.1) zphi(:,:)=0.0
-  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zphi)
-
-!--- Values at redundant longitude and at poles
-  zphi(imar+1,:)=zphi(1,:)
-  zphi(:,   1)=SUM(weight(1:imar,   1)*zphi(1:imar,   1))/SUM(weight(1:imar,   1))
-  zphi(:,jmar)=SUM(weight(1:imar,jmar)*zphi(1:imar,jmar))/SUM(weight(1:imar,jmar))
-
-END SUBROUTINE grid_noro0
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE read_noro(x,y,fname,zphi,zmea,zstd,zsig,zgam,zthe,zpic,zval,mask)
-!
-!-------------------------------------------------------------------------------
-! Purpose: Read parameters usually determined with grid_noro from a file.
-!===============================================================================
-  USE netcdf, ONLY: NF90_OPEN,  NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION,        &
-        NF90_NOERR, NF90_CLOSE, NF90_INQ_VARID, NF90_GET_VAR, NF90_STRERROR,   &
-        NF90_NOWRITE
-  IMPLICIT NONE 
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)  :: x(:), y(:)    !--- OUTPUT COORDINATES     (imar+1) (jmar)
-  CHARACTER(LEN=*), INTENT(IN) :: fname ! PARAMETERS FILE NAME
-  REAL, INTENT(OUT) :: zphi(:,:)     !--- GEOPOTENTIAL           (imar+1,jmar)
-  REAL, INTENT(OUT) :: zmea(:,:)     !--- MEAN OROGRAPHY         (imar+1,jmar)
-  REAL, INTENT(OUT) :: zstd(:,:)     !--- STANDARD DEVIATION     (imar+1,jmar)
-  REAL, INTENT(OUT) :: zsig(:,:)     !--- SLOPE                  (imar+1,jmar)
-  REAL, INTENT(OUT) :: zgam(:,:)     !--- ANISOTROPY             (imar+1,jmar)
-  REAL, INTENT(OUT) :: zthe(:,:)     !--- SMALL AXIS ORIENTATION (imar+1,jmar)
-  REAL, INTENT(OUT) :: zpic(:,:)     !--- MAXIMUM ALTITUDE       (imar+1,jmar)
-  REAL, INTENT(OUT) :: zval(:,:)     !--- MINIMUM ALTITUDE       (imar+1,jmar)
-  REAL, INTENT(OUT) :: mask(:,:)     !--- MASK                   (imar+1,jmar)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname="read_noro"
-  INTEGER :: imar, jmar, fid, did, vid
-  LOGICAL :: masque_lu
-  REAL :: xpi, d2r
-!-------------------------------------------------------------------------------
-  imar=assert_eq([SIZE(x),SIZE(zphi,1),SIZE(zmea,1),SIZE(zstd,1),SIZE(zsig,1), &
-                          SIZE(zgam,1),SIZE(zthe,1),SIZE(zpic,1),SIZE(zval,1), &
-                          SIZE(mask,1)],TRIM(modname)//" imar")-1
-  jmar=assert_eq([SIZE(y),SIZE(zphi,2),SIZE(zmea,2),SIZE(zstd,2),SIZE(zsig,2), &
-                          SIZE(zgam,2),SIZE(zthe,2),SIZE(zpic,2),SIZE(zval,2), &
-                          SIZE(mask,2)],TRIM(modname)//" jmar")
-  xpi=ACOS(-1.0); d2r=xpi/180.
-  WRITE(lunout,*)"*** Orography parameters at sub-cell scale from file ***"
-
-!--- ARE WE USING A READ MASK ?
-  masque_lu=ANY(mask/=-99999.); IF(.NOT.masque_lu) mask=0.0
-  WRITE(lunout,*)'Masque lu: ',masque_lu
-  CALL ncerr(NF90_OPEN(fname,NF90_NOWRITE,fid))
-  CALL check_dim('x','longitude',x(1:imar))
-  CALL check_dim('y','latitude' ,y(1:jmar))
-  IF(.NOT.masque_lu) CALL get_fld('mask',mask)
-  CALL get_fld('Zphi',zphi)
-  CALL get_fld('Zmea',zmea)
-  CALL get_fld('mu'  ,zstd)
-  CALL get_fld('Zsig',zsig)
-  CALL get_fld('Zgam',zgam)
-  CALL get_fld('Zthe',zthe)
-  zpic=zmea+2*zstd
-  zval=MAX(0.,zmea-2.*zstd)
-  CALL ncerr(NF90_CLOSE(fid))
-  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zmea)
-  WRITE(lunout,*)'  ST. DEV.:' ,MAXVAL(zstd)
-  WRITE(lunout,*)'  PENTE:'    ,MAXVAL(zsig)
-  WRITE(lunout,*)'  ANISOTROP:',MAXVAL(zgam)
-  WRITE(lunout,*)'  ANGLE:'    ,MINVAL(zthe),MAXVAL(zthe)
-  WRITE(lunout,*)'  pic:'      ,MAXVAL(zpic)
-  WRITE(lunout,*)'  val:'      ,MAXVAL(zval)
-
-CONTAINS
-
-
-SUBROUTINE get_fld(var,fld)
-  CHARACTER(LEN=*), INTENT(IN)    :: var
-  REAL,             INTENT(INOUT) :: fld(:,:)
-  CALL ncerr(NF90_INQ_VARID(fid,var,vid),var)
-  CALL ncerr(NF90_GET_VAR(fid,vid,fld(1:imar,:)),var)
-  fld(imar+1,:)=fld(1,:)
-END SUBROUTINE get_fld
-
-SUBROUTINE check_dim(dimd,nam,dimv)
-  CHARACTER(LEN=*), INTENT(IN) :: dimd
-  CHARACTER(LEN=*), INTENT(IN) :: nam
-  REAL,             INTENT(IN) :: dimv(:)
-  REAL, ALLOCATABLE :: tmp(:)
-  INTEGER :: n
-  CALL ncerr(NF90_INQ_DIMID(fid,dimd,did))
-  CALL ncerr(NF90_INQUIRE_DIMENSION(fid,did,len=n)); ALLOCATE(tmp(n))
-  CALL ncerr(NF90_INQ_VARID(fid,dimd,did))
-  CALL ncerr(NF90_GET_VAR(fid,did,tmp))
-  IF(MAXVAL(tmp)>xpi) tmp=tmp*d2r
-  IF(n/=SIZE(dimv).OR.ANY(ABS(tmp-dimv)>1E-6)) THEN
-    WRITE(lunout,*)'Problem with file "'//TRIM(fname)//'".'
-    CALL abort_physic(modname,'Grid differs from LMDZ for '//TRIM(nam)//'.',1)
-  END IF
-END SUBROUTINE check_dim
-
-SUBROUTINE ncerr(ncres,var)
-  IMPLICIT NONE
-  INTEGER,          INTENT(IN) :: ncres
-  CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: var
-  CHARACTER(LEN=256) :: mess
-  IF(ncres/=NF90_NOERR) THEN
-    mess='Problem with file "'//TRIM(fname)//'"'
-    IF(PRESENT(var)) mess=TRIM(mess)//' and variable "'//TRIM(var)//'"'
-    WRITE(lunout,*)TRIM(mess)//'.'
-    CALL abort_physic(modname,NF90_STRERROR(ncres),1)
-  END IF
-END SUBROUTINE ncerr
-
-END SUBROUTINE read_noro
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE MVA9(x)
-!
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-! MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(INOUT) :: x(:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  REAL    :: xf(SIZE(x,DIM=1),SIZE(x,DIM=2)), WEIGHTpb(-1:1,-1:1)
-  INTEGER :: i, j, imar, jmar
-!-------------------------------------------------------------------------------
-  WEIGHTpb=RESHAPE([((1./REAL((1+i**2)*(1+j**2)),i=-1,1),j=-1,1)],SHAPE=[3,3])
-  WEIGHTpb=WEIGHTpb/SUM(WEIGHTpb)
-  imar=SIZE(X,DIM=1); jmar=SIZE(X,DIM=2)
-  DO j=2,jmar-1
-    DO i=2,imar-1
-      xf(i,j)=SUM(x(i-1:i+1,j-1:j+1)*WEIGHTpb(:,:))
-    END DO
-  END DO
-  DO j=2,jmar-1
-    xf(1,j)=SUM(x(imar-1,j-1:j+1)*WEIGHTpb(-1,:))
-    xf(1,j)=xf(1,j)+SUM(x(1:2,j-1:j+1)*WEIGHTpb(0:1,-1:1))
-    xf(imar,j)=xf(1,j)
-  END DO
-  xf(:,   1)=xf(:,     2)
-  xf(:,jmar)=xf(:,jmar-1)
-  x(:,:)=xf(:,:)
-
-END SUBROUTINE MVA9
-!
-!-------------------------------------------------------------------------------
-
-
-END MODULE grid_noro_m
-
-
+link ../phylmd/grid_noro_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/haut2bas.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/haut2bas.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/haut2bas.F90	(revision 3940)
@@ -1,19 +1,1 @@
-
-! $Header$
-
-SUBROUTINE haut2bas(klon, klev, varb2h, varh2b)
-  IMPLICIT NONE
-
-  INTEGER klon, klev
-  REAL varb2h(klon, klev), varh2b(klon, klev)
-  INTEGER i, k, kinv
-
-  DO k = 1, klev
-    kinv = klev - k + 1
-    DO i = 1, klon
-      varh2b(i, k) = varb2h(i, kinv)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE haut2bas
+link ../phylmd/haut2bas.F90
Index: LMDZ6/trunk/libf/phylmdiso/hbtm2l.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/hbtm2l.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/hbtm2l.F90	(revision 3940)
@@ -1,700 +1,1 @@
-
-! $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)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! ***************************************************************
-  ! *                                                             *
-  ! * HBTM2L   D'apres Holstag&Boville et Troen&Mahrt             *
-  ! *                 JAS 47              BLM                     *
-  ! * Algorithmes These Anne Mathieu                              *
-  ! * Critere d'Entrainement Peter Duynkerke (JAS 50)             *
-  ! * written by  : Anne MATHIEU & Alain LAHELLEC, 22/11/99       *
-  ! * features : implem. exces Mathieu                            *
-  ! ***************************************************************
-  ! * mods : decembre 99 passage th a niveau plus bas. voir fixer *
-  ! ***************************************************************
-  ! * fin therm a la HBTM passage a forme Mathieu 12/09/2001      *
-  ! ***************************************************************
-  ! AM Fev 2003 Adaptation a LMDZ version couplee                 *
-  ! *
-  ! Pour le moment on fait passer en argument les grdeurs de surface :
-  ! flux, t,q2m, t,q10m, on va utiliser systematiquement les grdeurs a 2m ms
-  ! on garde la possibilite de changer si besoin est (jusqu'a present la
-  ! forme de HB avec le 1er niveau modele etait conservee)       *
-  ! ***************************************************************
-  ! * re-ecriture complete Alain Mars 2012 dans LMDZ5V5           *
-  ! ***************************************************************
-  include "YOMCST.h"
-  REAL rlvcp, reps
-  ! Arguments:
-
-  INTEGER knon ! nombre de points a calculer
-  ! AM
-  REAL t2m(klon), t10m(klon) ! temperature a 2 et 10m
-  REAL q2m(klon), q10m(klon) ! q a 2 et 10m
-  REAL ustar(klon)
-  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
-  REAL u(klon, klev) ! vitesse U (m/s)
-  REAL v(klon, klev) ! vitesse V (m/s)
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! vapeur d'eau (kg/kg)
-
-  INTEGER isommet
-  REAL vk
-  PARAMETER (vk=0.35) ! Von Karman => passer a .41 ! cf U.Olgstrom
-  REAL ricr
-  PARAMETER (ricr=0.4)
-  REAL fak
-  PARAMETER (fak=8.5) ! b calcul du Prandtl et de dTetas
-  REAL fakn
-  PARAMETER (fakn=7.2) ! a
-  REAL onet
-  PARAMETER (onet=1.0/3.0)
-  REAL betam
-  PARAMETER (betam=15.0) ! pour Phim / h dans la S.L stable
-  REAL betah
-  PARAMETER (betah=15.0)
-  REAL betas
-  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
-  REAL binm
-  PARAMETER (binm=betam*sffrac)
-  REAL binh
-  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
-
-  REAL z(klon, klev)
-  ! AM
-  REAL zref, dt0
-  PARAMETER (zref=2.) ! Niveau de ref a 2m
-  PARAMETER (dt0=0.1) ! convergence do while
-
-  INTEGER i, k, j
-  REAL khfs(klon) ! surface kinematic heat flux [mK/s]
-  REAL kqfs(klon) ! sfc kinematic constituent flux [m/s]
-  REAL heatv(klon) ! surface virtual heat flux
-  REAL rhino(klon, klev) ! bulk Richardon no. mais en Theta_v
-  LOGICAL unstbl(klon) ! pts w/unstbl pbl (positive virtual ht flx)
-  LOGICAL check(klon) ! True=>chk if Richardson no.>critcal
-  LOGICAL omegafl(klon) ! flag de prolongement cape pour pt Omega
-  REAL obklen(klon) ! Monin-Obukhov lengh
-
-  REAL pblh(klon) ! PBL H               (m)
-  REAL therm(klon) ! exces du thermique  (K)
-  REAL plcl(klon) ! Lifted Cnd Level (Pa)
-  REAL cape(klon) ! Cape
-  REAL cin(klon) ! Inhibition
-  REAL eauliq(klon) ! Eau Liqu integree
-  REAL ctei(klon) ! Cld Top Entr. Instab.
-  REAL d_qt(klon) ! Saut de qT a l'inversion
-  REAL d_thv(klon) !         Theta_e
-  REAL dlt_2(klon) ! Ordonnee a gauche de courbe de melange
-  REAL xhis(klon) ! fraction de melange pour flottab nulle
-  REAL posint(klon) ! partie positive de l'int. de Peter
-  REAL omega(klon) ! point ultime de l'ascention du thermique
-  REAL diagok(klon) ! pour traiter les sous-mailles sans info
-  ! Algorithme thermique
-  REAL s(klon, klev) ! [P/Po]^Kappa milieux couches
-  REAL th_th(klon) ! potential temperature of thermal
-  REAL the_th(klon) ! equivalent potential temperature of thermal
-  REAL qt_th(klon) ! total water of thermal
-  REAL tbef(klon) ! T thermique niveau ou calcul precedent
-  LOGICAL zsat(klon) ! le thermique est sature
-  LOGICAL zcin(klon) ! calcul d'inhibition
-  REAL kape(klon) ! Cape locale
-  REAL kin(klon) ! Cin locale
-  ! calcul de CTEI etc
-  REAL the1, the2, aa, bb, zthvd, zthvu, qsat, chi, rh, zxt, zdu2
-  REAL rnum, denom, th1, th2, tv1, tv2, thv1, thv2, ql1, ql2, dt
-  REAL dqsat_dt, qsat2, qt1, q1, q2, t1, t2, tl1, te2, xnull, delt_the
-  REAL delt_qt, quadsat, spblh, reduc
-  ! diag      REAL dTv21(klon,klev)
-
-  REAL phiminv(klon) ! inverse phi function for momentum
-  REAL phihinv(klon) ! inverse phi function for heat
-  REAL wm(klon) ! turbulent velocity scale for momentum
-  REAL zm(klon) ! current level height
-  REAL zp(klon) ! current level height + one level up
-  REAL zcor, zdelta, zcvm5
-  REAL fac, pblmin
-  REAL missing_val
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! c      missing_val=nf90_fill_real (avec include netcdf)
-  missing_val = 0.
-
-  ! initialisations (Anne)
-  isommet = klev
-  b212 = sqrt(b1*b2)
-  b2sr = sqrt(b2)
-
-  ! Initialisation thermo
-  rlvcp = rlvtt/rcpd
-  reps = rd/rv
-  ! raz
-  q_star = 0.
-  t_star = 0.
-  cape(:) = missing_val
-  kape(:) = 0.
-  cin(:) = missing_val
-  eauliq(:) = missing_val
-  ctei(:) = missing_val
-  d_qt(:) = missing_val
-  d_thv(:) = missing_val
-  dlt_2(:) = missing_val
-  xhis(:) = missing_val
-  posint(:) = missing_val
-  kin(:) = missing_val
-  omega(:) = missing_val
-  diagok(:) = 0.
-  ! diag      dTv21(:,:)= missing_val
-
-  ! 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
-  END DO
-  ! s(k) = [pplay(k)/ps]^kappa
-  ! + + + + + + + + + pplay  <-> s(k)   t  dp=pplay(k-1)-pplay(k)
-
-  ! -----------------  paprs <-> sig(k)
-
-  ! + + + + + + + + + pplay  <-> s(k-1)
-
-
-  ! + + + + + + + + + pplay  <-> s(1)   t  dp=paprs-pplay   z(1)
-
-  ! -----------------  paprs <-> sig(1)
-
-  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
-  END DO
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! +++  Determination des grandeurs de surface  +++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  DO i = 1, knon
-    ! 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
-    ! ***************************************************
-    ! dif khfs est deja w't'_v / heatv(i) = khfs(i) + RETV*zxt*kqfs(i)
-    ! 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))
-    ! AM   verifier que khfs et kqfs sont bien de la forme w'l'
-    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)
-    ! Theta et qT du thermique sans exces
-    qt_th(i) = q2m(i)
-    ! Al1 Th_th restera la Theta du thermique sans exces jusqu'au 3eme calcul
-    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
-    ! Attention Plcl est pression ou altitude ?
-    ! plcl(i) = 6000. ! m
-    plcl(i) = 200. ! hPa
-    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))
-    ELSE
-      ! set pblh to the friction high (cf + bas)
-      pblh(i) = 700.0*ustar(i)
-      check(i) = .FALSE.
-    END IF
-  END DO
-
-
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! PBL height calculation:
-  ! Search for level of pbl. Scan upward until the Richardson number between
-  ! the first level and the current level exceeds the "critical" value.
-  ! (bonne idee Nu de separer le Ric et l'exces de temp du thermique)
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  fac = 100.0
-  DO k = 2, isommet
-    DO i = 1, knon
-      IF (check(i)) THEN
-        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))
-        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))
-          ! test04 (la pblh est encore ici sous-estime'e)
-          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 IF
-    END DO
-  END DO
-
-
-  ! Set pbl height to maximum value where computation exceeds number of
-  ! layers allowed
-
-  DO i = 1, knon
-    IF (check(i)) pblh(i) = z(i, isommet)
-  END DO
-
-  ! Improve estimate of pbl height for the unstable points.
-  ! Find unstable points (sensible heat flux is upward):
-
-  DO i = 1, knon
-    IF (heatv(i)>0.) THEN
-      unstbl(i) = .TRUE.
-      check(i) = .TRUE.
-    ELSE
-      unstbl(i) = .FALSE.
-      check(i) = .FALSE.
-    END IF
-  END DO
-
-  ! For the unstable case, compute velocity scale and the
-  ! convective temperature excess:
-
-  DO i = 1, knon
-    IF (check(i)) THEN
-      phiminv(i) = (1.-binm*pblh(i)/obklen(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 100m
-      ! ; 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
-      ! endif else if (z(ind) gt 20) then begin
-      ! wm=(u_star^3+c1*w_star^3)^(1/3.)
-      ! endif
-      ! ***************************************************
-      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)
-      ! endif else begin
-      ! Theta_s(i,j)=thetav_10(i,j)
-      ! q_s(i,j)=q_10(i,j)
-      ! endelse
-      ! leur reference est le niveau a 10m, mais on prend 2m ici.
-      ! ======================================================================
-      ! Premier calcul de l'exces tu thermique
-      ! ======================================================================
-      ! 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))
-      ! 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)
-
-      ! 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
-      rhino(i, 1) = 0.0
-    END IF
-  END DO
-
-  ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++ Improve pblh estimate for unstable conditions using the +++++++
-  ! ++          convective temperature excess :                +++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-  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,
-        ! qui assimile qT a vapeur)
-        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))
-
-        ! 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))
-          ! 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 IF
-    END DO
-  END DO
-
-  ! Set pbl height to maximum value where computation exceeds number of
-  ! layers allowed (H&B)
-
-  DO i = 1, knon
-    IF (check(i)) pblh(i) = z(i, isommet)
-  END DO
-
-  ! PBL height must be greater than some minimum mechanical mixing depth
-  ! Several investigators have proposed minimum mechanical mixing depth
-  ! relationships as a function of the local friction velocity, u*.  We
-  ! make use of a linear relationship of the form h = c u* where c=700.
-  ! The scaling arguments that give rise to this relationship most often
-  ! represent the coefficient c as some constant over the local coriolis
-  ! parameter.  Here we make use of the experimental results of Koracin
-  ! and Berkowicz (1988) [BLM, Vol 43] for wich they recommend 0.07/f
-  ! where f was evaluated at 39.5 N and 52 N.  Thus we use a typical mid
-  ! latitude value for f so that c = 0.07/f = 700.  (H&B)
-  ! Al1 calcul de pblT dans ce cas
-  DO i = 1, knon
-    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)
-      ! et 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 IF
-  END DO
-
-  ! ********************************************************************
-  ! pblh is now available; do preparation for final calculations :
-  ! ********************************************************************
-  DO i = 1, knon
-    check(i) = .TRUE.
-    zsat(i) = .FALSE.
-    zcin(i) = .FALSE.
-    ! omegafl utilise pour prolongement CAPE
-    omegafl(i) = .FALSE.
-
-    ! Do additional preparation for unstable cases only, set temperature
-    ! and moisture perturbations depending on stability.
-    ! Rq: les formules sont prises dans leur forme Couche de Surface
-    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)
-    END IF
-  END DO
-
-
-  ! =======================================================
-  ! last upward integration
-  ! For all unstable layers, compute integral info and CTEI
-  ! =======================================================
-
-  ! 1/Recompute surface characteristics with the improved pblh
-  ! ----------------------------------------------------------
-  DO i = 1, knon
-    IF (unstbl(i)) THEN
-      diagok(i) = 1.
-      ! from missing_value to zero
-      cape(i) = 0.
-      cin(i) = 0.
-      eauliq(i) = 0.
-      ctei(i) = 0.
-      d_qt(i) = 0.
-      d_thv(i) = 0.
-      dlt_2(i) = 0.
-      xhis(i) = 0.
-      posint(i) = 0.
-      kin(i) = 0.
-      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)
-      ! Al1diag
-      ! trmb1(i) = b1*(1.+2.*RETV*qT_th(i))*t_star**2
-      ! trmb2(i) = (RETV*Th_th(i))**2*b2*q_star*q_star
-      ! trmb3(i) = 2.*RETV*Th_th(i)*b212*q_star*t_star
-
-      ! Th_th will now be the thermal-theta (including exces)
-      ! c         Th_th(i) = Th_th(i)+sqrt(b1)*max(0.,khfs(i)/wm(i))
-      th_th(i) = th_th(i) + therm(i)
-      ! al1diag
-      ! trmb2(i) = wm(i)
-      ! trmb3(i) = phiminv(i)
-      ! and computes Theta_e for thermal
-      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)
-    qsat = min(0.5, qsat)
-    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)
-    ! al1diag
-    ! ctei(i) = Plcl(i)
-    ! cape(i) = T2
-    ! trmb1(i)= Chi
-    ! select unstable columns (=thermals)
-    check(i) = .FALSE.
-    IF (heatv(i)>0.) check(i) = .TRUE.
-    ! diag
-    ! dTv21(i,1) = T2*(1+RETV*qT_th(i))-t(i,1)*(1+RETV*q(i,1))
-  END DO
-  ! ----------------------------------
-  ! 2/ upward integration for thermals
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ k loop
-  DO k = 2, isommet
-    DO i = 1, knon
-      IF (check(i) .OR. omegafl(i)) THEN
-        ! CC         if (pplay(i,k) .le. plcl(i)) then
-        zm(i) = z(i, k-1)
-        zp(i) = z(i, k)
-        ! Environnement : calcul de Tv1 a partir de t(:,:)== T liquide
-        ! ==============
-        tl1 = t(i, k)
-        t1 = tl1
-        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)
-        ! thermodyn function (Tl2Tql)
-        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)
-          qsat = min(0.5, qsat)
-          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)
-          ql1 = q(i, k) - q1 ! can be negative
-          rnum = tl1 - t1 + rlvcp*ql1
-          dt = rnum/denom
-        END DO
-        ql1 = max(0., ql1)
-        tv1 = t1*(1.+retv*q1-ql1)
-        ! Thermique    : on atteint le seuil B/E de condensation
-        ! ==============
-
-        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)
-          qsat = min(0.5, qsat)
-          zcor = 1./(1.-retv*qsat)
-          qsat = qsat*zcor
-          q2 = min(qt_th(i), qsat)
-          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))
-            ! 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
-            ! on calcule pour le cas sans nuage un ctei en Delta Thv
-            thv2 = t2/spblh*(1.+retv*qt_th(i))
-            ctei(i) = thv1 - thv2
-            tv2 = t2*(1.+retv*q2-ql2)
-            ! diag
-            ! dTv21(i,k) = Tv2-Tv1
-            check(i) = .FALSE.
-            omegafl(i) = .TRUE.
-          END IF
-        END IF
-
-        IF (zsat(i)) THEN
-          ! thermodyn functions (Te2Tqsat)
-          t2 = tbef(i)
-          dt = 1.
-          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)
-            qsat = min(0.5, qsat)
-            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
-            t2 = t2 + dt
-          END DO
-          q2 = min(qt_th(i), qsat)
-          ql2 = max(0., qt_th(i)-q2)
-          ! jusqu'a PBLH y compris
-          IF (zm(i)<pblh(i)) THEN
-
-            ! 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))
-              ! 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
-              ! CTEI
-              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
-              ! Calcul de la Cloud Top Entrainement Instability
-              ! cf Mathieu Lahellec QJRMS (2005) Comments to DYCOMS-II
-              ! saut a l'inversion :
-              delt_the = the1 - the2 ! negatif
-              delt_qt = q(i, k) - qt_th(i) ! negatif
-              d_qt(i) = -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
-                d_thv(i) = aa - bb
-                ! approx de Xhi_s et de l'integrale Xint=ctei(i)
-                xhis(i) = bb/(aa-dlt_2(i))
-                ! trmb1(i) = xhis
-                ! trmb3(i) = dlt_2
-                xnull = bb/aa
-                IF (xhis(i)>0.1) THEN
-                  ctei(i) = dlt_2(i)*xhis(i) + aa*(1.-xhis(i)) + bb*alog(xhis(i))
-                ELSE
-                  ctei(i) = .5*(dlt_2(i)+aa-bb)
-                END IF
-                IF (xnull>0.) THEN
-                  posint(i) = aa - bb + bb*alog(xnull)
-                ELSE
-                  posint(i) = 0.
-                END IF
-              ELSE
-                ctei(i) = 1.
-                posint(i) = 1.
-              END IF
-              check(i) = .FALSE.
-              omegafl(i) = .TRUE.
-            END IF ! end a pblh
-            IF (check(i)) eauliq(i) = eauliq(i) + (paprs(i,k)-paprs(i,k+1))*ql2/rg
-          END IF
-
-        END IF ! Zsat
-
-        ! KAPE : thermique / environnement
-        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))
-        ! Cin
-        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
-          zcin(i) = .TRUE.
-          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
-          omega(i) = zm(i)
-          ! trmb3(i) = paprs(i,k)
-          omegafl(i) = .FALSE.
-          ! diag
-          ! print*,'Tv2-Tv1 (k): ',i,(dTv21(i,j),j=1,k)
-        END IF
-        ! CC         EndIf !plcl
-      END IF ! check(i)
-    END DO
-  END DO ! end of level loop
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ end k loop
-  RETURN
-END SUBROUTINE hbtm2l
+link ../phylmd/hbtm2l.F90
Index: LMDZ6/trunk/libf/phylmdiso/hbtm_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/hbtm_mod.F90	(revision 3940)
+++ LMDZ6/trunk/libf/phylmdiso/hbtm_mod.F90	(revision 3940)
@@ -0,0 +1,1 @@
+link ../phylmd/hbtm_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/hgardfou.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/hgardfou.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/hgardfou.F90	(revision 3940)
@@ -1,134 +1,1 @@
-
-! $Id: hgardfou.F90 2399 2015-11-20 16:23:28Z emillour $
-SUBROUTINE hgardfou(t, tsol, text,abortphy)
-  USE dimphy, ONLY: klon, klev
-  USE phys_state_var_mod, ONLY: pctsrf
-  USE geometry_mod, ONLY: longitude_deg, latitude_deg
-  USE indice_sol_mod, ONLY: nbsrf
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Verifier la temperature
-  ! ======================================================================
-  include "YOMCST.h"
-  REAL t(klon, klev), tsol(klon, nbsrf)
-  CHARACTER(len=*), intent(in):: text
-  CHARACTER (LEN=20) :: modname = 'hgardfou'
-  INTEGER abortphy
-
-  INTEGER i, k, nsrf
-  REAL zt(klon)
-  INTEGER jadrs(klon), jbad
-  LOGICAL ok
-
-  LOGICAL firstcall
-  SAVE firstcall
-  DATA firstcall/.TRUE./
-  !$OMP THREADPRIVATE(firstcall)
-
-  IF (firstcall) THEN
-    WRITE (lunout, *) 'hgardfou garantit la temperature dans [100,370] K'
-    firstcall = .FALSE.
-    ! DO i = 1, klon
-    ! WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
-    ! ENDDO
-
-  END IF
-
-  ok = .TRUE.
-  DO k = 1, klev
-    DO i = 1, klon
-      zt(i) = t(i, k)
-    END DO
-#ifdef CRAY
-    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
-#else
-    jbad = 0
-    DO i = 1, klon
-      IF (zt(i)>370.) THEN
-        jbad = jbad + 1
-        jadrs(jbad) = i
-      END IF
-    END DO
-#endif
-    IF (jbad>0) THEN
-      ok = .FALSE.
-      DO i = 1, jbad
-        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
-          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
-          latitude_deg(jadrs(i)),(pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
-      END DO
-    END IF
-#ifdef CRAY
-    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
-#else
-    jbad = 0
-    DO i = 1, klon
-      ! IF (zt(i).LT.100.0) THEN
-      IF (zt(i)<50.0) THEN
-        jbad = jbad + 1
-        jadrs(jbad) = i
-      END IF
-    END DO
-#endif
-    IF (jbad>0) THEN
-      ok = .FALSE.
-      DO i = 1, jbad
-        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
-          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
-          latitude_deg(jadrs(i)), (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
-      END DO
-    END IF
-  END DO
-
-  DO nsrf = 1, nbsrf
-    DO i = 1, klon
-      zt(i) = tsol(i, nsrf)
-    END DO
-#ifdef CRAY
-    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
-#else
-    jbad = 0
-    DO i = 1, klon
-      IF (zt(i)>370.0) THEN
-        jbad = jbad + 1
-        jadrs(jbad) = i
-      END IF
-    END DO
-#endif
-    IF (jbad>0) THEN
-      ok = .FALSE.
-      DO i = 1, jbad
-        WRITE (lunout, *) &
-          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
-          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
-          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
-      END DO
-    END IF
-#ifdef CRAY
-    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
-#else
-    jbad = 0
-    DO i = 1, klon
-      ! IF (zt(i).LT.100.0) THEN
-      IF (zt(i)<50.0) THEN
-        jbad = jbad + 1
-        jadrs(jbad) = i
-      END IF
-    END DO
-#endif
-    IF (jbad>0) THEN
-      ok = .FALSE.
-      DO i = 1, jbad
-        WRITE (lunout, *) &
-          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
-          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
-          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
-      END DO
-    END IF
-  END DO
-
-!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
-  IF (.NOT. ok) abortphy=1
-
-END SUBROUTINE hgardfou
+link ../phylmd/hgardfou.F90
Index: LMDZ6/trunk/libf/phylmdiso/hines_gwd.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/hines_gwd.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/hines_gwd.F90	(revision 3940)
@@ -1,2019 +1,1 @@
-
-! $Id: hines_gwd.F90 3102 2017-12-03 20:27:42Z oboucher $
-
-SUBROUTINE hines_gwd(nlon, nlev, dtime, paphm1x, papm1x, rlat, tx, ux, vx, &
-    zustrhi, zvstrhi, d_t_hin, d_u_hin, d_v_hin)
-
-  ! ########################################################################
-  ! Parametrization of the momentum flux deposition due to a broad band
-  ! spectrum of gravity waves, following Hines (1997a,b), as coded by
-  ! McLANDRESS (1995). Modified by McFARLANE and MANZINI (1995-1997)
-  ! MAECHAM model stand alone version
-  ! ########################################################################
-
-
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOEGWD.h"
-  include "YOMCST.h"
-
-  INTEGER nazmth
-  PARAMETER (nazmth=8)
-
-  ! INPUT ARGUMENTS.
-  ! ----- ----------
-
-  ! - 2D
-  ! PAPHM1   : HALF LEVEL PRESSURE (T-DT)
-  ! PAPM1    : FULL LEVEL PRESSURE (T-DT)
-  ! PTM1     : TEMPERATURE (T-DT)
-  ! PUM1     : ZONAL WIND (T-DT)
-  ! PVM1     : MERIDIONAL WIND (T-DT)
-
-
-  ! REFERENCE.
-  ! ----------
-  ! SEE MODEL DOCUMENTATION
-
-  ! AUTHOR.
-  ! -------
-
-  ! N. MCFARLANE   DKRZ-HAMBURG   MAY 1995
-  ! STAND ALONE E. MANZINI MPI-HAMBURG FEBRUARY 1997
-
-  ! BASED ON A COMBINATION OF THE OROGRAPHIC SCHEME BY N.MCFARLANE 1987
-  ! AND THE HINES SCHEME AS CODED BY C. MCLANDRESS 1995.
-
-
-
-  ! ym      INTEGER KLEVM1
-
-  REAL paphm1(klon, klev+1), papm1(klon, klev)
-  REAL ptm1(klon, klev), pum1(klon, klev), pvm1(klon, klev)
-  REAL prflux(klon)
-  ! 1
-  ! 1
-  ! 1
-  REAL rlat(klon), coslat(klon)
-
-  REAL th(klon, klev), utendgw(klon, klev), vtendgw(klon, klev), &
-    pressg(klon), uhs(klon, klev), vhs(klon, klev), zpr(klon)
-
-  ! * VERTICAL POSITIONING ARRAYS.
-
-  REAL sgj(klon, klev), shj(klon, klev), shxkj(klon, klev), dsgj(klon, klev)
-
-  ! * LOGICAL SWITCHES TO CONTROL ROOF DRAG, ENVELOP GW DRAG AND
-  ! * HINES' DOPPLER SPREADING EXTROWAVE GW DRAG.
-  ! * LOZPR IS TRUE FOR ZPR ENHANCEMENT
-
-
-  ! * WORK ARRAYS.
-
-  REAL m_alpha(klon, klev, nazmth), v_alpha(klon, klev, nazmth), &
-    sigma_alpha(klon, klev, nazmth), sigsqh_alpha(klon, klev, nazmth), &
-    drag_u(klon, klev), drag_v(klon, klev), flux_u(klon, klev), &
-    flux_v(klon, klev), heat(klon, klev), diffco(klon, klev), &
-    bvfreq(klon, klev), density(klon, klev), sigma_t(klon, klev), &
-    visc_mol(klon, klev), alt(klon, klev), sigsqmcw(klon, klev, nazmth), &
-    sigmatm(klon, klev), ak_alpha(klon, nazmth), k_alpha(klon, nazmth), &
-    mmin_alpha(klon, nazmth), i_alpha(klon, nazmth), rmswind(klon), &
-    bvfbot(klon), densbot(klon)
-  REAL smoothr1(klon, klev), smoothr2(klon, klev)
-  REAL sigalpmc(klon, klev, nazmth)
-  REAL f2mod(klon, klev)
-
-  ! * THES ARE THE INPUT PARAMETERS FOR HINES ROUTINE AND
-  ! * ARE SPECIFIED IN ROUTINE HINES_SETUP. SINCE THIS IS CALLED
-  ! * ONLY AT FIRST CALL TO THIS ROUTINE THESE VARIABLES MUST BE SAVED
-  ! * FOR USE AT SUBSEQUENT CALLS. THIS CAN BE AVOIDED BY CALLING
-  ! * HINES_SETUP IN MAIN PROGRAM AND PASSING THE PARAMETERS AS
-  ! * SUBROUTINE ARGUEMENTS.
-
-
-  REAL rmscon
-  INTEGER nmessg, iprint, ilrms
-  INTEGER ifl
-
-  INTEGER naz, icutoff, nsmax, iheatcal
-  REAL slope, f1, f2, f3, f5, f6, kstar(klon), alt_cutoff, smco
-
-  ! PROVIDED AS INPUT
-
-  INTEGER nlon, nlev
-
-  REAL dtime
-  REAL paphm1x(nlon, nlev+1), papm1x(nlon, nlev)
-  REAL ux(nlon, nlev), vx(nlon, nlev), tx(nlon, nlev)
-
-  ! VARIABLES FOR OUTPUT
-
-
-  REAL d_t_hin(nlon, nlev), d_u_hin(nlon, nlev), d_v_hin(nlon, nlev)
-  REAL zustrhi(nlon), zvstrhi(nlon)
-
-
-  ! * LOGICAL SWITCHES TO CONTROL PRECIP ENHANCEMENT AND
-  ! * HINES' DOPPLER SPREADING EXTROWAVE GW DRAG.
-  ! * LOZPR IS TRUE FOR ZPR ENHANCEMENT
-
-  LOGICAL lozpr, lorms(klon)
-
-  ! LOCAL PARAMETERS TO MAKE THINGS WORK (TEMPORARY VARIABLE)
-
-  REAL rhoh2o, zpcons, rgocp, zlat, dttdsf, ratio, hscal
-  INTEGER i, j, l, jl, jk, le, lref, lrefp, levbot
-
-  ! DATA PARAMETERS NEEDED, EXPLAINED LATER
-
-  REAL v0, vmin, dmpscal, taufac, hmin, apibt, cpart, fcrit
-  REAL pcrit, pcons
-  INTEGER iplev, ierror
-
-
-
-  ! PRINT *,' IT IS STARTED HINES GOING ON...'
-
-
-
-
-  ! *    COMPUTATIONAL CONSTANTS.
-  ! ------------- ----------
-
-
-  d_t_hin(:, :) = 0.
-
-  rhoh2o = 1000.
-  zpcons = (1000.*86400.)/rhoh2o
-  ! ym      KLEVM1=KLEV-1
-
-
-  DO jl = kidia, kfdia
-    paphm1(jl, 1) = paphm1x(jl, klev+1)
-    DO jk = 1, klev
-      le = klev + 1 - jk
-      paphm1(jl, jk+1) = paphm1x(jl, le)
-      papm1(jl, jk) = papm1x(jl, le)
-      ptm1(jl, jk) = tx(jl, le)
-      pum1(jl, jk) = ux(jl, le)
-      pvm1(jl, jk) = vx(jl, le)
-    END DO
-  END DO
-
-  ! Define constants and arrays needed for the ccc/mam gwd scheme
-  ! *Constants:
-
-  rgocp = rd/rcpd
-  lrefp = klev - 1
-  lref = klev - 2
-  ! 1
-  ! 1    *Arrays
-  ! 1
-  DO jk = 1, klev
-    DO jl = kidia, kfdia
-      shj(jl, jk) = papm1(jl, jk)/paphm1(jl, klev+1)
-      sgj(jl, jk) = papm1(jl, jk)/paphm1(jl, klev+1)
-      dsgj(jl, jk) = (paphm1(jl,jk+1)-paphm1(jl,jk))/paphm1(jl, klev+1)
-      shxkj(jl, jk) = (papm1(jl,jk)/paphm1(jl,klev+1))**rgocp
-      th(jl, jk) = ptm1(jl, jk)
-    END DO
-  END DO
-
-  ! C
-  DO jl = kidia, kfdia
-    pressg(jl) = paphm1(jl, klev+1)
-  END DO
-
-
-  DO jl = kidia, kfdia
-    prflux(jl) = 0.0
-    zpr(jl) = zpcons*prflux(jl)
-    zlat = (rlat(jl)/180.)*rpi
-    coslat(jl) = cos(zlat)
-  END DO
-
-  ! /#########################################################################
-  ! /
-  ! /
-
-  ! * AUG. 14/95 - C. MCLANDRESS.
-  ! * SEP.    95   N. MCFARLANE.
-
-  ! * THIS ROUTINE CALCULATES THE HORIZONTAL WIND TENDENCIES
-  ! * DUE TO MCFARLANE'S OROGRAPHIC GW DRAG SCHEME, HINES'
-  ! * DOPPLER SPREAD SCHEME FOR "EXTROWAVES" AND ADDS ON
-  ! * ROOF DRAG. IT IS BASED ON THE ROUTINE GWDFLX8.
-
-  ! * LREFP IS THE INDEX OF THE MODEL LEVEL BELOW THE REFERENCE LEVEL
-  ! * I/O ARRAYS PASSED FROM MAIN.
-  ! * (PRESSG = SURFACE PRESSURE)
-
-
-
-
-  ! * CONSTANTS VALUES DEFINED IN DATA STATEMENT ARE :
-  ! * VMIN     = MIMINUM WIND IN THE DIRECTION OF REFERENCE LEVEL
-  ! *            WIND BEFORE WE CONSIDER BREAKING TO HAVE OCCURED.
-  ! * DMPSCAL  = DAMPING TIME FOR GW DRAG IN SECONDS.
-  ! * TAUFAC   = 1/(LENGTH SCALE).
-  ! * HMIN     = MIMINUM ENVELOPE HEIGHT REQUIRED TO PRODUCE GW DRAG.
-  ! * V0       = VALUE OF WIND THAT APPROXIMATES ZERO.
-
-
-  DATA vmin/5.0/, v0/1.E-10/, taufac/5.E-6/, hmin/40000./, dmpscal/6.5E+6/, &
-    apibt/1.5708/, cpart/0.7/, fcrit/1./
-
-  ! * HINES EXTROWAVE GWD CONSTANTS DEFINED IN DATA STATEMENT ARE:
-  ! * RMSCON = ROOT MEAN SQUARE GRAVITY WAVE WIND AT LOWEST LEVEL (M/S).
-  ! * NMESSG  = UNIT NUMBER FOR PRINTED MESSAGES.
-  ! * IPRINT  = 1 TO DO PRINT OUT SOME HINES ARRAYS.
-  ! * IFL     = FIRST CALL FLAG TO HINES_SETUP ("SAVE" IT)
-  ! * PCRIT = CRITICAL VALUE OF ZPR (MM/D)
-  ! * IPLEV = LEVEL OF APPLICATION OF PRCIT
-  ! * PCONS = FACTOR OF ZPR ENHANCEMENT
-
-
-  DATA pcrit/5./, pcons/4.75/
-
-  iplev = lrefp - 1
-
-  DATA rmscon/1.00/iprint/2/, nmessg/6/
-  DATA ifl/0/
-
-  lozpr = .FALSE.
-
-  ! -----------------------------------------------------------------------
-
-
-
-  ! * SET ERROR FLAG
-
-  ierror = 0
-
-  ! * SPECIFY VARIOUS PARAMETERS FOR HINES ROUTINE AT VERY FIRST CALL.
-  ! * (NOTE THAT ARRAY K_ALPHA IS SPECIFIED SO MAKE SURE THAT
-  ! * IT IS NOT OVERWRITTEN LATER ON).
-
-  CALL hines_setup(naz, slope, f1, f2, f3, f5, f6, kstar, icutoff, &
-    alt_cutoff, smco, nsmax, iheatcal, k_alpha, ierror, nmessg, klon, nazmth, &
-    coslat)
-  IF (ierror/=0) GO TO 999
-
-  ! * START GWD CALCULATIONS.
-
-  lref = lrefp - 1
-
-
-  DO j = 1, nazmth
-    DO l = 1, klev
-      DO i = kidia, klon
-        sigsqmcw(i, l, j) = 0.
-      END DO
-    END DO
-  END DO
-
-
-
-  ! * INITIALIZE NECESSARY ARRAYS.
-
-  DO l = 1, klev
-    DO i = kidia, kfdia
-      utendgw(i, l) = 0.
-      vtendgw(i, l) = 0.
-
-      uhs(i, l) = 0.
-      vhs(i, l) = 0.
-
-    END DO
-  END DO
-
-  ! * IF USING HINES SCHEME THEN CALCULATE B V FREQUENCY AT ALL POINTS
-  ! * AND SMOOTH BVFREQ.
-
-  DO l = 2, klev
-    DO i = kidia, kfdia
-      dttdsf = (th(i,l)/shxkj(i,l)-th(i,l-1)/shxkj(i,l-1))/ &
-        (shj(i,l)-shj(i,l-1))
-      dttdsf = min(dttdsf, -5./sgj(i,l))
-      bvfreq(i, l) = sqrt(-dttdsf*sgj(i,l)*(sgj(i,l)**rgocp)/rd)*rg/ptm1(i, l &
-        )
-    END DO
-  END DO
-  DO l = 1, klev
-    DO i = kidia, kfdia
-      IF (l==1) THEN
-        bvfreq(i, l) = bvfreq(i, l+1)
-      END IF
-      IF (l>1) THEN
-        ratio = 5.*log(sgj(i,l)/sgj(i,l-1))
-        bvfreq(i, l) = (bvfreq(i,l-1)+ratio*bvfreq(i,l))/(1.+ratio)
-      END IF
-    END DO
-  END DO
-
-  ! * CALCULATE GW DRAG DUE TO HINES' EXTROWAVES
-  ! * SET MOLECULAR VISCOSITY TO A VERY SMALL VALUE.
-  ! * IF THE MODEL TOP IS GREATER THAN 100 KM THEN THE ACTUAL
-  ! * VISCOSITY COEFFICIENT COULD BE SPECIFIED HERE.
-
-  DO l = 1, klev
-    DO i = kidia, kfdia
-      visc_mol(i, l) = 1.5E-5
-      drag_u(i, l) = 0.
-      drag_v(i, l) = 0.
-      flux_u(i, l) = 0.
-      flux_v(i, l) = 0.
-      heat(i, l) = 0.
-      diffco(i, l) = 0.
-    END DO
-  END DO
-
-  ! * ALTITUDE AND DENSITY AT BOTTOM.
-
-  DO i = kidia, kfdia
-    hscal = rd*ptm1(i, klev)/rg
-    density(i, klev) = sgj(i, klev)*pressg(i)/(rg*hscal)
-    alt(i, klev) = 0.
-  END DO
-
-  ! * ALTITUDE AND DENSITY AT REMAINING LEVELS.
-
-  DO l = klev - 1, 1, -1
-    DO i = kidia, kfdia
-      hscal = rd*ptm1(i, l)/rg
-      alt(i, l) = alt(i, l+1) + hscal*dsgj(i, l)/sgj(i, l)
-      density(i, l) = sgj(i, l)*pressg(i)/(rg*hscal)
-    END DO
-  END DO
-
-
-  ! * INITIALIZE SWITCHES FOR HINES GWD CALCULATION
-
-  ilrms = 0
-
-  DO i = kidia, kfdia
-    lorms(i) = .FALSE.
-  END DO
-
-
-  ! * DEFILE BOTTOM LAUNCH LEVEL
-
-  levbot = iplev
-
-  ! * BACKGROUND WIND MINUS VALUE AT BOTTOM LAUNCH LEVEL.
-
-  DO l = 1, levbot
-    DO i = kidia, kfdia
-      uhs(i, l) = pum1(i, l) - pum1(i, levbot)
-      vhs(i, l) = pvm1(i, l) - pvm1(i, levbot)
-    END DO
-  END DO
-
-  ! * SPECIFY ROOT MEAN SQUARE WIND AT BOTTOM LAUNCH LEVEL.
-
-  DO i = kidia, kfdia
-    rmswind(i) = rmscon
-  END DO
-
-  IF (lozpr) THEN
-    DO i = kidia, kfdia
-      IF (zpr(i)>pcrit) THEN
-        rmswind(i) = rmscon + ((zpr(i)-pcrit)/zpr(i))*pcons
-      END IF
-    END DO
-  END IF
-
-  DO i = kidia, kfdia
-    IF (rmswind(i)>0.0) THEN
-      ilrms = ilrms + 1
-      lorms(i) = .TRUE.
-    END IF
-  END DO
-
-  ! * CALCULATE GWD (NOTE THAT DIFFUSION COEFFICIENT AND
-  ! * HEATING RATE ONLY CALCULATED IF IHEATCAL = 1).
-
-  IF (ilrms>0) THEN
-
-    CALL hines_extro0(drag_u, drag_v, heat, diffco, flux_u, flux_v, uhs, vhs, &
-      bvfreq, density, visc_mol, alt, rmswind, k_alpha, m_alpha, v_alpha, &
-      sigma_alpha, sigsqh_alpha, ak_alpha, mmin_alpha, i_alpha, sigma_t, &
-      densbot, bvfbot, 1, iheatcal, icutoff, iprint, nsmax, smco, alt_cutoff, &
-      kstar, slope, f1, f2, f3, f5, f6, naz, sigsqmcw, sigmatm, kidia, klon, &
-      1, levbot, klon, klev, nazmth, lorms, smoothr1, smoothr2, sigalpmc, &
-      f2mod)
-
-    ! * ADD ON HINES' GWD TENDENCIES TO OROGRAPHIC TENDENCIES AND
-    ! * APPLY HINES' GW DRAG ON (UROW,VROW) WORK ARRAYS.
-
-    DO l = 1, klev
-      DO i = kidia, kfdia
-        utendgw(i, l) = utendgw(i, l) + drag_u(i, l)
-        vtendgw(i, l) = vtendgw(i, l) + drag_v(i, l)
-      END DO
-    END DO
-
-
-    ! * END OF HINES CALCULATIONS.
-
-  END IF
-
-  ! -----------------------------------------------------------------------
-
-  DO jl = kidia, kfdia
-    zustrhi(jl) = flux_u(jl, 1)
-    zvstrhi(jl) = flux_v(jl, 1)
-    DO jk = 1, klev
-      le = klev - jk + 1
-      d_u_hin(jl, jk) = utendgw(jl, le)*dtime
-      d_v_hin(jl, jk) = vtendgw(jl, le)*dtime
-    END DO
-  END DO
-
-  ! PRINT *,'UTENDGW:',UTENDGW
-
-  ! PRINT *,' HINES HAS BEEN COMPLETED (LONG ISNT IT...)'
-
-  RETURN
-999 CONTINUE
-
-  ! * IF ERROR DETECTED THEN ABORT.
-
-  WRITE (nmessg, 6000)
-  WRITE (nmessg, 6010) ierror
-6000 FORMAT (/' EXECUTION ABORTED IN GWDOREXV')
-6010 FORMAT ('     ERROR FLAG =', I4)
-
-
-  RETURN
-END SUBROUTINE hines_gwd
-! /
-! /
-
-
-SUBROUTINE hines_extro0(drag_u, drag_v, heat, diffco, flux_u, flux_v, vel_u, &
-    vel_v, bvfreq, density, visc_mol, alt, rmswind, k_alpha, m_alpha, &
-    v_alpha, sigma_alpha, sigsqh_alpha, ak_alpha, mmin_alpha, i_alpha, &
-    sigma_t, densb, bvfb, iorder, iheatcal, icutoff, iprint, nsmax, smco, &
-    alt_cutoff, kstar, slope, f1, f2, f3, f5, f6, naz, sigsqmcw, sigmatm, &
-    il1, il2, lev1, lev2, nlons, nlevs, nazmth, lorms, smoothr1, smoothr2, &
-    sigalpmc, f2mod)
-
-  IMPLICIT NONE
-
-  ! Main routine for Hines' "extrowave" gravity wave parameterization based
-  ! on Hines' Doppler spread theory. This routine calculates zonal
-  ! and meridional components of gravity wave drag, heating rates
-  ! and diffusion coefficient on a longitude by altitude grid.
-  ! No "mythical" lower boundary region calculation is made so it
-  ! is assumed that lowest level winds are weak (i.e, approximately zero).
-
-  ! Aug. 13/95 - C. McLandress
-  ! SEPT. /95  - N.McFarlane
-
-  ! Modifications:
-
-  ! Output arguements:
-
-  ! * DRAG_U = zonal component of gravity wave drag (m/s^2).
-  ! * DRAG_V = meridional component of gravity wave drag (m/s^2).
-  ! * HEAT   = gravity wave heating (K/sec).
-  ! * DIFFCO = diffusion coefficient (m^2/sec)
-  ! * FLUX_U = zonal component of vertical momentum flux (Pascals)
-  ! * FLUX_V = meridional component of vertical momentum flux (Pascals)
-
-  ! Input arguements:
-
-  ! * VEL_U      = background zonal wind component (m/s).
-  ! * VEL_V      = background meridional wind component (m/s).
-  ! * BVFREQ     = background Brunt Vassala frequency (radians/sec).
-  ! * DENSITY    = background density (kg/m^3)
-  ! * VISC_MOL   = molecular viscosity (m^2/s)
-  ! * ALT        = altitude of momentum, density, buoyancy levels (m)
-  ! *              (NOTE: levels ordered so that ALT(I,1) > ALT(I,2), etc.)
-  ! * RMSWIND   = root mean square gravity wave wind at lowest level (m/s).
-  ! * K_ALPHA    = horizontal wavenumber of each azimuth (1/m).
-  ! * IORDER	   = 1 means vertical levels are indexed from top down
-  ! *              (i.e., highest level indexed 1 and lowest level NLEVS);
-  ! *           .NE. 1 highest level is index NLEVS.
-  ! * IHEATCAL   = 1 to calculate heating rates and diffusion coefficient.
-  ! * IPRINT     = 1 to print out various arrays.
-  ! * ICUTOFF    = 1 to exponentially damp GWD, heating and diffusion
-  ! *              arrays above ALT_CUTOFF; otherwise arrays not modified.
-  ! * ALT_CUTOFF = altitude in meters above which exponential decay applied.
-  ! * SMCO       = smoothing factor used to smooth cutoff vertical
-  ! *              wavenumbers and total rms winds in vertical direction
-  ! *              before calculating drag or heating
-  ! *              (SMCO >= 1 ==> 1:SMCO:1 stencil used).
-  ! * NSMAX      = number of times smoother applied ( >= 1),
-  ! *            = 0 means no smoothing performed.
-  ! * KSTAR      = typical gravity wave horizontal wavenumber (1/m).
-  ! * SLOPE      = slope of incident vertical wavenumber spectrum
-  ! *              (SLOPE must equal 1., 1.5 or 2.).
-  ! * F1 to F6   = Hines's fudge factors (F4 not needed since used for
-  ! *              vertical flux of vertical momentum).
-  ! * NAZ        = actual number of horizontal azimuths used.
-  ! * IL1        = first longitudinal index to use (IL1 >= 1).
-  ! * IL2        = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * LEV1       = index of first level for drag calculation.
-  ! * LEV2       = index of last level for drag calculation
-  ! *              (i.e., LEV1 < LEV2 <= NLEVS).
-  ! * NLONS      = number of longitudes.
-  ! * NLEVS      = number of vertical levels.
-  ! * NAZMTH     = azimuthal array dimension (NAZMTH >= NAZ).
-
-  ! Work arrays.
-
-  ! * M_ALPHA      = cutoff vertical wavenumber (1/m).
-  ! * V_ALPHA      = wind component at each azimuth (m/s) and if IHEATCAL=1
-  ! *                holds vertical derivative of cutoff wavenumber.
-  ! * SIGMA_ALPHA  = total rms wind in each azimuth (m/s).
-  ! * SIGSQH_ALPHA = portion of wind variance from waves having wave
-  ! *                normals in the alpha azimuth (m/s).
-  ! * SIGMA_T      = total rms horizontal wind (m/s).
-  ! * AK_ALPHA     = spectral amplitude factor at each azimuth
-  ! *                (i.e.,{AjKj}) in m^4/s^2.
-  ! * I_ALPHA      = Hines' integral.
-  ! * MMIN_ALPHA   = minimum value of cutoff wavenumber.
-  ! * DENSB        = background density at bottom level.
-  ! * BVFB         = buoyancy frequency at bottom level and
-  ! *                work array for ICUTOFF = 1.
-
-  ! * LORMS       = .TRUE. for drag computation
-
-  INTEGER naz, nlons, nlevs, nazmth, il1, il2, lev1, lev2
-  INTEGER icutoff, nsmax, iorder, iheatcal, iprint
-  REAL kstar(nlons), f1, f2, f3, f5, f6, slope
-  REAL alt_cutoff, smco
-  REAL drag_u(nlons, nlevs), drag_v(nlons, nlevs)
-  REAL heat(nlons, nlevs), diffco(nlons, nlevs)
-  REAL flux_u(nlons, nlevs), flux_v(nlons, nlevs)
-  REAL vel_u(nlons, nlevs), vel_v(nlons, nlevs)
-  REAL bvfreq(nlons, nlevs), density(nlons, nlevs)
-  REAL visc_mol(nlons, nlevs), alt(nlons, nlevs)
-  REAL rmswind(nlons), bvfb(nlons), densb(nlons)
-  REAL sigma_t(nlons, nlevs), sigsqmcw(nlons, nlevs, nazmth)
-  REAL sigma_alpha(nlons, nlevs, nazmth), sigmatm(nlons, nlevs)
-  REAL sigsqh_alpha(nlons, nlevs, nazmth)
-  REAL m_alpha(nlons, nlevs, nazmth), v_alpha(nlons, nlevs, nazmth)
-  REAL ak_alpha(nlons, nazmth), k_alpha(nlons, nazmth)
-  REAL mmin_alpha(nlons, nazmth), i_alpha(nlons, nazmth)
-  REAL smoothr1(nlons, nlevs), smoothr2(nlons, nlevs)
-  REAL sigalpmc(nlons, nlevs, nazmth)
-  REAL f2mod(nlons, nlevs)
-
-  LOGICAL lorms(nlons)
-
-  ! Internal variables.
-
-  INTEGER levbot, levtop, i, n, l, lev1p, lev2m
-  INTEGER ilprt1, ilprt2
-  ! -----------------------------------------------------------------------
-
-  ! PRINT *,' IN HINES_EXTRO0'
-  lev1p = lev1 + 1
-  lev2m = lev2 - 1
-
-  ! Index of lowest altitude level (bottom of drag calculation).
-
-  levbot = lev2
-  levtop = lev1
-  IF (iorder/=1) THEN
-    WRITE (6, 1)
-1   FORMAT (2X, ' error: IORDER NOT ONE! ')
-  END IF
-
-  ! Buoyancy and density at bottom level.
-
-  DO i = il1, il2
-    bvfb(i) = bvfreq(i, levbot)
-    densb(i) = density(i, levbot)
-  END DO
-
-  ! initialize some variables
-
-  DO n = 1, naz
-    DO l = lev1, lev2
-      DO i = il1, il2
-        m_alpha(i, l, n) = 0.0
-      END DO
-    END DO
-  END DO
-  DO l = lev1, lev2
-    DO i = il1, il2
-      sigma_t(i, l) = 0.0
-    END DO
-  END DO
-  DO n = 1, naz
-    DO i = il1, il2
-      i_alpha(i, n) = 0.0
-    END DO
-  END DO
-
-  ! Compute azimuthal wind components from zonal and meridional winds.
-
-  CALL hines_wind(v_alpha, vel_u, vel_v, naz, il1, il2, lev1, lev2, nlons, &
-    nlevs, nazmth)
-
-  ! Calculate cutoff vertical wavenumber and velocity variances.
-
-  CALL hines_wavnum(m_alpha, sigma_alpha, sigsqh_alpha, sigma_t, ak_alpha, &
-    v_alpha, visc_mol, density, densb, bvfreq, bvfb, rmswind, i_alpha, &
-    mmin_alpha, kstar, slope, f1, f2, f3, naz, levbot, levtop, il1, il2, &
-    nlons, nlevs, nazmth, sigsqmcw, sigmatm, lorms, sigalpmc, f2mod)
-  ! Smooth cutoff wavenumbers and total rms velocity in the vertical
-  ! direction NSMAX times, using FLUX_U as temporary work array.
-
-  IF (nsmax>0) THEN
-    DO n = 1, naz
-      DO l = lev1, lev2
-        DO i = il1, il2
-          smoothr1(i, l) = m_alpha(i, l, n)
-        END DO
-      END DO
-      CALL vert_smooth(smoothr1, smoothr2, smco, nsmax, il1, il2, lev1, lev2, &
-        nlons, nlevs)
-      DO l = lev1, lev2
-        DO i = il1, il2
-          m_alpha(i, l, n) = smoothr1(i, l)
-        END DO
-      END DO
-    END DO
-    CALL vert_smooth(sigma_t, smoothr2, smco, nsmax, il1, il2, lev1, lev2, &
-      nlons, nlevs)
-  END IF
-
-  ! Calculate zonal and meridional components of the
-  ! momentum flux and drag.
-
-  CALL hines_flux(flux_u, flux_v, drag_u, drag_v, alt, density, densb, &
-    m_alpha, ak_alpha, k_alpha, slope, naz, il1, il2, lev1, lev2, nlons, &
-    nlevs, nazmth, lorms)
-
-  ! Cutoff drag above ALT_CUTOFF, using BVFB as temporary work array.
-
-  IF (icutoff==1) THEN
-    CALL hines_exp(drag_u, bvfb, alt, alt_cutoff, iorder, il1, il2, lev1, &
-      lev2, nlons, nlevs)
-    CALL hines_exp(drag_v, bvfb, alt, alt_cutoff, iorder, il1, il2, lev1, &
-      lev2, nlons, nlevs)
-  END IF
-
-  ! Print out various arrays for diagnostic purposes.
-
-  IF (iprint==1) THEN
-    ilprt1 = 15
-    ilprt2 = 16
-    CALL hines_print(flux_u, flux_v, drag_u, drag_v, alt, sigma_t, &
-      sigma_alpha, v_alpha, m_alpha, 1, 1, 6, ilprt1, ilprt2, lev1, lev2, &
-      naz, nlons, nlevs, nazmth)
-  END IF
-
-  ! If not calculating heating rate and diffusion coefficient then finished.
-
-  IF (iheatcal/=1) RETURN
-
-  ! Calculate vertical derivative of cutoff wavenumber (store
-  ! in array V_ALPHA) using centered differences at interior gridpoints
-  ! and one-sided differences at first and last levels.
-
-  DO n = 1, naz
-    DO l = lev1p, lev2m
-      DO i = il1, il2
-        v_alpha(i, l, n) = (m_alpha(i,l+1,n)-m_alpha(i,l-1,n))/ &
-          (alt(i,l+1)-alt(i,l-1))
-      END DO
-    END DO
-    DO i = il1, il2
-      v_alpha(i, lev1, n) = (m_alpha(i,lev1p,n)-m_alpha(i,lev1,n))/ &
-        (alt(i,lev1p)-alt(i,lev1))
-    END DO
-    DO i = il1, il2
-      v_alpha(i, lev2, n) = (m_alpha(i,lev2,n)-m_alpha(i,lev2m,n))/ &
-        (alt(i,lev2)-alt(i,lev2m))
-    END DO
-  END DO
-
-  ! Heating rate and diffusion coefficient.
-
-  CALL hines_heat(heat, diffco, m_alpha, v_alpha, ak_alpha, k_alpha, bvfreq, &
-    density, densb, sigma_t, visc_mol, kstar, slope, f2, f3, f5, f6, naz, &
-    il1, il2, lev1, lev2, nlons, nlevs, nazmth)
-
-  ! Finished.
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_extro0
-
-SUBROUTINE hines_wavnum(m_alpha, sigma_alpha, sigsqh_alpha, sigma_t, &
-    ak_alpha, v_alpha, visc_mol, density, densb, bvfreq, bvfb, rms_wind, &
-    i_alpha, mmin_alpha, kstar, slope, f1, f2, f3, naz, levbot, levtop, il1, &
-    il2, nlons, nlevs, nazmth, sigsqmcw, sigmatm, lorms, sigalpmc, f2mod)
-  IMPLICIT NONE
-  ! This routine calculates the cutoff vertical wavenumber and velocity
-  ! variances on a longitude by altitude grid for the Hines' Doppler
-  ! spread gravity wave drag parameterization scheme.
-  ! NOTE: (1) only values of four or eight can be used for # azimuths (NAZ).
-  ! (2) only values of 1.0, 1.5 or 2.0 can be used for slope (SLOPE).
-
-  ! Aug. 10/95 - C. McLandress
-
-  ! Output arguements:
-
-  ! * M_ALPHA      = cutoff wavenumber at each azimuth (1/m).
-  ! * SIGMA_ALPHA  = total rms wind in each azimuth (m/s).
-  ! * SIGSQH_ALPHA = portion of wind variance from waves having wave
-  ! *                normals in the alpha azimuth (m/s).
-  ! * SIGMA_T      = total rms horizontal wind (m/s).
-  ! * AK_ALPHA     = spectral amplitude factor at each azimuth
-  ! *                (i.e.,{AjKj}) in m^4/s^2.
-
-  ! Input arguements:
-
-  ! * V_ALPHA  = wind component at each azimuth (m/s).
-  ! * VISC_MOL = molecular viscosity (m^2/s)
-  ! * DENSITY  = background density (kg/m^3).
-  ! * DENSB    = background density at model bottom (kg/m^3).
-  ! * BVFREQ   = background Brunt Vassala frequency (radians/sec).
-  ! * BVFB     = background Brunt Vassala frequency at model bottom.
-  ! * RMS_WIND = root mean square gravity wave wind at lowest level (m/s).
-  ! * KSTAR    = typical gravity wave horizontal wavenumber (1/m).
-  ! * SLOPE    = slope of incident vertical wavenumber spectrum
-  ! *            (SLOPE = 1., 1.5 or 2.).
-  ! * F1,F2,F3 = Hines's fudge factors.
-  ! * NAZ      = actual number of horizontal azimuths used (4 or 8).
-  ! * LEVBOT   = index of lowest vertical level.
-  ! * LEVTOP   = index of highest vertical level
-  ! *            (NOTE: if LEVTOP < LEVBOT then level index
-  ! *             increases from top down).
-  ! * IL1      = first longitudinal index to use (IL1 >= 1).
-  ! * IL2      = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * NLONS    = number of longitudes.
-  ! * NLEVS    = number of vertical levels.
-  ! * NAZMTH   = azimuthal array dimension (NAZMTH >= NAZ).
-
-  ! * LORMS       = .TRUE. for drag computation
-
-  ! Input work arrays:
-
-  ! * I_ALPHA    = Hines' integral at a single level.
-  ! * MMIN_ALPHA = minimum value of cutoff wavenumber.
-
-  INTEGER naz, levbot, levtop, il1, il2, nlons, nlevs, nazmth
-  REAL slope, kstar(nlons), f1, f2, f3, f2mfac
-  REAL m_alpha(nlons, nlevs, nazmth)
-  REAL sigma_alpha(nlons, nlevs, nazmth)
-  REAL sigalpmc(nlons, nlevs, nazmth)
-  REAL sigsqh_alpha(nlons, nlevs, nazmth)
-  REAL sigsqmcw(nlons, nlevs, nazmth)
-  REAL sigma_t(nlons, nlevs)
-  REAL sigmatm(nlons, nlevs)
-  REAL ak_alpha(nlons, nazmth)
-  REAL v_alpha(nlons, nlevs, nazmth)
-  REAL visc_mol(nlons, nlevs)
-  REAL f2mod(nlons, nlevs)
-  REAL density(nlons, nlevs), densb(nlons)
-  REAL bvfreq(nlons, nlevs), bvfb(nlons), rms_wind(nlons)
-  REAL i_alpha(nlons, nazmth), mmin_alpha(nlons, nazmth)
-
-  LOGICAL lorms(nlons)
-
-  ! Internal variables.
-
-  INTEGER i, l, n, lstart, lend, lincr, lbelow
-  REAL m_sub_m_turb, m_sub_m_mol, m_trial
-  REAL visc, visc_min, azfac, sp1
-
-  ! c      REAL  N_OVER_M(1000), SIGFAC(1000)
-
-  REAL n_over_m(nlons), sigfac(nlons)
-  DATA visc_min/1.E-10/
-  ! -----------------------------------------------------------------------
-
-
-  ! PRINT *,'IN HINES_WAVNUM'
-  sp1 = slope + 1.
-
-  ! Indices of levels to process.
-
-  IF (levbot>levtop) THEN
-    lstart = levbot - 1
-    lend = levtop
-    lincr = -1
-  ELSE
-    WRITE (6, 1)
-1   FORMAT (2X, ' error: IORDER NOT ONE! ')
-  END IF
-
-  ! Use horizontal isotropy to calculate azimuthal variances at bottom level.
-
-  azfac = 1./real(naz)
-  DO n = 1, naz
-    DO i = il1, il2
-      sigsqh_alpha(i, levbot, n) = azfac*rms_wind(i)**2
-    END DO
-  END DO
-
-  ! Velocity variances at bottom level.
-
-  CALL hines_sigma(sigma_t, sigma_alpha, sigsqh_alpha, naz, levbot, il1, il2, &
-    nlons, nlevs, nazmth)
-
-  CALL hines_sigma(sigmatm, sigalpmc, sigsqmcw, naz, levbot, il1, il2, nlons, &
-    nlevs, nazmth)
-
-  ! Calculate cutoff wavenumber and spectral amplitude factor
-  ! at bottom level where it is assumed that background winds vanish
-  ! and also initialize minimum value of cutoff wavnumber.
-
-  DO n = 1, naz
-    DO i = il1, il2
-      IF (lorms(i)) THEN
-        m_alpha(i, levbot, n) = bvfb(i)/(f1*sigma_alpha(i,levbot,n)+f2* &
-          sigma_t(i,levbot))
-        ak_alpha(i, n) = sigsqh_alpha(i, levbot, n)/ &
-          (m_alpha(i,levbot,n)**sp1/sp1)
-        mmin_alpha(i, n) = m_alpha(i, levbot, n)
-      END IF
-    END DO
-  END DO
-
-  ! Calculate quantities from the bottom upwards,
-  ! starting one level above bottom.
-
-  DO l = lstart, lend, lincr
-
-    ! Level beneath present level.
-
-    lbelow = l - lincr
-
-    ! Calculate N/m_M where m_M is maximum permissible value of the vertical
-    ! wavenumber (i.e., m > m_M are obliterated) and N is buoyancy frequency.
-    ! m_M is taken as the smaller of the instability-induced
-    ! wavenumber (M_SUB_M_TURB) and that imposed by molecular viscosity
-    ! (M_SUB_M_MOL). Since variance at this level is not yet known
-    ! use value at level below.
-
-    DO i = il1, il2
-      IF (lorms(i)) THEN
-
-        f2mfac = sigmatm(i, lbelow)**2
-        f2mod(i, lbelow) = 1. + 2.*f2mfac/(f2mfac+sigma_t(i,lbelow)**2)
-
-        visc = amax1(visc_mol(i,l), visc_min)
-        m_sub_m_turb = bvfreq(i, l)/(f2*f2mod(i,lbelow)*sigma_t(i,lbelow))
-        m_sub_m_mol = (bvfreq(i,l)*kstar(i)/visc)**0.33333333/f3
-        IF (m_sub_m_turb<m_sub_m_mol) THEN
-          n_over_m(i) = f2*f2mod(i, lbelow)*sigma_t(i, lbelow)
-        ELSE
-          n_over_m(i) = bvfreq(i, l)/m_sub_m_mol
-        END IF
-      END IF
-    END DO
-
-    ! Calculate cutoff wavenumber at this level.
-
-    DO n = 1, naz
-      DO i = il1, il2
-        IF (lorms(i)) THEN
-
-          ! Calculate trial value (since variance at this level is not yet
-          ! known
-          ! use value at level below). If trial value is negative or if it
-          ! exceeds
-          ! minimum value (not permitted) then set it to minimum value.
-
-          m_trial = bvfb(i)/(f1*(sigma_alpha(i,lbelow,n)+sigalpmc(i,lbelow, &
-            n))+n_over_m(i)+v_alpha(i,l,n))
-          IF (m_trial<=0. .OR. m_trial>mmin_alpha(i,n)) THEN
-            m_trial = mmin_alpha(i, n)
-          END IF
-          m_alpha(i, l, n) = m_trial
-
-          ! Reset minimum value of cutoff wavenumber if necessary.
-
-          IF (m_alpha(i,l,n)<mmin_alpha(i,n)) THEN
-            mmin_alpha(i, n) = m_alpha(i, l, n)
-          END IF
-
-        END IF
-      END DO
-    END DO
-
-    ! Calculate the Hines integral at this level.
-
-    CALL hines_intgrl(i_alpha, v_alpha, m_alpha, bvfb, slope, naz, l, il1, &
-      il2, nlons, nlevs, nazmth, lorms)
-
-
-    ! Calculate the velocity variances at this level.
-
-    DO i = il1, il2
-      sigfac(i) = densb(i)/density(i, l)*bvfreq(i, l)/bvfb(i)
-    END DO
-    DO n = 1, naz
-      DO i = il1, il2
-        sigsqh_alpha(i, l, n) = sigfac(i)*ak_alpha(i, n)*i_alpha(i, n)
-      END DO
-    END DO
-    CALL hines_sigma(sigma_t, sigma_alpha, sigsqh_alpha, naz, l, il1, il2, &
-      nlons, nlevs, nazmth)
-
-    CALL hines_sigma(sigmatm, sigalpmc, sigsqmcw, naz, l, il1, il2, nlons, &
-      nlevs, nazmth)
-
-    ! End of level loop.
-
-  END DO
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_wavnum
-
-SUBROUTINE hines_wind(v_alpha, vel_u, vel_v, naz, il1, il2, lev1, lev2, &
-    nlons, nlevs, nazmth)
-    IMPLICIT NONE
-  ! This routine calculates the azimuthal horizontal background wind
-  ! components
-  ! on a longitude by altitude grid for the case of 4 or 8 azimuths for
-  ! the Hines' Doppler spread GWD parameterization scheme.
-
-  ! Aug. 7/95 - C. McLandress
-
-  ! Output arguement:
-
-  ! * V_ALPHA   = background wind component at each azimuth (m/s).
-  ! *             (note: first azimuth is in eastward direction
-  ! *              and rotate in counterclockwise direction.)
-
-  ! Input arguements:
-
-  ! * VEL_U     = background zonal wind component (m/s).
-  ! * VEL_V     = background meridional wind component (m/s).
-  ! * NAZ       = actual number of horizontal azimuths used (must be 4 or 8).
-  ! * IL1       = first longitudinal index to use (IL1 >= 1).
-  ! * IL2       = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * LEV1      = first altitude level to use (LEV1 >=1).
-  ! * LEV2      = last altitude level to use (LEV1 < LEV2 <= NLEVS).
-  ! * NLONS     = number of longitudes.
-  ! * NLEVS     = number of vertical levels.
-  ! * NAZMTH    = azimuthal array dimension (NAZMTH >= NAZ).
-
-  ! Constants in DATA statements.
-
-  ! * COS45 = cosine of 45 degrees.
-  ! * UMIN  = minimum allowable value for zonal or meridional
-  ! *         wind component (m/s).
-
-  ! Subroutine arguements.
-
-  INTEGER naz, il1, il2, lev1, lev2
-  INTEGER nlons, nlevs, nazmth
-  REAL v_alpha(nlons, nlevs, nazmth)
-  REAL vel_u(nlons, nlevs), vel_v(nlons, nlevs)
-
-  ! Internal variables.
-
-  INTEGER i, l
-  REAL u, v, cos45, umin
-
-  DATA cos45/0.7071068/
-  DATA umin/0.001/
-  ! -----------------------------------------------------------------------
-
-  ! Case with 4 azimuths.
-
-
-  ! PRINT *,'IN HINES_WIND'
-  IF (naz==4) THEN
-    DO l = lev1, lev2
-      DO i = il1, il2
-        u = vel_u(i, l)
-        v = vel_v(i, l)
-        IF (abs(u)<umin) u = umin
-        IF (abs(v)<umin) v = umin
-        v_alpha(i, l, 1) = u
-        v_alpha(i, l, 2) = v
-        v_alpha(i, l, 3) = -u
-        v_alpha(i, l, 4) = -v
-      END DO
-    END DO
-  END IF
-
-  ! Case with 8 azimuths.
-
-  IF (naz==8) THEN
-    DO l = lev1, lev2
-      DO i = il1, il2
-        u = vel_u(i, l)
-        v = vel_v(i, l)
-        IF (abs(u)<umin) u = umin
-        IF (abs(v)<umin) v = umin
-        v_alpha(i, l, 1) = u
-        v_alpha(i, l, 2) = cos45*(v+u)
-        v_alpha(i, l, 3) = v
-        v_alpha(i, l, 4) = cos45*(v-u)
-        v_alpha(i, l, 5) = -u
-        v_alpha(i, l, 6) = -v_alpha(i, l, 2)
-        v_alpha(i, l, 7) = -v
-        v_alpha(i, l, 8) = -v_alpha(i, l, 4)
-      END DO
-    END DO
-  END IF
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_wind
-
-SUBROUTINE hines_flux(flux_u, flux_v, drag_u, drag_v, alt, density, densb, &
-    m_alpha, ak_alpha, k_alpha, slope, naz, il1, il2, lev1, lev2, nlons, &
-    nlevs, nazmth, lorms)
-    IMPLICIT NONE
-  ! Calculate zonal and meridional components of the vertical flux
-  ! of horizontal momentum and corresponding wave drag (force per unit mass)
-  ! on a longitude by altitude grid for the Hines' Doppler spread
-  ! GWD parameterization scheme.
-  ! NOTE: only 4 or 8 azimuths can be used.
-
-  ! Aug. 6/95 - C. McLandress
-
-  ! Output arguements:
-
-  ! * FLUX_U = zonal component of vertical momentum flux (Pascals)
-  ! * FLUX_V = meridional component of vertical momentum flux (Pascals)
-  ! * DRAG_U = zonal component of drag (m/s^2).
-  ! * DRAG_V = meridional component of drag (m/s^2).
-
-  ! Input arguements:
-
-  ! * ALT       = altitudes (m).
-  ! * DENSITY   = background density (kg/m^3).
-  ! * DENSB     = background density at bottom level (kg/m^3).
-  ! * M_ALPHA   = cutoff vertical wavenumber (1/m).
-  ! * AK_ALPHA  = spectral amplitude factor (i.e., {AjKj} in m^4/s^2).
-  ! * K_ALPHA   = horizontal wavenumber (1/m).
-  ! * SLOPE     = slope of incident vertical wavenumber spectrum.
-  ! * NAZ       = actual number of horizontal azimuths used (must be 4 or 8).
-  ! * IL1       = first longitudinal index to use (IL1 >= 1).
-  ! * IL2       = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * LEV1      = first altitude level to use (LEV1 >=1).
-  ! * LEV2      = last altitude level to use (LEV1 < LEV2 <= NLEVS).
-  ! * NLONS     = number of longitudes.
-  ! * NLEVS     = number of vertical levels.
-  ! * NAZMTH    = azimuthal array dimension (NAZMTH >= NAZ).
-
-  ! * LORMS       = .TRUE. for drag computation
-
-  ! Constant in DATA statement.
-
-  ! * COS45 = cosine of 45 degrees.
-
-  ! Subroutine arguements.
-
-  INTEGER naz, il1, il2, lev1, lev2
-  INTEGER nlons, nlevs, nazmth
-  REAL slope
-  REAL flux_u(nlons, nlevs), flux_v(nlons, nlevs)
-  REAL drag_u(nlons, nlevs), drag_v(nlons, nlevs)
-  REAL alt(nlons, nlevs), density(nlons, nlevs), densb(nlons)
-  REAL m_alpha(nlons, nlevs, nazmth)
-  REAL ak_alpha(nlons, nazmth), k_alpha(nlons, nazmth)
-
-  LOGICAL lorms(nlons)
-
-  ! Internal variables.
-
-  INTEGER i, l, lev1p, lev2m, lev2p
-  REAL cos45, prod2, prod4, prod6, prod8, dendz, dendz2
-  DATA cos45/0.7071068/
-  ! -----------------------------------------------------------------------
-
-  lev1p = lev1 + 1
-  lev2m = lev2 - 1
-  lev2p = lev2 + 1
-
-  ! Sum over azimuths for case where SLOPE = 1.
-
-  IF (slope==1.) THEN
-
-    ! Case with 4 azimuths.
-
-    IF (naz==4) THEN
-      DO l = lev1, lev2
-        DO i = il1, il2
-          flux_u(i, l) = ak_alpha(i, 1)*k_alpha(i, 1)*m_alpha(i, l, 1) - &
-            ak_alpha(i, 3)*k_alpha(i, 3)*m_alpha(i, l, 3)
-          flux_v(i, l) = ak_alpha(i, 2)*k_alpha(i, 2)*m_alpha(i, l, 2) - &
-            ak_alpha(i, 4)*k_alpha(i, 4)*m_alpha(i, l, 4)
-        END DO
-      END DO
-    END IF
-
-    ! Case with 8 azimuths.
-
-    IF (naz==8) THEN
-      DO l = lev1, lev2
-        DO i = il1, il2
-          prod2 = ak_alpha(i, 2)*k_alpha(i, 2)*m_alpha(i, l, 2)
-          prod4 = ak_alpha(i, 4)*k_alpha(i, 4)*m_alpha(i, l, 4)
-          prod6 = ak_alpha(i, 6)*k_alpha(i, 6)*m_alpha(i, l, 6)
-          prod8 = ak_alpha(i, 8)*k_alpha(i, 8)*m_alpha(i, l, 8)
-          flux_u(i, l) = ak_alpha(i, 1)*k_alpha(i, 1)*m_alpha(i, l, 1) - &
-            ak_alpha(i, 5)*k_alpha(i, 5)*m_alpha(i, l, 5) + &
-            cos45*(prod2-prod4-prod6+prod8)
-          flux_v(i, l) = ak_alpha(i, 3)*k_alpha(i, 3)*m_alpha(i, l, 3) - &
-            ak_alpha(i, 7)*k_alpha(i, 7)*m_alpha(i, l, 7) + &
-            cos45*(prod2+prod4-prod6-prod8)
-        END DO
-      END DO
-    END IF
-
-  END IF
-
-  ! Sum over azimuths for case where SLOPE not equal to 1.
-
-  IF (slope/=1.) THEN
-
-    ! Case with 4 azimuths.
-
-    IF (naz==4) THEN
-      DO l = lev1, lev2
-        DO i = il1, il2
-          flux_u(i, l) = ak_alpha(i, 1)*k_alpha(i, 1)* &
-            m_alpha(i, l, 1)**slope - ak_alpha(i, 3)*k_alpha(i, 3)*m_alpha(i, &
-            l, 3)**slope
-          flux_v(i, l) = ak_alpha(i, 2)*k_alpha(i, 2)* &
-            m_alpha(i, l, 2)**slope - ak_alpha(i, 4)*k_alpha(i, 4)*m_alpha(i, &
-            l, 4)**slope
-        END DO
-      END DO
-    END IF
-
-    ! Case with 8 azimuths.
-
-    IF (naz==8) THEN
-      DO l = lev1, lev2
-        DO i = il1, il2
-          prod2 = ak_alpha(i, 2)*k_alpha(i, 2)*m_alpha(i, l, 2)**slope
-          prod4 = ak_alpha(i, 4)*k_alpha(i, 4)*m_alpha(i, l, 4)**slope
-          prod6 = ak_alpha(i, 6)*k_alpha(i, 6)*m_alpha(i, l, 6)**slope
-          prod8 = ak_alpha(i, 8)*k_alpha(i, 8)*m_alpha(i, l, 8)**slope
-          flux_u(i, l) = ak_alpha(i, 1)*k_alpha(i, 1)* &
-            m_alpha(i, l, 1)**slope - ak_alpha(i, 5)*k_alpha(i, 5)*m_alpha(i, &
-            l, 5)**slope + cos45*(prod2-prod4-prod6+prod8)
-          flux_v(i, l) = ak_alpha(i, 3)*k_alpha(i, 3)* &
-            m_alpha(i, l, 3)**slope - ak_alpha(i, 7)*k_alpha(i, 7)*m_alpha(i, &
-            l, 7)**slope + cos45*(prod2+prod4-prod6-prod8)
-        END DO
-      END DO
-    END IF
-
-  END IF
-
-  ! Calculate flux from sum.
-
-  DO l = lev1, lev2
-    DO i = il1, il2
-      flux_u(i, l) = flux_u(i, l)*densb(i)/slope
-      flux_v(i, l) = flux_v(i, l)*densb(i)/slope
-    END DO
-  END DO
-
-  ! Calculate drag at intermediate levels using centered differences
-
-  DO l = lev1p, lev2m
-    DO i = il1, il2
-      IF (lorms(i)) THEN
-        ! cc       DENDZ2 = DENSITY(I,L) * ( ALT(I,L+1) - ALT(I,L-1) )
-        dendz2 = density(i, l)*(alt(i,l-1)-alt(i,l))
-        ! cc       DRAG_U(I,L) = - ( FLUX_U(I,L+1) - FLUX_U(I,L-1) ) / DENDZ2
-        drag_u(i, l) = -(flux_u(i,l-1)-flux_u(i,l))/dendz2
-        ! cc       DRAG_V(I,L) = - ( FLUX_V(I,L+1) - FLUX_V(I,L-1) ) / DENDZ2
-        drag_v(i, l) = -(flux_v(i,l-1)-flux_v(i,l))/dendz2
-
-      END IF
-    END DO
-  END DO
-
-  ! Drag at first and last levels using one-side differences.
-
-  DO i = il1, il2
-    IF (lorms(i)) THEN
-      dendz = density(i, lev1)*(alt(i,lev1)-alt(i,lev1p))
-      drag_u(i, lev1) = flux_u(i, lev1)/dendz
-      drag_v(i, lev1) = flux_v(i, lev1)/dendz
-    END IF
-  END DO
-  DO i = il1, il2
-    IF (lorms(i)) THEN
-      dendz = density(i, lev2)*(alt(i,lev2m)-alt(i,lev2))
-      drag_u(i, lev2) = -(flux_u(i,lev2m)-flux_u(i,lev2))/dendz
-      drag_v(i, lev2) = -(flux_v(i,lev2m)-flux_v(i,lev2))/dendz
-    END IF
-  END DO
-  IF (nlevs>lev2) THEN
-    DO i = il1, il2
-      IF (lorms(i)) THEN
-        dendz = density(i, lev2p)*(alt(i,lev2)-alt(i,lev2p))
-        drag_u(i, lev2p) = -flux_u(i, lev2)/dendz
-        drag_v(i, lev2p) = -flux_v(i, lev2)/dendz
-      END IF
-    END DO
-  END IF
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_flux
-
-SUBROUTINE hines_heat(heat, diffco, m_alpha, dmdz_alpha, ak_alpha, k_alpha, &
-    bvfreq, density, densb, sigma_t, visc_mol, kstar, slope, f2, f3, f5, f6, &
-    naz, il1, il2, lev1, lev2, nlons, nlevs, nazmth)
-  IMPLICIT NONE
-  ! This routine calculates the gravity wave induced heating and
-  ! diffusion coefficient on a longitude by altitude grid for
-  ! the Hines' Doppler spread gravity wave drag parameterization scheme.
-
-  ! Aug. 6/95 - C. McLandress
-
-  ! Output arguements:
-
-  ! * HEAT   = gravity wave heating (K/sec).
-  ! * DIFFCO = diffusion coefficient (m^2/sec)
-
-  ! Input arguements:
-
-  ! * M_ALPHA     = cutoff vertical wavenumber (1/m).
-  ! * DMDZ_ALPHA  = vertical derivative of cutoff wavenumber.
-  ! * AK_ALPHA    = spectral amplitude factor of each azimuth
-  ! (i.e., {AjKj} in m^4/s^2).
-  ! * K_ALPHA     = horizontal wavenumber of each azimuth (1/m).
-  ! * BVFREQ      = background Brunt Vassala frequency (rad/sec).
-  ! * DENSITY     = background density (kg/m^3).
-  ! * DENSB       = background density at bottom level (kg/m^3).
-  ! * SIGMA_T     = total rms horizontal wind (m/s).
-  ! * VISC_MOL    = molecular viscosity (m^2/s).
-  ! * KSTAR       = typical gravity wave horizontal wavenumber (1/m).
-  ! * SLOPE       = slope of incident vertical wavenumber spectrum.
-  ! * F2,F3,F5,F6 = Hines's fudge factors.
-  ! * NAZ         = actual number of horizontal azimuths used.
-  ! * IL1         = first longitudinal index to use (IL1 >= 1).
-  ! * IL2         = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * LEV1        = first altitude level to use (LEV1 >=1).
-  ! * LEV2        = last altitude level to use (LEV1 < LEV2 <= NLEVS).
-  ! * NLONS       = number of longitudes.
-  ! * NLEVS       = number of vertical levels.
-  ! * NAZMTH      = azimuthal array dimension (NAZMTH >= NAZ).
-
-  INTEGER naz, il1, il2, lev1, lev2, nlons, nlevs, nazmth
-  REAL kstar(nlons), slope, f2, f3, f5, f6
-  REAL heat(nlons, nlevs), diffco(nlons, nlevs)
-  REAL m_alpha(nlons, nlevs, nazmth), dmdz_alpha(nlons, nlevs, nazmth)
-  REAL ak_alpha(nlons, nazmth), k_alpha(nlons, nazmth)
-  REAL bvfreq(nlons, nlevs), density(nlons, nlevs), densb(nlons)
-  REAL sigma_t(nlons, nlevs), visc_mol(nlons, nlevs)
-
-  ! Internal variables.
-
-  INTEGER i, l, n
-  REAL m_sub_m_turb, m_sub_m_mol, m_sub_m, heatng
-  REAL visc, visc_min, cpgas, sm1
-
-  ! specific heat at constant pressure
-
-  DATA cpgas/1004./
-
-  ! minimum permissible viscosity
-
-  DATA visc_min/1.E-10/
-  ! -----------------------------------------------------------------------
-
-  ! Initialize heating array.
-
-  DO l = 1, nlevs
-    DO i = 1, nlons
-      heat(i, l) = 0.
-    END DO
-  END DO
-
-  ! Perform sum over azimuths for case where SLOPE = 1.
-
-  IF (slope==1.) THEN
-    DO n = 1, naz
-      DO l = lev1, lev2
-        DO i = il1, il2
-          heat(i, l) = heat(i, l) + ak_alpha(i, n)*k_alpha(i, n)*dmdz_alpha(i &
-            , l, n)
-        END DO
-      END DO
-    END DO
-  END IF
-
-  ! Perform sum over azimuths for case where SLOPE not 1.
-
-  IF (slope/=1.) THEN
-    sm1 = slope - 1.
-    DO n = 1, naz
-      DO l = lev1, lev2
-        DO i = il1, il2
-          heat(i, l) = heat(i, l) + ak_alpha(i, n)*k_alpha(i, n)*m_alpha(i, l &
-            , n)**sm1*dmdz_alpha(i, l, n)
-        END DO
-      END DO
-    END DO
-  END IF
-
-  ! Heating and diffusion.
-
-  DO l = lev1, lev2
-    DO i = il1, il2
-
-      ! Maximum permissible value of cutoff wavenumber is the smaller
-      ! of the instability-induced wavenumber (M_SUB_M_TURB) and
-      ! that imposed by molecular viscosity (M_SUB_M_MOL).
-
-      visc = amax1(visc_mol(i,l), visc_min)
-      m_sub_m_turb = bvfreq(i, l)/(f2*sigma_t(i,l))
-      m_sub_m_mol = (bvfreq(i,l)*kstar(i)/visc)**0.33333333/f3
-      m_sub_m = amin1(m_sub_m_turb, m_sub_m_mol)
-
-      heatng = -heat(i, l)*f5*bvfreq(i, l)/m_sub_m*densb(i)/density(i, l)
-      diffco(i, l) = f6*heatng**0.33333333/m_sub_m**1.33333333
-      heat(i, l) = heatng/cpgas
-
-    END DO
-  END DO
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_heat
-
-SUBROUTINE hines_sigma(sigma_t, sigma_alpha, sigsqh_alpha, naz, lev, il1, &
-    il2, nlons, nlevs, nazmth)
-  IMPLICIT NONE
-  ! This routine calculates the total rms and azimuthal rms horizontal
-  ! velocities at a given level on a longitude by altitude grid for
-  ! the Hines' Doppler spread GWD parameterization scheme.
-  ! NOTE: only four or eight azimuths can be used.
-
-  ! Aug. 7/95 - C. McLandress
-
-  ! Output arguements:
-
-  ! * SIGMA_T      = total rms horizontal wind (m/s).
-  ! * SIGMA_ALPHA  = total rms wind in each azimuth (m/s).
-
-  ! Input arguements:
-
-  ! * SIGSQH_ALPHA = portion of wind variance from waves having wave
-  ! *                normals in the alpha azimuth (m/s).
-  ! * NAZ       = actual number of horizontal azimuths used (must be 4 or 8).
-  ! * LEV       = altitude level to process.
-  ! * IL1       = first longitudinal index to use (IL1 >= 1).
-  ! * IL2       = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * NLONS     = number of longitudes.
-  ! * NLEVS     = number of vertical levels.
-  ! * NAZMTH    = azimuthal array dimension (NAZMTH >= NAZ).
-
-  ! Subroutine arguements.
-
-  INTEGER lev, naz, il1, il2
-  INTEGER nlons, nlevs, nazmth
-  REAL sigma_t(nlons, nlevs)
-  REAL sigma_alpha(nlons, nlevs, nazmth)
-  REAL sigsqh_alpha(nlons, nlevs, nazmth)
-
-  ! Internal variables.
-
-  INTEGER i, n
-  REAL sum_even, sum_odd
-  ! -----------------------------------------------------------------------
-
-  ! Calculate azimuthal rms velocity for the 4 azimuth case.
-
-  IF (naz==4) THEN
-    DO i = il1, il2
-      sigma_alpha(i, lev, 1) = sqrt(sigsqh_alpha(i,lev,1)+sigsqh_alpha(i,lev, &
-        3))
-      sigma_alpha(i, lev, 2) = sqrt(sigsqh_alpha(i,lev,2)+sigsqh_alpha(i,lev, &
-        4))
-      sigma_alpha(i, lev, 3) = sigma_alpha(i, lev, 1)
-      sigma_alpha(i, lev, 4) = sigma_alpha(i, lev, 2)
-    END DO
-  END IF
-
-  ! Calculate azimuthal rms velocity for the 8 azimuth case.
-
-  IF (naz==8) THEN
-    DO i = il1, il2
-      sum_odd = (sigsqh_alpha(i,lev,1)+sigsqh_alpha(i,lev,3)+ &
-        sigsqh_alpha(i,lev,5)+sigsqh_alpha(i,lev,7))/2.
-      sum_even = (sigsqh_alpha(i,lev,2)+sigsqh_alpha(i,lev,4)+ &
-        sigsqh_alpha(i,lev,6)+sigsqh_alpha(i,lev,8))/2.
-      sigma_alpha(i, lev, 1) = sqrt(sigsqh_alpha(i,lev,1)+sigsqh_alpha(i,lev, &
-        5)+sum_even)
-      sigma_alpha(i, lev, 2) = sqrt(sigsqh_alpha(i,lev,2)+sigsqh_alpha(i,lev, &
-        6)+sum_odd)
-      sigma_alpha(i, lev, 3) = sqrt(sigsqh_alpha(i,lev,3)+sigsqh_alpha(i,lev, &
-        7)+sum_even)
-      sigma_alpha(i, lev, 4) = sqrt(sigsqh_alpha(i,lev,4)+sigsqh_alpha(i,lev, &
-        8)+sum_odd)
-      sigma_alpha(i, lev, 5) = sigma_alpha(i, lev, 1)
-      sigma_alpha(i, lev, 6) = sigma_alpha(i, lev, 2)
-      sigma_alpha(i, lev, 7) = sigma_alpha(i, lev, 3)
-      sigma_alpha(i, lev, 8) = sigma_alpha(i, lev, 4)
-    END DO
-  END IF
-
-  ! Calculate total rms velocity.
-
-  DO i = il1, il2
-    sigma_t(i, lev) = 0.
-  END DO
-  DO n = 1, naz
-    DO i = il1, il2
-      sigma_t(i, lev) = sigma_t(i, lev) + sigsqh_alpha(i, lev, n)
-    END DO
-  END DO
-  DO i = il1, il2
-    sigma_t(i, lev) = sqrt(sigma_t(i,lev))
-  END DO
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_sigma
-
-SUBROUTINE hines_intgrl(i_alpha, v_alpha, m_alpha, bvfb, slope, naz, lev, &
-    il1, il2, nlons, nlevs, nazmth, lorms)
-  IMPLICIT NONE
-  ! This routine calculates the vertical wavenumber integral
-  ! for a single vertical level at each azimuth on a longitude grid
-  ! for the Hines' Doppler spread GWD parameterization scheme.
-  ! NOTE: (1) only spectral slopes of 1, 1.5 or 2 are permitted.
-  ! (2) the integral is written in terms of the product QM
-  ! which by construction is always less than 1. Series
-  ! solutions are used for small |QM| and analytical solutions
-  ! for remaining values.
-
-  ! Aug. 8/95 - C. McLandress
-
-  ! Output arguement:
-
-  ! * I_ALPHA = Hines' integral.
-
-  ! Input arguements:
-
-  ! * V_ALPHA = azimuthal wind component (m/s).
-  ! * M_ALPHA = azimuthal cutoff vertical wavenumber (1/m).
-  ! * BVFB    = background Brunt Vassala frequency at model bottom.
-  ! * SLOPE   = slope of initial vertical wavenumber spectrum
-  ! *           (must use SLOPE = 1., 1.5 or 2.)
-  ! * NAZ     = actual number of horizontal azimuths used.
-  ! * LEV     = altitude level to process.
-  ! * IL1     = first longitudinal index to use (IL1 >= 1).
-  ! * IL2     = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * NLONS   = number of longitudes.
-  ! * NLEVS   = number of vertical levels.
-  ! * NAZMTH  = azimuthal array dimension (NAZMTH >= NAZ).
-
-  ! * LORMS       = .TRUE. for drag computation
-
-  ! Constants in DATA statements:
-
-  ! * QMIN = minimum value of Q_ALPHA (avoids indeterminant form of integral)
-  ! * QM_MIN = minimum value of Q_ALPHA * M_ALPHA (used to avoid numerical
-  ! *          problems).
-
-  INTEGER lev, naz, il1, il2, nlons, nlevs, nazmth
-  REAL i_alpha(nlons, nazmth)
-  REAL v_alpha(nlons, nlevs, nazmth)
-  REAL m_alpha(nlons, nlevs, nazmth)
-  REAL bvfb(nlons), slope
-
-  LOGICAL lorms(nlons)
-
-  ! Internal variables.
-
-  INTEGER i, n
-  REAL q_alpha, qm, sqrtqm, q_min, qm_min
-
-  DATA q_min/1.0/, qm_min/0.01/
-  ! -----------------------------------------------------------------------
-
-  ! For integer value SLOPE = 1.
-
-  IF (slope==1.) THEN
-
-    DO n = 1, naz
-      DO i = il1, il2
-        IF (lorms(i)) THEN
-
-          q_alpha = v_alpha(i, lev, n)/bvfb(i)
-          qm = q_alpha*m_alpha(i, lev, n)
-
-          ! If |QM| is small then use first 4 terms series of Taylor series
-          ! expansion of integral in order to avoid indeterminate form of
-          ! integral,
-          ! otherwise use analytical form of integral.
-
-          IF (abs(q_alpha)<q_min .OR. abs(qm)<qm_min) THEN
-            IF (q_alpha==0.) THEN
-              i_alpha(i, n) = m_alpha(i, lev, n)**2/2.
-            ELSE
-              i_alpha(i, n) = (qm**2/2.+qm**3/3.+qm**4/4.+qm**5/5.)/ &
-                q_alpha**2
-            END IF
-          ELSE
-            i_alpha(i, n) = -(alog(1.-qm)+qm)/q_alpha**2
-          END IF
-
-        END IF
-      END DO
-    END DO
-
-  END IF
-
-  ! For integer value SLOPE = 2.
-
-  IF (slope==2.) THEN
-
-    DO n = 1, naz
-      DO i = il1, il2
-        IF (lorms(i)) THEN
-
-          q_alpha = v_alpha(i, lev, n)/bvfb(i)
-          qm = q_alpha*m_alpha(i, lev, n)
-
-          ! If |QM| is small then use first 4 terms series of Taylor series
-          ! expansion of integral in order to avoid indeterminate form of
-          ! integral,
-          ! otherwise use analytical form of integral.
-
-          IF (abs(q_alpha)<q_min .OR. abs(qm)<qm_min) THEN
-            IF (q_alpha==0.) THEN
-              i_alpha(i, n) = m_alpha(i, lev, n)**3/3.
-            ELSE
-              i_alpha(i, n) = (qm**3/3.+qm**4/4.+qm**5/5.+qm**6/6.)/ &
-                q_alpha**3
-            END IF
-          ELSE
-            i_alpha(i, n) = -(alog(1.-qm)+qm+qm**2/2.)/q_alpha**3
-          END IF
-
-        END IF
-      END DO
-    END DO
-
-  END IF
-
-  ! For real value SLOPE = 1.5
-
-  IF (slope==1.5) THEN
-
-    DO n = 1, naz
-      DO i = il1, il2
-        IF (lorms(i)) THEN
-
-          q_alpha = v_alpha(i, lev, n)/bvfb(i)
-          qm = q_alpha*m_alpha(i, lev, n)
-
-          ! If |QM| is small then use first 4 terms series of Taylor series
-          ! expansion of integral in order to avoid indeterminate form of
-          ! integral,
-          ! otherwise use analytical form of integral.
-
-          IF (abs(q_alpha)<q_min .OR. abs(qm)<qm_min) THEN
-            IF (q_alpha==0.) THEN
-              i_alpha(i, n) = m_alpha(i, lev, n)**2.5/2.5
-            ELSE
-              i_alpha(i, n) = (qm/2.5+qm**2/3.5+qm**3/4.5+qm**4/5.5)* &
-                m_alpha(i, lev, n)**1.5/q_alpha
-            END IF
-          ELSE
-            qm = abs(qm)
-            sqrtqm = sqrt(qm)
-            IF (q_alpha>=0.) THEN
-              i_alpha(i, n) = (alog((1.+sqrtqm)/(1.-sqrtqm))-2.*sqrtqm*(1.+qm &
-                /3.))/q_alpha**2.5
-            ELSE
-              i_alpha(i, n) = 2.*(atan(sqrtqm)+sqrtqm*(qm/3.-1.))/ &
-                abs(q_alpha)**2.5
-            END IF
-          END IF
-
-        END IF
-      END DO
-    END DO
-
-  END IF
-
-  ! If integral is negative (which in principal should not happen) then
-  ! print a message and some info since execution will abort when calculating
-  ! the variances.
-
-  ! DO 80 N = 1,NAZ
-  ! DO 70 I = IL1,IL2
-  ! IF (I_ALPHA(I,N).LT.0.)  THEN
-  ! WRITE (6,*)
-  ! WRITE (6,*) '******************************'
-  ! WRITE (6,*) 'Hines integral I_ALPHA < 0 '
-  ! WRITE (6,*) '  longitude I=',I
-  ! WRITE (6,*) '  azimuth   N=',N
-  ! WRITE (6,*) '  level   LEV=',LEV
-  ! WRITE (6,*) '  I_ALPHA =',I_ALPHA(I,N)
-  ! WRITE (6,*) '  V_ALPHA =',V_ALPHA(I,LEV,N)
-  ! WRITE (6,*) '  M_ALPHA =',M_ALPHA(I,LEV,N)
-  ! WRITE (6,*) '  Q_ALPHA =',V_ALPHA(I,LEV,N) / BVFB(I)
-  ! WRITE (6,*) '  QM      =',V_ALPHA(I,LEV,N) / BVFB(I)
-  ! ^                                * M_ALPHA(I,LEV,N)
-  ! WRITE (6,*) '******************************'
-  ! END IF
-  ! 70     CONTINUE
-  ! 80   CONTINUE
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_intgrl
-
-SUBROUTINE hines_setup(naz, slope, f1, f2, f3, f5, f6, kstar, icutoff, &
-    alt_cutoff, smco, nsmax, iheatcal, k_alpha, ierror, nmessg, nlons, &
-    nazmth, coslat)
-  IMPLICIT NONE
-  ! This routine specifies various parameters needed for the
-  ! the Hines' Doppler spread gravity wave drag parameterization scheme.
-
-  ! Aug. 8/95 - C. McLandress
-
-  ! Output arguements:
-
-  ! * NAZ        = actual number of horizontal azimuths used
-  ! *              (code set up presently for only NAZ = 4 or 8).
-  ! * SLOPE      = slope of incident vertical wavenumber spectrum
-  ! *              (code set up presently for SLOPE 1., 1.5 or 2.).
-  ! * F1         = "fudge factor" used in calculation of trial value of
-  ! *              azimuthal cutoff wavenumber M_ALPHA (1.2 <= F1 <= 1.9).
-  ! * F2         = "fudge factor" used in calculation of maximum
-  ! *              permissible instabiliy-induced cutoff wavenumber
-  ! *              M_SUB_M_TURB (0.1 <= F2 <= 1.4).
-  ! * F3         = "fudge factor" used in calculation of maximum
-  ! *              permissible molecular viscosity-induced cutoff wavenumber
-  ! *              M_SUB_M_MOL (0.1 <= F2 <= 1.4).
-  ! * F5         = "fudge factor" used in calculation of heating rate
-  ! *              (1 <= F5 <= 3).
-  ! * F6         = "fudge factor" used in calculation of turbulent
-  ! *              diffusivity coefficient.
-  ! * KSTAR      = typical gravity wave horizontal wavenumber (1/m)
-  ! *              used in calculation of M_SUB_M_TURB.
-  ! * ICUTOFF    = 1 to exponentially damp off GWD, heating and diffusion
-  ! *              arrays above ALT_CUTOFF; otherwise arrays not modified.
-  ! * ALT_CUTOFF = altitude in meters above which exponential decay applied.
-  ! * SMCO       = smoother used to smooth cutoff vertical wavenumbers
-  ! *              and total rms winds before calculating drag or heating.
-  ! *              (==> a 1:SMCO:1 stencil used; SMCO >= 1.).
-  ! * NSMAX      = number of times smoother applied ( >= 1),
-  ! *            = 0 means no smoothing performed.
-  ! * IHEATCAL   = 1 to calculate heating rates and diffusion coefficient.
-  ! *            = 0 means only drag and flux calculated.
-  ! * K_ALPHA    = horizontal wavenumber of each azimuth (1/m) which
-  ! *              is set here to KSTAR.
-  ! * IERROR     = error flag.
-  ! *            = 0 no errors.
-  ! *            = 10 ==> NAZ > NAZMTH
-  ! *            = 20 ==> invalid number of azimuths (NAZ must be 4 or 8).
-  ! *            = 30 ==> invalid slope (SLOPE must be 1., 1.5 or 2.).
-  ! *            = 40 ==> invalid smoother (SMCO must be >= 1.)
-
-  ! Input arguements:
-
-  ! * NMESSG  = output unit number where messages to be printed.
-  ! * NLONS   = number of longitudes.
-  ! * NAZMTH  = azimuthal array dimension (NAZMTH >= NAZ).
-
-  INTEGER naz, nlons, nazmth, iheatcal, icutoff
-  INTEGER nmessg, nsmax, ierror
-  REAL kstar(nlons), slope, f1, f2, f3, f5, f6, alt_cutoff, smco
-  REAL k_alpha(nlons, nazmth), coslat(nlons)
-  REAL ksmin, ksmax
-
-  ! Internal variables.
-
-  INTEGER i, n
-  ! -----------------------------------------------------------------------
-
-  ! Specify constants.
-
-  naz = 8
-  slope = 1.
-  f1 = 1.5
-  f2 = 0.3
-  f3 = 1.0
-  f5 = 3.0
-  f6 = 1.0
-  ksmin = 1.E-5
-  ksmax = 1.E-4
-  DO i = 1, nlons
-    kstar(i) = ksmin/(coslat(i)+(ksmin/ksmax))
-  END DO
-  icutoff = 1
-  alt_cutoff = 105.E3
-  smco = 2.0
-  ! SMCO       = 1.0
-  nsmax = 5
-  ! NSMAX      = 2
-  iheatcal = 0
-
-  ! Print information to output file.
-
-  ! WRITE (NMESSG,6000)
-  ! 6000 FORMAT (/' Subroutine HINES_SETUP:')
-  ! WRITE (NMESSG,*)  '  SLOPE = ', SLOPE
-  ! WRITE (NMESSG,*)  '  NAZ = ', NAZ
-  ! WRITE (NMESSG,*)  '  F1,F2,F3  = ', F1, F2, F3
-  ! WRITE (NMESSG,*)  '  F5,F6     = ', F5, F6
-  ! WRITE (NMESSG,*)  '  KSTAR     = ', KSTAR
-  ! >           ,'  COSLAT     = ', COSLAT
-  ! IF (ICUTOFF .EQ. 1)  THEN
-  ! WRITE (NMESSG,*) '  Drag exponentially damped above ',
-  ! &                       ALT_CUTOFF/1.E3
-  ! END IF
-  ! IF (NSMAX.LT.1 )  THEN
-  ! WRITE (NMESSG,*) '  No smoothing of cutoff wavenumbers, etc'
-  ! ELSE
-  ! WRITE (NMESSG,*) '  Cutoff wavenumbers and sig_t smoothed:'
-  ! WRITE (NMESSG,*) '    SMCO  =', SMCO
-  ! WRITE (NMESSG,*) '    NSMAX =', NSMAX
-  ! END IF
-
-  ! Check that things are setup correctly and log error if not
-
-  ierror = 0
-  IF (naz>nazmth) ierror = 10
-  IF (naz/=4 .AND. naz/=8) ierror = 20
-  IF (slope/=1. .AND. slope/=1.5 .AND. slope/=2.) ierror = 30
-  IF (smco<1.) ierror = 40
-
-  ! Use single value for azimuthal-dependent horizontal wavenumber.
-
-  DO n = 1, naz
-    DO i = 1, nlons
-      k_alpha(i, n) = kstar(i)
-    END DO
-  END DO
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_setup
-
-SUBROUTINE hines_print(flux_u, flux_v, drag_u, drag_v, alt, sigma_t, &
-    sigma_alpha, v_alpha, m_alpha, iu_print, iv_print, nmessg, ilprt1, &
-    ilprt2, levprt1, levprt2, naz, nlons, nlevs, nazmth)
-  IMPLICIT NONE
-  ! Print out altitude profiles of various quantities from
-  ! Hines' Doppler spread gravity wave drag parameterization scheme.
-  ! (NOTE: only for NAZ = 4 or 8).
-
-  ! Aug. 8/95 - C. McLandress
-
-  ! Input arguements:
-
-  ! * IU_PRINT = 1 to print out values in east-west direction.
-  ! * IV_PRINT = 1 to print out values in north-south direction.
-  ! * NMESSG   = unit number for printed output.
-  ! * ILPRT1   = first longitudinal index to print.
-  ! * ILPRT2   = last longitudinal index to print.
-  ! * LEVPRT1  = first altitude level to print.
-  ! * LEVPRT2  = last altitude level to print.
-
-  INTEGER naz, ilprt1, ilprt2, levprt1, levprt2
-  INTEGER nlons, nlevs, nazmth
-  INTEGER iu_print, iv_print, nmessg
-  REAL flux_u(nlons, nlevs), flux_v(nlons, nlevs)
-  REAL drag_u(nlons, nlevs), drag_v(nlons, nlevs)
-  REAL alt(nlons, nlevs), sigma_t(nlons, nlevs)
-  REAL sigma_alpha(nlons, nlevs, nazmth)
-  REAL v_alpha(nlons, nlevs, nazmth), m_alpha(nlons, nlevs, nazmth)
-
-  ! Internal variables.
-
-  INTEGER n_east, n_west, n_north, n_south
-  INTEGER i, l
-  ! -----------------------------------------------------------------------
-
-  ! Azimuthal indices of cardinal directions.
-
-  n_east = 1
-  IF (naz==4) THEN
-    n_west = 3
-    n_north = 2
-    n_south = 4
-  ELSE IF (naz==8) THEN
-    n_west = 5
-    n_north = 3
-    n_south = 7
-  END IF
-
-  ! Print out values for range of longitudes.
-
-  DO i = ilprt1, ilprt2
-
-    ! Print east-west wind, sigmas, cutoff wavenumbers, flux and drag.
-
-    IF (iu_print==1) THEN
-      WRITE (nmessg, *)
-      WRITE (nmessg, 6001) i
-      WRITE (nmessg, 6005)
-6001  FORMAT ('Hines GW (east-west) at longitude I =', I3)
-6005  FORMAT (15X, ' U ', 2X, 'sig_E', 2X, 'sig_T', 3X, 'm_E', 4X, 'm_W', 4X, &
-        'fluxU', 5X, 'gwdU')
-      DO l = levprt1, levprt2
-        WRITE (nmessg, 6701) alt(i, l)/1.E3, v_alpha(i, l, n_east), &
-          sigma_alpha(i, l, n_east), sigma_t(i, l), &
-          m_alpha(i, l, n_east)*1.E3, m_alpha(i, l, n_west)*1.E3, &
-          flux_u(i, l)*1.E5, drag_u(i, l)*24.*3600.
-      END DO
-6701  FORMAT (' z=', F7.2, 1X, 3F7.1, 2F7.3, F9.4, F9.3)
-    END IF
-
-    ! Print north-south winds, sigmas, cutoff wavenumbers, flux and drag.
-
-    IF (iv_print==1) THEN
-      WRITE (nmessg, *)
-      WRITE (nmessg, 6002) i
-6002  FORMAT ('Hines GW (north-south) at longitude I =', I3)
-      WRITE (nmessg, 6006)
-6006  FORMAT (15X, ' V ', 2X, 'sig_N', 2X, 'sig_T', 3X, 'm_N', 4X, 'm_S', 4X, &
-        'fluxV', 5X, 'gwdV')
-      DO l = levprt1, levprt2
-        WRITE (nmessg, 6701) alt(i, l)/1.E3, v_alpha(i, l, n_north), &
-          sigma_alpha(i, l, n_north), sigma_t(i, l), &
-          m_alpha(i, l, n_north)*1.E3, m_alpha(i, l, n_south)*1.E3, &
-          flux_v(i, l)*1.E5, drag_v(i, l)*24.*3600.
-      END DO
-    END IF
-
-  END DO
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_print
-
-SUBROUTINE hines_exp(data, data_zmax, alt, alt_exp, iorder, il1, il2, lev1, &
-    lev2, nlons, nlevs)
-  IMPLICIT NONE
-  ! This routine exponentially damps a longitude by altitude array
-  ! of data above a specified altitude.
-
-  ! Aug. 13/95 - C. McLandress
-
-  ! Output arguements:
-
-  ! * DATA = modified data array.
-
-  ! Input arguements:
-
-  ! * DATA    = original data array.
-  ! * ALT     = altitudes.
-  ! * ALT_EXP = altitude above which exponential decay applied.
-  ! * IORDER	= 1 means vertical levels are indexed from top down
-  ! *           (i.e., highest level indexed 1 and lowest level NLEVS);
-  ! *           .NE. 1 highest level is index NLEVS.
-  ! * IL1     = first longitudinal index to use (IL1 >= 1).
-  ! * IL2     = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * LEV1    = first altitude level to use (LEV1 >=1).
-  ! * LEV2    = last altitude level to use (LEV1 < LEV2 <= NLEVS).
-  ! * NLONS   = number of longitudes.
-  ! * NLEVS   = number of vertical
-
-  ! Input work arrays:
-
-  ! * DATA_ZMAX = data values just above altitude ALT_EXP.
-
-  INTEGER iorder, il1, il2, lev1, lev2, nlons, nlevs
-  REAL alt_exp
-  REAL data(nlons, nlevs), data_zmax(nlons), alt(nlons, nlevs)
-
-  ! Internal variables.
-
-  INTEGER levbot, levtop, lincr, i, l
-  REAL hscale
-  DATA hscale/5.E3/
-  ! -----------------------------------------------------------------------
-
-  ! Index of lowest altitude level (bottom of drag calculation).
-
-  levbot = lev2
-  levtop = lev1
-  lincr = 1
-  IF (iorder/=1) THEN
-    levbot = lev1
-    levtop = lev2
-    lincr = -1
-  END IF
-
-  ! Data values at first level above ALT_EXP.
-
-  DO i = il1, il2
-    DO l = levtop, levbot, lincr
-      IF (alt(i,l)>=alt_exp) THEN
-        data_zmax(i) = data(i, l)
-      END IF
-    END DO
-  END DO
-
-  ! Exponentially damp field above ALT_EXP to model top at L=1.
-
-  DO l = 1, lev2
-    DO i = il1, il2
-      IF (alt(i,l)>=alt_exp) THEN
-        data(i, l) = data_zmax(i)*exp((alt_exp-alt(i,l))/hscale)
-      END IF
-    END DO
-  END DO
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE hines_exp
-
-SUBROUTINE vert_smooth(data, work, coeff, nsmooth, il1, il2, lev1, lev2, &
-    nlons, nlevs)
-  IMPLICIT NONE
-  ! Smooth a longitude by altitude array in the vertical over a
-  ! specified number of levels using a three point smoother.
-
-  ! NOTE: input array DATA is modified on output!
-
-  ! Aug. 3/95 - C. McLandress
-
-  ! Output arguement:
-
-  ! * DATA    = smoothed array (on output).
-
-  ! Input arguements:
-
-  ! * DATA    = unsmoothed array of data (on input).
-  ! * WORK    = work array of same dimension as DATA.
-  ! * COEFF   = smoothing coefficient for a 1:COEFF:1 stencil.
-  ! *           (e.g., COEFF = 2 will result in a smoother which
-  ! *           weights the level L gridpoint by two and the two
-  ! *           adjecent levels (L+1 and L-1) by one).
-  ! * NSMOOTH = number of times to smooth in vertical.
-  ! *           (e.g., NSMOOTH=1 means smoothed only once,
-  ! *           NSMOOTH=2 means smoothing repeated twice, etc.)
-  ! * IL1     = first longitudinal index to use (IL1 >= 1).
-  ! * IL2     = last longitudinal index to use (IL1 <= IL2 <= NLONS).
-  ! * LEV1    = first altitude level to use (LEV1 >=1).
-  ! * LEV2    = last altitude level to use (LEV1 < LEV2 <= NLEVS).
-  ! * NLONS   = number of longitudes.
-  ! * NLEVS   = number of vertical levels.
-
-  ! Subroutine arguements.
-
-  INTEGER nsmooth, il1, il2, lev1, lev2, nlons, nlevs
-  REAL coeff
-  REAL data(nlons, nlevs), work(nlons, nlevs)
-
-  ! Internal variables.
-
-  INTEGER i, l, ns, lev1p, lev2m
-  REAL sum_wts
-  ! -----------------------------------------------------------------------
-
-  ! Calculate sum of weights.
-
-  sum_wts = coeff + 2.
-
-  lev1p = lev1 + 1
-  lev2m = lev2 - 1
-
-  ! Smooth NSMOOTH times
-
-  DO ns = 1, nsmooth
-
-    ! Copy data into work array.
-
-    DO l = lev1, lev2
-      DO i = il1, il2
-        work(i, l) = data(i, l)
-      END DO
-    END DO
-
-    ! Smooth array WORK in vertical direction and put into DATA.
-
-    DO l = lev1p, lev2m
-      DO i = il1, il2
-        data(i, l) = (work(i,l+1)+coeff*work(i,l)+work(i,l-1))/sum_wts
-      END DO
-    END DO
-
-  END DO
-
-  RETURN
-  ! -----------------------------------------------------------------------
-END SUBROUTINE vert_smooth
-
-
-
-
-
-
+link ../phylmd/hines_gwd.F90
Index: LMDZ6/trunk/libf/phylmdiso/histo_o500_pctau.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/histo_o500_pctau.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/histo_o500_pctau.F90	(revision 3940)
@@ -1,65 +1,1 @@
-
-! $Header$
-
-SUBROUTINE histo_o500_pctau(nbreg, pct_ocean, w, histo, histow, nhisto)
-  USE dimphy
-  IMPLICIT NONE
-
-  INTEGER :: ij, k, l, nw
-  INTEGER :: nreg, nbreg
-  INTEGER, PARAMETER :: kmax = 8, lmax = 8
-  INTEGER, PARAMETER :: kmaxm1 = kmax - 1, lmaxm1 = lmax - 1
-  INTEGER, PARAMETER :: iwmax = 40
-
-  INTEGER, DIMENSION (klon) :: iw
-  REAL, DIMENSION (klon) :: w
-  REAL, PARAMETER :: wmin = -200., pas_w = 10.
-  REAL, DIMENSION (kmaxm1, lmaxm1, iwmax, nbreg) :: histow, nhisto
-  REAL, DIMENSION (klon, kmaxm1, lmaxm1) :: histo
-
-  ! LOGICAL, dimension(klon,nbreg) :: pct_ocean
-  INTEGER, DIMENSION (klon, nbreg) :: pct_ocean
-
-  ! initialisation
-  histow(:, :, :, :) = 0.
-  nhisto(:, :, :, :) = 0.
-
-  ! calcul de l'histogramme de chaque regime dynamique
-  DO nreg = 1, nbreg
-    DO ij = 1, klon
-      iw(ij) = int((w(ij)-wmin)/pas_w) + 1
-      ! IF(pct_ocean(ij,nreg)) THEN
-      ! IF(pct_ocean(ij,nreg).EQ.1) THEN
-      IF (iw(ij)>=1 .AND. iw(ij)<=iwmax) THEN
-        DO l = 1, lmaxm1
-          DO k = 1, kmaxm1
-            IF (histo(ij,k,l)>0.) THEN
-              histow(k, l, iw(ij), nreg) = histow(k, l, iw(ij), nreg) + &
-                histo(ij, k, l)*pct_ocean(ij, nreg)
-              nhisto(k, l, iw(ij), nreg) = nhisto(k, l, iw(ij), nreg) + &
-                pct_ocean(ij, nreg)
-            END IF
-          END DO !k
-        END DO !l
-        ! ELSE IF (iw(ij).LE.0.OR.iw(ij).GT.iwmax) THEN !iw
-        ! PRINT*,'ij,iw=',ij,iw(ij)
-      END IF !iw
-      ! ENDIF !pct_ocean
-    END DO !ij
-    ! normalisation
-    DO nw = 1, iwmax
-      DO l = 1, lmaxm1
-        DO k = 1, kmaxm1
-          IF (nhisto(k,l,nw,nreg)/=0.) THEN
-            histow(k, l, nw, nreg) = 100.*histow(k, l, nw, nreg)/ &
-              nhisto(k, l, nw, nreg)
-            ! PRINT*,'k,l,nw,nreg,histoW',k,l,nw,nreg,
-            ! &     histoW(k,l,nw,nreg)
-          END IF
-        END DO !k
-      END DO !l
-    END DO !nw
-  END DO !nreg
-
-  RETURN
-END SUBROUTINE histo_o500_pctau
+link ../phylmd/histo_o500_pctau.F90
Index: LMDZ6/trunk/libf/phylmdiso/homogene.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/homogene.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/homogene.F90	(revision 3940)
@@ -1,98 +1,1 @@
-
-! $Header$
-
-SUBROUTINE homogene(paprs, q, dq, u, v, du, dv)
-  USE dimphy
-  IMPLICIT NONE
-  ! ==============================================================
-  ! Schema ad hoc du melange vertical pour les vitesses u et v,
-  ! a appliquer apres le schema de convection (fiajc et fiajh).
-
-  ! paprs:input, pression demi-couche (inter-couche)
-  ! q:    input, vapeur d'eau (kg/kg)
-  ! dq:   input, incrementation de vapeur d'eau (de la convection)
-  ! u:    input, vitesse u
-  ! v:    input, vitesse v
-
-  ! du:   output, incrementation pour u
-  ! dv:   output, incrementation pour v
-  ! ==============================================================
-
-  REAL paprs(klon, klev+1)
-  REAL q(klon, klev), dq(klon, klev)
-  REAL u(klon, klev), du(klon, klev)
-  REAL v(klon, klev), dv(klon, klev)
-
-  REAL zm_dq(klon) ! quantite totale de l'eau deplacee
-  REAL zm_q(klon) ! quantite totale de la vapeur d'eau
-  REAL zm_u(klon) ! moyenne de u (brassage parfait et total)
-  REAL zm_v(klon) ! moyenne de v (brassage parfait et total)
-  REAL z_frac(klon) ! fraction du brassage parfait et total
-  REAL zm_dp(klon)
-
-  REAL zx
-  INTEGER i, k
-  REAL frac_max
-  PARAMETER (frac_max=0.1)
-  REAL seuil
-  PARAMETER (seuil=1.0E-10)
-  LOGICAL faisrien
-  PARAMETER (faisrien=.TRUE.)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      du(i, k) = 0.0
-      dv(i, k) = 0.0
-    END DO
-  END DO
-
-  IF (faisrien) RETURN
-
-  DO i = 1, klon
-    zm_dq(i) = 0.
-    zm_q(i) = 0.
-    zm_u(i) = 0.
-    zm_v(i) = 0.
-    zm_dp(i) = 0.
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (abs(dq(i,k))>seuil) THEN
-        zx = paprs(i, k) - paprs(i, k+1)
-        zm_dq(i) = zm_dq(i) + abs(dq(i,k))*zx
-        zm_q(i) = zm_q(i) + q(i, k)*zx
-        zm_dp(i) = zm_dp(i) + zx
-        zm_u(i) = zm_u(i) + u(i, k)*zx
-        zm_v(i) = zm_v(i) + v(i, k)*zx
-      END IF
-    END DO
-  END DO
-
-  ! Hypothese principale: apres la convection, la vitesse de chaque
-  ! couche est composee de deux parties: celle (1-z_frac) de la vitesse
-  ! original et celle (z_frac) de la vitesse moyenne qui serait la
-  ! vitesse de chaque couche si le brassage etait parfait et total.
-  ! La fraction du brassage est calculee par le rapport entre la quantite
-  ! totale de la vapeur d'eau deplacee (ou condensee) et la quantite
-  ! totale de la vapeur d'eau. Et cette fraction est limitee a frac_max
-  ! (Est-ce vraiment raisonnable ? Z.X. Li, le 07-09-1995).
-
-  DO i = 1, klon
-    IF (zm_dp(i)>=1.0E-15 .AND. zm_q(i)>=1.0E-15) THEN
-      z_frac(i) = min(frac_max, zm_dq(i)/zm_q(i))
-      zm_u(i) = zm_u(i)/zm_dp(i)
-      zm_v(i) = zm_v(i)/zm_dp(i)
-    END IF
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (zm_dp(i)>=1.E-15 .AND. zm_q(i)>=1.E-15 .AND. abs(dq(i, &
-          k))>seuil) THEN
-        du(i, k) = u(i, k)*(1.-z_frac(i)) + zm_u(i)*z_frac(i) - u(i, k)
-        dv(i, k) = v(i, k)*(1.-z_frac(i)) + zm_v(i)*z_frac(i) - v(i, k)
-      END IF
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE homogene
+link ../phylmd/homogene.F90
Index: LMDZ6/trunk/libf/phylmdiso/hydrol.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/hydrol.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/hydrol.F90	(revision 3940)
@@ -1,118 +1,1 @@
-
-! $Header$
-
-
-
-SUBROUTINE hydrol(dtime, pctsrf, rain_fall, snow_fall, evap, agesno, tsol, &
-    qsol, snow, runoff)
-  USE dimphy
-  USE indice_sol_mod
-
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS)
-  ! date: 19940414
-  ! ======================================================================
-
-  ! Traitement de l'hydrologie du sol
-  ! ---------------------------------
-  ! rain_fall: taux de pluie
-  ! snow_fall: taux de neige
-  ! agesno: age de la neige
-  ! evap: taux d'evaporation
-  ! tsol: temperature du sol
-  ! qsol: humidite du sol
-  ! snow: couverture neigeuse
-
-  include "YOMCST.h"
-
-  REAL chasno ! epaisseur du sol: 0.15 m
-  PARAMETER (chasno=3.334E+05/(2.3867E+06*0.15))
-  REAL mx_eau_sol
-  PARAMETER (mx_eau_sol=150.0)
-
-  REAL dtime
-  REAL pctsrf(klon, nbsrf)
-  REAL snow(klon, nbsrf), tsol(klon, nbsrf), qsol(klon, nbsrf)
-  REAL snow_fall(klon), rain_fall(klon), evap(klon)
-  REAL runoff(klon), agesno(klon)
-
-  INTEGER i, is
-  REAL subli, fsno
-  ! -----------------------------------------------------------------------
-  DO i = 1, klon
-
-    runoff(i) = 0.0
-
-    is = is_ter
-    snow(i, is) = snow(i, is) + snow_fall(i)*dtime*pctsrf(i, is)
-    IF (pctsrf(i,is)>epsfra) THEN
-      subli = min(evap(i)*dtime, snow(i,is))
-      snow(i, is) = snow(i, is) - subli
-      fsno = min(max((tsol(i,is)-rtt)/chasno,0.0), snow(i,is))
-      snow(i, is) = snow(i, is) - fsno
-      tsol(i, is) = tsol(i, is) - fsno*chasno
-      qsol(i, is) = qsol(i, is) + (rain_fall(i)-evap(i))*dtime + subli + fsno
-      qsol(i, is) = max(qsol(i,is), 0.0)
-      runoff(i) = runoff(i) + max(qsol(i,is)-mx_eau_sol, 0.0)*pctsrf(i, is)
-      qsol(i, is) = min(qsol(i,is), mx_eau_sol)
-      ! cc         ELSE
-      ! cc            snow(i,is) = 0.0
-      ! cc            qsol(i,is) = 0.0
-      ! cc            tsol(i,is) = 0.0
-    END IF
-
-    is = is_lic
-    snow(i, is) = snow(i, is) + snow_fall(i)*dtime*pctsrf(i, is)
-    IF (pctsrf(i,is)>epsfra) THEN
-      subli = min(evap(i)*dtime, snow(i,is))
-      snow(i, is) = snow(i, is) - subli
-      fsno = min(max((tsol(i,is)-rtt)/chasno,0.0), snow(i,is))
-      snow(i, is) = snow(i, is) - fsno
-      tsol(i, is) = tsol(i, is) - fsno*chasno
-      qsol(i, is) = qsol(i, is) + (rain_fall(i)-evap(i))*dtime + subli + fsno
-      qsol(i, is) = max(qsol(i,is), 0.0)
-      runoff(i) = runoff(i) + max(qsol(i,is)-mx_eau_sol, 0.0)*pctsrf(i, is)
-      qsol(i, is) = min(qsol(i,is), mx_eau_sol)
-      ! je limite la temperature a RTT-1.8 (il faudrait aussi prendre l'eau
-      ! de
-      ! la fonte) (Laurent Li, le 14mars98):
-      ! IM cf GK   tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
-      ! IM cf GK : la glace fond a 0C, non pas a -1.8
-      tsol(i, is) = min(tsol(i,is), rtt)
-
-      ! cc         ELSE
-      ! cc            snow(i,is) = 0.0
-      ! cc            qsol(i,is) = 0.0
-      ! cc            tsol(i,is) = 0.0
-    END IF
-
-    is = is_sic
-    qsol(i, is) = 0.0
-    snow(i, is) = snow(i, is) + snow_fall(i)*dtime*pctsrf(i, is)
-    IF (pctsrf(i,is)>epsfra) THEN
-      subli = min(evap(i)*dtime, snow(i,is))
-      snow(i, is) = snow(i, is) - subli
-      fsno = min(max((tsol(i,is)-rtt)/chasno,0.0), snow(i,is))
-      snow(i, is) = snow(i, is) - fsno
-      tsol(i, is) = tsol(i, is) - fsno*chasno
-      ! je limite la temperature a RTT-1.8 (il faudrait aussi prendre l'eau
-      ! de
-      ! la fonte) (Laurent Li, le 14mars98):
-      ! IM cf GK   tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
-      ! IM cf GK : la glace fond a 0C, non pas a -1.8
-      tsol(i, is) = min(tsol(i,is), rtt)
-
-      ! cc         ELSE
-      ! cc            snow(i,is) = 0.0
-      ! cc            tsol(i,is) = 0.0
-    END IF
-
-    agesno(i) = (agesno(i)+(1.-agesno(i)/50.)*dtime/86400.)* &
-      exp(-1.*max(0.0,snow_fall(i))*dtime/0.3)
-    agesno(i) = max(agesno(i), 0.0)
-
-  END DO
-
-  RETURN
-END SUBROUTINE hydrol
+link ../phylmd/hydrol.F90
Index: LMDZ6/trunk/libf/phylmdiso/icefrac_lsc_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/icefrac_lsc_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/icefrac_lsc_mod.F90	(revision 3940)
@@ -1,59 +1,1 @@
-!
-! $Header$
-!
-MODULE icefrac_lsc_mod
-
-IMPLICIT NONE
-
-CONTAINS
-!*******************************************************************
-
-SUBROUTINE icefrac_lsc(np,temp, sig, icefrac)
-  !
-  ! Compute the ice fraction 1-xliq (see e.g.
-  ! Doutriaux-Boucher & Quaas 2004, section 2.2.)
-  !
-  ! (JBM 3/14 8/14 5/16)
-  
-  USE print_control_mod, ONLY: lunout, prt_level
-  INCLUDE "nuage.h"
-
-  ! nuage.h contains:
-  ! t_glace_min: if T < Tmin, the cloud is only made of water ice
-  ! t_glace_max: if T > Tmax, the cloud is only made of liquid water
-  ! exposant_glace: controls the sharpness of the transition
-  INTEGER :: np
-  REAL, DIMENSION(np), INTENT(IN) :: temp ! temperature
-  REAL, DIMENSION(np), INTENT(IN) :: sig
-  REAL, DIMENSION(np), INTENT(OUT) :: icefrac
-
-  REAL :: sig0,www,tmin_tmp,liqfrac_tmp
-  INTEGER :: ip
-
-  sig0=0.8
-
-  DO ip=1,np
-     IF (iflag_t_glace.EQ.1) THEN
-       ! Transition to ice close to surface for T<Tmax
-       ! w=1 at the surface and 0 for sig < sig0
-       www=(max(sig(ip)-sig0,0.))/(1.-sig0) 
-     ELSEIF (iflag_t_glace.GE.2) THEN
-       ! No convertion to ice close to surface
-       www = 0.
-     ENDIF
-     tmin_tmp=www*t_glace_max+(1.-www)*t_glace_min
-     liqfrac_tmp=  (temp(ip)-tmin_tmp) / (t_glace_max-tmin_tmp)
-     liqfrac_tmp = MIN(MAX(liqfrac_tmp,0.0),1.0)
-     IF (iflag_t_glace.GE.3) THEN
-       icefrac(ip) = 1.0-liqfrac_tmp**exposant_glace
-     ELSE
-       icefrac(ip) = (1.0-liqfrac_tmp)**exposant_glace
-     ENDIF
-  ENDDO
-
-  RETURN
-END SUBROUTINE icefrac_lsc
-
-!*******************************************************************
-!
-END MODULE icefrac_lsc_mod
+link ../phylmd/icefrac_lsc_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/indice_sol_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/indice_sol_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/indice_sol_mod.F90	(revision 3940)
@@ -1,17 +1,1 @@
-      MODULE indice_sol_mod
-
-            IMPLICIT NONE
-
-            INTEGER, PARAMETER :: nbsrf = 4 ! nombre de sous-fractions pour une maille
-            INTEGER, PARAMETER :: is_ter=1, is_lic=2, is_oce = 3, is_sic=4
-                              ! terre ! ocean ! glacier continental ! glace de mer
-
-            INTEGER, PARAMETER :: is_ave=nbsrf+1 ! valeur moyenne sur l'ensemble des surfaces
-            REAL, PARAMETER :: epsfra=1.0E-05
-
-            CHARACTER(len=3), DIMENSION(nbsrf), PARAMETER :: clnsurf = (/'ter', 'lic', 'oce', 'sic'/)
-!FC 
-           INTEGER, SAVE    :: nvm_orch ! Nombre de type de vegetation ds ORCHIDEE                 
-
-      END MODULE indice_sol_mod
-
+link ../phylmd/indice_sol_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/infotrac_phy.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/infotrac_phy.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/infotrac_phy.F90	(revision 3940)
@@ -23,4 +23,8 @@
   INTEGER, SAVE :: nqtottr
 !$OMP THREADPRIVATE(nqtottr)
+
+! ThL : number of CO2 tracers			ModThL
+  INTEGER, SAVE :: nqCO2
+!$OMP THREADPRIVATE(nqCO2)
 
 #ifdef CPP_StratAer
@@ -194,7 +198,7 @@
     ALLOCATE(solsym(nbtr))
     solsym(:)=solsym_(:)
-  
+     
     IF(prt_level.ge.1) THEN
-      write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr",nqtot,nqo,nbtr
+      write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr,nqCO2",nqtot,nqo,nbtr,nqCO2
     ENDIF
     
Index: LMDZ6/trunk/libf/phylmdiso/ini_bilKP_ave.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_bilKP_ave.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_bilKP_ave.h	(revision 3940)
@@ -1,259 +1,1 @@
-c
-c $Id: ini_bilKP_ave.h 3102 2017-12-03 20:27:42Z oboucher $
-c
-      IF (ok_journe) THEN
-c
-         zsto = dtime
-         zout = ecrit_day
-         typeval=tave
-c
-         idayref = day_ref
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-c
-cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-cym         DO i = 1, iim
-cym            zx_lon(i,1) = rlon(i+1)
-cym            zx_lon(i,jjmp1) = rlon(i+1)
-cym         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=REAL(ll)
-         ENDDO
-cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-cym         write(*,*)'zx_lon = ',zx_lon(:,1)
-cym         write(*,*)'zx_lat = ',zx_lat(1,:)
-cym         CALL histbeg("histbilKP_ave", iim,zx_lon(:,1), jjmp1,
-cym     .                zx_lat(1,:),
-cym     .                1,iim,1,jjmp1, itau_phy, zjulian, dtime,
-cym     .                nhori, nid_bilKPave)
-         CALL histbeg_phy("histbilKP_ave", itau_phy, zjulian, dtime,
-     .                nhori, nid_bilKPave)
-
-         write(*,*)'Journee ', itau_phy, zjulian
-         CALL histvert(nid_bilKPave, "presnivs",
-     .                "Vertical levels","mb",
-     .                 klev, presnivs/100., nvert)
-c
-c
-c Champs 3D:
-c
-         CALL histdef(nid_bilKPave,"ue",
-     .   "Zonal energy transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"ve",
-     .   "Merid energy transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"uq",
-     .   "Zonal humidity transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"vq",
-     .   "Merid humidity transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-c Champs 3D:
-c
-         CALL histdef(nid_bilKPave,"temp",
-     .   "Air temperature","K",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"ovap",
-     .   "Specific humidity","Kg/Kg",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"geop",
-     .   "Geopotential height","m",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"vitu",
-     .   "Zonal wind","m/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"vitv",
-     .   "Meridional wind","m/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "vitw", 
-     .   "Vertical wind", "m/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "pres", 
-     .   "Inter-Layer Air pressure",
-     .                "Pa",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "play", 
-     .   "Mean-Layer Air pressure",
-     .                "Pa",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "oliq", 
-     .   "Liquid water content", 
-     .                "kg/kg",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dtdyn", 
-     .   "Dynamics dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dqdyn", 
-     .   "Dynamics dQ", "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dtcon", 
-     .   "Convection dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "ducon", 
-     .   "Convection du", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dvcon", 
-     .   "Convection dv", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"dqcon",
-     .   "Convection dQ","Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dtlsc", 
-     .   "Condensation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"dqlsc",
-     .   "Condensation dQ","Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"dtvdf",
-     .   "Boundary-layer dT","K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dqvdf", 
-     .   "Boundary-layer dQ", 
-     .               "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"dtajs",
-     .   "Ajustement sec dT","K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dqajs",
-     .   "Ajustement sec dQ", 
-     .               "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dteva", 
-     .   "Reevaporation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"dqeva",
-     .   "Reevaporation dQ",
-     .                "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-
-c
-         CALL histdef(nid_bilKPave, "dtswr", 
-     .   "SW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dtsw0", 
-     .   "SW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dtlwr", 
-     .   "LW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dtlw0", 
-     .   "LW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"duvdf",
-     .   "Boundary-layer dU","m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave,"dvvdf",
-     .   "Boundary-layer dV","m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         IF (ok_orodr) THEN
-         IF (ok_orolf) THEN
-         CALL histdef(nid_bilKPave, "duoli",
-     .   "Orography dU", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPave, "dvoli", 
-     .   "Orography dV", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         ENDIF
-         ENDIF
-C
-         CALL histdef(nid_bilKPave, "duphy",
-     .   "Physiq dU","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPave, "dvphy",
-     .   "Physiq dV","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPave, "dtphy",
-     .   "Physiq dT","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPave, "dqphy",
-     .   "Physiq dQ","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPave, "dqlphy",
-     .   "Physiq dQl","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-C
-         CALL histend(nid_bilKPave)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF ! fin de test sur ok_journe
+link ../phylmd/ini_bilKP_ave.h
Index: LMDZ6/trunk/libf/phylmdiso/ini_bilKP_ins.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_bilKP_ins.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_bilKP_ins.h	(revision 3940)
@@ -1,326 +1,1 @@
-c
-c $Id: ini_bilKP_ins.h 3102 2017-12-03 20:27:42Z oboucher $
-c
-      IF (ok_journe) THEN
-c
-         zsto = dtime
-         zout = dtime
-         typeval=tinst
-c
-         idayref = day_ref
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-c
-cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-cym         DO i = 1, iim
-cym            zx_lon(i,1) = rlon(i+1)
-cym            zx_lon(i,jjmp1) = rlon(i+1)
-cym         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=REAL(ll)
-         ENDDO
-cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-cym         write(*,*)'zx_lon = ',zx_lon(:,1)
-cym         write(*,*)'zx_lat = ',zx_lat(1,:)
-c
-cIM 280405 BEG
-c
-cIM cf. AM 081204 BEG region
-          imin_ins=1
-          imax_ins=iim
-          jmin_ins=1
-          jmax_ins=jjmp1
-cym          do i=1,iim-1
-cym             if(zx_lon(i,1).lt.lonmin_ins) imin_ins=i
-cym             if(zx_lon(i,1).le.lonmax_ins) imax_ins=i+1
-cym          enddo
-cym          do j=1,jjmp1
-cym             if(zx_lat(1,j).ge.latmin_ins) jmax_ins=j
-cym             if(zx_lat(1,j).gt.latmax_ins) jmin_ins=j
-cym          enddo
-c
-          print*,'On stoke le fichier bilKP instantanne sur ',
-     s   imin_ins,imax_ins,jmin_ins,jmax_ins
-          print*,'On stoke le fichier bilKP instantanne sur ',
-     s   zx_lon(imin_ins,1),zx_lon(imax_ins,1),
-     s   zx_lat(1,jmin_ins),zx_lat(1,jmax_ins)
-cIM cf. AM 081204 END region
-c
-cIM 280405 END
-c
-cym         IF(1.EQ.0) THEN
-cym         CALL histbeg("histbilKP_ins", iim,zx_lon(:,1), jjmp1,
-cym     .                zx_lat(1,:),
-cym     .                1,iim,1,jjmp1, itau_phy, zjulian, dtime,
-cym     .                nhori, nid_bilKPins)
-         ENDIF
-c
-cIM 280405 BEG
-c
-cIM cf. AM 081204 BEG region
-cym         CALL histbeg("histbilKP_ins", iim,zx_lon(:,1), 
-cym     .                 jjmp1,zx_lat(1,:),
-cym     .                 imin_ins,imax_ins-imin_ins+1,
-cym     .                 jmin_ins,jmax_ins-jmin_ins+1,
-cym     .                 itau_phy, zjulian, dtime,
-cym     .                 nhori, nid_bilKPins)
-         CALL histbeg_phy("histbilKP_ins", itau_phy, zjulian, dtime,
-     .                 nhori, nid_bilKPins)
-cIM 081204 END
-c
-cIM 280405 END
-c
-         write(*,*)'Journee ', itau_phy, zjulian
-         CALL histvert(nid_bilKPins, "presnivs",
-     .                "Vertical levels","mb",
-     .                 klev, presnivs/100., nvert)
-c
-c Champs 3D:
-c
-         CALL histdef(nid_bilKPins,"ue",
-     .   "Zonal energy transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"ve",
-     .   "Merid energy transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"uq",
-     .   "Zonal humidity transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"vq",
-     .   "Merid humidity transport","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32, 
-     .                typeval, zsto,zout)
-c
-c Champs 3D:
-c
-         CALL histdef(nid_bilKPins, "temp",
-     .   "Air temperature", "K",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"ovap",
-     .   "Specific humidity","Kg/Kg",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"geop",
-     .   "Geopotential height", "m",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"vitu", 
-     .   "Zonal wind", "m/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"vitv", 
-     .   "Meridional wind", "m/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "vitw",
-     .   "Vertical wind", "m/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "pres",
-     .   "Inter-Layer Air pressure",
-     .                "Pa",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "play",
-     .   "Mean-Layer Air pressure",
-     .                "Pa",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "oliq",
-     .   "Liquid water content", 
-     .                "kg/kg",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dtdyn",
-     .   "Dynamics dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dqdyn",
-     .   "Dynamics dQ", "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dtcon",
-     .   "Convection dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "ducon",
-     .   "Convection du", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dvcon",
-     .   "Convection dv", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dqcon",
-     .   "Convection dQ","Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dtlsc",
-     .   "Condensation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dqlsc",
-     .   "Condensation dQ","Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dtvdf",
-     .   "Boundary-layer dT","K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dqvdf", 
-     .   "Boundary-layer dQ", 
-     .               "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dtajs",
-     .   "Ajustement sec dT","K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dqajs",
-     .   "Ajustement sec dQ", 
-     .               "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dteva",
-     .   "Reevaporation dT","K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dqeva",
-     .   "Reevaporation dQ",
-     .                "Kg/Kg/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-
-c
-         CALL histdef(nid_bilKPins, "dtswr", 
-     .   "SW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dtsw0", 
-     .   "SW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dtlwr", 
-     .   "LW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dtlw0", 
-     .   "LW radiation dT", "K/s",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"duvdf",
-     .   "Boundary-layer dU","m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins,"dvvdf",
-     .   "Boundary-layer dV","m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         IF (ok_orodr) THEN
-         IF (ok_orolf) THEN
-         CALL histdef(nid_bilKPins, "duoli", 
-     .   "Orography dU", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         CALL histdef(nid_bilKPins, "dvoli", 
-     .   "Orography dV", "m/s2",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-c
-         ENDIF
-         ENDIF
-C
-         CALL histdef(nid_bilKPins, "duphy",
-     .   "Physiq dU","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPins, "dvphy",
-     .   "Physiq dV","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPins, "dtphy",
-     .   "Physiq dT","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPins, "dqphy",
-     .   "Physiq dQ","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-C
-         CALL histdef(nid_bilKPins, "dqlphy",
-     .   "Physiq dQl","-",
-     .                iim,jjphy_nb,nhori, klev,1,klev,nvert, 32,
-     .                typeval, zsto,zout)
-cIM 280405 BEG
-c
-c Champs 2D:
-c
-c u850, v850
-c        DO k=1, nlevSTD
-         DO k=1, 12
-c
-         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
-         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
-c
-         IF(bb2.EQ."850") THEN 
-c
-          CALL histdef(nid_bilKPins, "u"//bb2,
-     .                 "Zonal wind "//bb2//"mb","m/s",
-     .                iim,jjphy_nb,nhori, 1,1,1, -99, 32,
-     .                typeval, zsto,zout)
-c
-          CALL histdef(nid_bilKPins, "v"//bb2,
-     .                 "Meridional wind "//bb2//"mb","m/s",
-     .                iim,jjphy_nb,nhori, 1,1,1, -99, 32,
-     .                typeval, zsto,zout)
-c
-         ENDIF !(bb2.EQ."850") 
-c
-         ENDDO !k=1, 12
-c
-cIM 280405 END
-c
-         CALL histend(nid_bilKPins)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF ! fin de test sur ok_journe
+link ../phylmd/ini_bilKP_ins.h
Index: LMDZ6/trunk/libf/phylmdiso/ini_coord_REGDYN.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_coord_REGDYN.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_coord_REGDYN.h	(revision 3940)
@@ -1,81 +1,1 @@
-c
-c $Header$
-c
-       nsrf=3
-       DO nreg=1, nbregdyn
-       DO i=1, klon
-
-c       IF (debut) THEN
-         IF(rlon(i).LT.0.) THEN
-           rlonPOS(i)=rlon(i)+360.
-         ELSE
-           rlonPOS(i)=rlon(i)  
-         ENDIF
-c       ENDIF
-
-        pct_ocean(i,nreg)=0
-
-c test si c'est 1 point d'ocean
-        IF(pctsrf(i,nsrf).EQ.1.) THEN
-
-         IF(nreg.EQ.1) THEN
-
-c TROP
-          IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
-           pct_ocean(i,nreg)=1
-          ENDIF
-
-c PACIFIQUE NORD
-          ELSEIF(nreg.EQ.2) THEN
-           IF(rlat(i).GE.40.AND.rlat(i).LE.60.) THEN
-            IF(rlonPOS(i).GE.160..AND.rlonPOS(i).LE.235.) THEN 
-             pct_ocean(i,nreg)=1
-            ENDIF
-           ENDIF
-c CALIFORNIE ST-CU
-         ELSEIF(nreg.EQ.3) THEN
-          IF(rlonPOS(i).GE.220..AND.rlonPOS(i).LE.250.) THEN
-           IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
-            pct_ocean(i,nreg)=1
-           ENDIF
-          ENDIF
-c HAWAI
-        ELSEIF(nreg.EQ.4) THEN 
-         IF(rlonPOS(i).GE.180..AND.rlonPOS(i).LE.220.) THEN
-          IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
-           pct_ocean(i,nreg)=1
-          ENDIF
-         ENDIF
-c WARM POOL
-        ELSEIF(nreg.EQ.5) THEN 
-         IF(rlonPOS(i).GE.70..AND.rlonPOS(i).LE.150.) THEN
-          IF(rlat(i).GE.-5.AND.rlat(i).LE.20.) THEN
-           pct_ocean(i,nreg)=1
-          ENDIF
-         ENDIF
-        ENDIF !nbregdyn
-c TROP
-c        IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
-c         pct_ocean(i)=.TRUE.
-c         WRITE(*,*) 'pct_ocean =',i, rlon(i), rlat(i)
-c          ENDIF !lon
-c         ENDIF !lat
-
-        ENDIF !pctsrf
-       ENDDO !klon
-       ENDDO !nbregdyn
-cIM 190504      ENDIF !ok_regdyn
- 
-cIM somme de toutes les nhistoW BEG
-      IF (debut) THEN
-      DO nreg = 1, nbregdyn
-       DO k = 1, kmaxm1
-        DO l = 1, lmaxm1
-         DO iw = 1, iwmax
-          nhistoWt(k,l,iw,nreg)=0.
-         ENDDO !iw
-        ENDDO !l
-       ENDDO !k
-      ENDDO !nreg
-      ENDIF !(debut) THEN
-cIM 190504 BEG
+link ../phylmd/ini_coord_REGDYN.h
Index: LMDZ6/trunk/libf/phylmdiso/ini_histREGDYN.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_histREGDYN.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_histREGDYN.h	(revision 3940)
@@ -1,127 +1,1 @@
-!
-! $Header$
-!
-
-      IF (ok_regdyn) THEN
-      
-        if (is_sequential) then
-c
-cIM      PRINT*, 'La frequence de sortie REGDYN est de ', ecrit_mth
-c
-         idayref = day_ref
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-c
-c axe vertical pour les differents niveaux des histogrammes
-      DO iw=1, iwmax
-        zx_o500(iw)=wmin+(iw-1./2.)*pas_w
-      ENDDO
-
-         CALL histbeg("histREGDYN", kmaxm1,zx_tau, lmaxm1,zx_pc,
-     .                 1,kmaxm1,1,lmaxm1, itau_phy, zjulian, dtime, 
-     .                 nhoriRD, nid_regdyn)
-
-         CALL histvert(nid_regdyn, "omeganivs", "Omega levels", 
-     .                 "mb/day",
-     .                 iwmax, zx_o500, komega)
-c
-c   pour les champs instantannes, il faut mettre la meme valeur pour
-c   zout et zsto.
-c   dtime est passe par ailleurs a histbeg
-c
-c        zout = dtime * REAL(NINT(86400./dtime*ecrit_regdyn))
-c        zsto = zout
-c        print*,'zout,zsto=',zout,zsto
-c
-c stockage a chaque pas de temps de la physique
-c
-         zstophy = dtime
-cIM 020904      zstophy = dtime * nbapp_isccp
-
-c ecriture mensuelle
-c
-         zout = dtime * ecrit_mth
-cIM 020904      
-c        zout = dtime * ecrit_day
-c        zout = dtime * REAL(NINT(86400./dtime*ecrit_regdyn))
-
-c
-c Champs 3D:
-c
-c TROP
-         CALL histdef(nid_regdyn, "hw1", "Tropics Histogram ", "%",
-     &                kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, 
-     &                "ave(X)", zstophy,zout)
-
-         CALL histdef(nid_regdyn, "nh1", "Nb of pixels Tropics Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c
-
-         CALL histdef(nid_regdyn, "nht1",
-     &                "Total Nb pixels Tropics Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c
-c PAN
-         CALL histdef(nid_regdyn, "hw2", "North Pacific Histogram", "%",
-     &                kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, 
-     &                "ave(X)", zstophy,zout)
-
-         CALL histdef(nid_regdyn, "nh2", "Nb of pixels North Pacific",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c
-
-         CALL histdef(nid_regdyn, "nht2",
-     &                "Total Nb pixels North Pacific Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c CAL
-         CALL histdef(nid_regdyn, "hw3", "California Histogram", "%",
-     &                kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, 
-     &                "ave(X)", zstophy,zout)
-
-         CALL histdef(nid_regdyn, "nh3", 
-     &                "Nb of pixels California Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c
-
-         CALL histdef(nid_regdyn, "nht3",
-     &                "Total Nb pixels California Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c HAW
-         CALL histdef(nid_regdyn, "hw4", "Hawai Histogram", "%",
-     &                kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, 
-     &                "ave(X)", zstophy,zout)
-
-         CALL histdef(nid_regdyn, "nh4", "Nb of pixels Hawai Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c
-
-         CALL histdef(nid_regdyn, "nht4",
-     &                "Total Nb pixels Hawai Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c WAP
-         CALL histdef(nid_regdyn, "hw5", "Warm Pool Histogram", "%",
-     &                kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, 
-     &                "ave(X)", zstophy,zout)
-
-         CALL histdef(nid_regdyn, "nh5", "Nb of pixels Warm Pool Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c
-
-         CALL histdef(nid_regdyn, "nht5",
-     &                "Total Nb pixels Warm Pool Histo",
-     &                "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega,
-     &                32,"ave(X)", zstophy,zout)
-c
-         CALL histend(nid_regdyn)
-	 
-	 endif ! is_sequential
-
-      endif ! ok_regdyn
+link ../phylmd/ini_histREGDYN.h
Index: LMDZ6/trunk/libf/phylmdiso/ini_histday_seri.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_histday_seri.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_histday_seri.h	(revision 3940)
@@ -1,131 +1,1 @@
-!
-! $Id: ini_histday_seri.h 2399 2015-11-20 16:23:28Z emillour $
-!
-!ym Ne fonctionnera pas en mode parallele
-      IF (is_sequential) THEN
-      
-      IF (type_run.EQ."AMIP") THEN
-!
-       zstophy = pdtphys
-       zout = ecrit_day
-!
-         idayref = day_ref
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-!
-         CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,longitude_deg,zx_lon)
-         DO i = 1, nbp_lon
-            zx_lon(i,1) = longitude_deg(i+1)
-            zx_lon(i,nbp_lat) = longitude_deg(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=REAL(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,latitude_deg,zx_lat)
-!
-         imin_debut=1 
-         nbpti=1
-         jmin_debut=1 
-         nbptj=1
-!
-         CALL histbeg("histday_seri.nc",  &
-                       nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:), &
-                       imin_debut,nbpti,jmin_debut,nbptj, &
-                       itau_phy, zjulian, dtime, &
-                       nhori, nid_day_seri)
-!
-         CALL histvert(nid_day_seri, "presnivs",  &
-                      "Vertical levels","mb", &
-                       klev, presnivs/100., nvert)
-!
-         CALL histdef(nid_day_seri, "bilTOA",  &
-                      "Net radiation at model top", "W/m2", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32,  &
-                      "ave(X)", zstophy,zout)
-!
-         CALL histdef(nid_day_seri, "bils",  &
-                      "Net downward energy flux at surface","W/m2", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32,  &
-                      "ave(X)", zstophy,zout)
-!
-         CALL histdef(nid_day_seri, "ecin",  &
-                      "Total kinetic energy (per unit area)","J/m2", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-!IM 151004 BEG
-         IF(1.EQ.0) THEN
-!
-         CALL histdef(nid_day_seri, "momang",  &
-                     "Total relative angular momentum (per unit area)", &
-                     "kg/s", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-         CALL histdef(nid_day_seri, "frictor",  &
-                     "Friction torque (per unit area)", "N/m", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-         CALL histdef(nid_day_seri, "mountor",  &
-                     "Mountain torque (per unit area)", "N/m", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-         ENDIF !(1.EQ.0) THEN
-!
-         CALL histdef(nid_day_seri, "momang",  &
-                     "Axial angular momentum (per unit area)", &
-                     "kg/s", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-         CALL histdef(nid_day_seri, "torsfc",  &
-              "Total surface torque (including mountain torque)", "N/m", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-!IM 151004 END        
-!
-         CALL histdef(nid_day_seri, "tamv",  &
-                      "Temperature (mass-weighted vert. ave)", "K", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-         CALL histdef(nid_day_seri, "psol",  &
-                      "Surface pressure", "Pa", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32,  &
-                      "ave(X)", zstophy,zout)
-!
-         CALL histdef(nid_day_seri, "evap",  &
-                      "Evaporation and sublimation (per unit area)",  &
-                      "kg/(m2*s)", &
-                      nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32,  &
-                      "ave(X)", zstophy,zout)
-!
-!          call histdef(nid_day_seri, 
-!    .         "SnowFrac", 
-!    .         "Snow-covered area ", "%",  
-!    .         nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32,
-!    .         "ave(X)", zstophy,zout)
-!
-!        CALL histdef(nid_day_seri, "snow_depth", 
-!IM 080904  .                "Snow Depth (water equivalent)", "m",
-!IM 191104  .                "Snow Depth (water equivalent)", "kg/m2",
-!    .                "Snow Mass", "kg/m2",
-!    .                nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, 
-!    .               "ave(X)", zstophy,zout)
-!
-           call histdef(nid_day_seri,  &
-               "tsol_"//clnsurf(is_oce),  &
-               "SST over open (ice-free) ocean ", "K",   &
-               nbp_lon,nbp_lat,nhori, 1,1,1, -99, 32, &
-               "ave(X)", zstophy,zout)
-!
-!=================================================================
-!
-         CALL histend(nid_day_seri)
-!
-!=================================================================
-      ENDIF ! fin de test sur type_run.EQ.AMIP
-      
-      ENDIF ! is_sequential
+link ../phylmd/ini_histday_seri.h
Index: LMDZ6/trunk/libf/phylmdiso/ini_histrac.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_histrac.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_histrac.h	(revision 3940)
@@ -1,245 +1,1 @@
-!
-! $Id $
-!
-  IF (ecrit_tra>0.) THEN
-!$OMP MASTER 
-!!!     CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
-! correction pour l heure initiale                               !jyg 
-!                                                               !jyg 
-      CALL ymds2ju(annee_ref, 1, day_ref, hour, zjulian)         !jyg
-
-     CALL histbeg_phy("histrac", itau_phy, zjulian, pdtphys,nhori, nid_tra)
-     CALL histvert(nid_tra, "presnivs", "Vertical levels", "Pa",klev, presnivs, nvert,"down")
-
-     zsto = pdtphys
-     zout = ecrit_tra
-     CALL histdef(nid_tra, "phis", "Surface geop. height", "-",   &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,"once",  zsto,zout)
-     CALL histdef(nid_tra, "aire", "Grid area", "-",              &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,"once",  zsto,zout)
-     CALL histdef(nid_tra, "zmasse", "column density of air in cell", &
-          "kg m-2", iim, jj_nb, nhori, klev, 1, klev, nvert, 32, "ave(X)", &
-          zsto,zout)
-! RomP >>>
-     CALL histdef(nid_tra, "sourceBE", "source 7Be", &
-          "at/kgA/s", iim, jj_nb, nhori, klev, 1, klev, nvert, 32, "ave(X)", &
-          zsto,zout)
-! RomP <<<
-
-!TRACEURS
-!----------------
-     DO it = 1,nbtr
-!!        iiq = niadv(it+2)                                                         ! jyg
-        iiq = niadv(it+nqo)                                                         ! jyg
-
-! CONCENTRATIONS
-        CALL histdef(nid_tra, tname(iiq), ttext(iiq), "U/kga",    &
-             iim,jj_nb,nhori, klev,1,klev,nvert, 32,"ave(X)", zsto,zout)
-
-! TD LESSIVAGE
-        IF (lessivage .AND. aerosol(it)) THEN
-           CALL histdef(nid_tra, "fl"//tname(iiq),"Flux "//ttext(iiq), &
-                "at/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_ls_"//tname(iiq),      &
-                "tendance lessivage large scale"// ttext(iiq), "?",&
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_insc_"//tname(iiq),      &
-                "tendance lessivage large scale"// ttext(iiq), "?",&
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_bcscav_"//tname(iiq),      &
-                "tendance lessivage large scale"// ttext(iiq), "?",&
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_evls_"//tname(iiq),      &
-                "tendance lessivage large scale"// ttext(iiq), "?",&
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
-                "ave(X)", zsto,zout)
-!  Tracer concentration in LS precipitation at surface
-           CALL histdef(nid_tra, "qpr_ls_"//tname(iiq),       &
-                "concentration in LS precip"// ttext(iiq), "at/kgw", &
-                iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-                "ave(X)", zsto,zout)     
-                 END IF
-
-! TD THERMIQUES
-        IF (iflag_thermals.gt.0) THEN
-           CALL histdef(nid_tra, "d_tr_th_"//tname(iiq),      &
-                "tendance thermique"// ttext(iiq), "?",       &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
-                "ave(X)", zsto,zout)
-        ENDIF
-
-! TD CONVECTION
-        IF (iflag_con.GE.2) THEN
-           CALL histdef(nid_tra, "d_tr_cv_"//tname(iiq),   &
-                "tendance convection"// ttext(iiq), "?",   &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-        ENDIF
-
-! RomP >>>
-        IF (iflag_con.EQ.30) THEN
-           CALL histdef(nid_tra, "d_tr_cvMA_"//tname(iiq),   &
-                "tendance convection"// ttext(iiq), "?",&
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_trsp_"//tname(iiq),   &
-                "tendance transport "// ttext(iiq), "at/kga",   &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_sscav_"//tname(iiq),   &
-                "tendance lessivage flux satures "// ttext(iiq), "at/kga",   &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_sat_"//tname(iiq),   &
-                "tendance flux satures "// ttext(iiq), "at/kga",  &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "d_tr_uscav_"//tname(iiq),  &
-                "tendance flux insatures "// ttext(iiq), "at/kga", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "tr_pr_"//tname(iiq),  &
-                "concentration dans precip"// ttext(iiq), "at/kga", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "tr_aa_"//tname(iiq),  &
-                "concentration precip issu AA"// ttext(iiq), "at/kga", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "tr_mel_"//tname(iiq),  &
-                "concentration precip issu melange"// ttext(iiq), "at/kga", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "tr_di_"//tname(iiq),  &
-                "concentration dans descente insaturee"// ttext(iiq), "at/kga", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "tr_trspdi_"//tname(iiq),  &
-                "conc descente insaturee MA"// ttext(iiq), "at/kga", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "zmfd1a_"//tname(iiq),  &
-                "zmfd1a"// ttext(iiq), "_", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "zmfphi2_"//tname(iiq),  &
-                "zmfphi2"// ttext(iiq), "_", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-           CALL histdef(nid_tra, "zmfdam_"//tname(iiq),  &
-                "zmfdam"// ttext(iiq), "_", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
-                "ave(X)", zsto,zout)
-          ENDIF
-! RomP <<<
-           CALL histdef(nid_tra, "dtrdyn_"//tname(iiq),  &
-                "td dyn tra"// ttext(iiq), "at/kga", &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,  &
-                "ave(X)", zsto,zout)
-! TD decroissance radioactive
-           CALL histdef(nid_tra, "d_tr_dec_"//tname(iiq),   &
-                "tendance decroi radio "// ttext(iiq), "",  &
-                iim,jj_nb,nhori, klev,1,klev,nvert, 32,  &
-                "ave(X)", zsto,zout)
-
-! TD COUCHE-LIMITE
-      IF (iflag_vdf_trac>=0) THEN
-        CALL histdef(nid_tra, "d_tr_cl_"//tname(iiq),      &
-             "tendance couche limite"// ttext(iiq), "?",   &
-             iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
-             "ave(X)", zsto,zout)
-!  Dry deposit (1st layer and surface)
-        CALL histdef(nid_tra, "d_tr_dry_"//tname(iiq),       &
-             "tendancy dry deposit"// ttext(iiq), "at/kga/step", &
-             iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-             "ave(X)", zsto,zout)     
-        CALL histdef(nid_tra, "flux_tr_dry_"//tname(iiq),       &
-             "dry deposit at surf (downward)"// ttext(iiq), "at/m2/step", &
-             iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-             "ave(X)", zsto,zout)     
-      ENDIF
-     ENDDO
-
-     CALL histdef(nid_tra, "Mint", "Mint","",         &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "inst(X)", zout,zout)
-     CALL histdef(nid_tra, "frac_impa", "frac_impa","",         &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "inst(X)", zout,zout)
-     CALL histdef(nid_tra, "frac_nucl", "frac_nucl","",         &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "inst(X)", zout,zout)
-!---------------   
-!
-! VENT (niveau 1)
-     CALL histdef(nid_tra, "pyu1", "Vent niv 1", "-",      &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)     
-     CALL histdef(nid_tra, "pyv1", "Vent niv 1", "-",      &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)
-
-! TEMPERATURE DU SOL
-     CALL histdef(nid_tra, "ftsol1", "temper sol", "-",    &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)
-     CALL histdef(nid_tra, "ftsol2", "temper sol", "-",    &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)
-     CALL histdef(nid_tra, "ftsol3", "temper sol", "-",    &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst",  zout,zout)
-     CALL histdef(nid_tra, "ftsol4", "temper sol", "-",    &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)
-
-! NATURE DU SOL
-     CALL histdef(nid_tra, "psrf1", "nature sol", "-",     &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)
-     CALL histdef(nid_tra, "psrf2", "nature sol", "-",     &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)
-     CALL histdef(nid_tra, "psrf3", "nature sol", "-",     &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
-          "inst(X)",  zout,zout)
-     CALL histdef(nid_tra, "psrf4", "nature sol", "-",     &
-          iim,jj_nb,nhori, 1,1,1, -99, 32,                 & 
-          "inst(X)",  zout,zout)
-! DIVERS
-     CALL histdef(nid_tra, "pplay", "pressure","-",        &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "inst(X)", zout,zout)
-     CALL histdef(nid_tra, "T", "temperature","K",         &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "inst(X)", zout,zout)
-     CALL histdef(nid_tra, "mfu", "flux u mont","-",       &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "ave(X)", zsto,zout)
-     CALL histdef(nid_tra, "mfd", "flux u decen","-",      &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "ave(X)", zsto,zout)
-     CALL histdef(nid_tra, "en_u", "flux u mont","-",      &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "ave(X)", zsto,zout)
-     CALL histdef(nid_tra, "en_d", "flux u mont","-",      &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "ave(X)", zsto,zout)
-     CALL histdef(nid_tra, "de_d", "flux u mont","-",      &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "ave(X)", zsto,zout)
-     CALL histdef(nid_tra, "de_u", "flux u decen","-",     &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "ave(X)", zsto,zout)
-     CALL histdef(nid_tra, "coefh", "turbulent coef","-",  &
-          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
-          "ave(X)", zsto,zout)   
-     
-     CALL histend(nid_tra)
-!$OMP END MASTER
-  END IF ! ecrit_tra>0.
-  
+link ../phylmd/ini_histrac.h
Index: LMDZ6/trunk/libf/phylmdiso/ini_undefSTD.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_undefSTD.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_undefSTD.F90	(revision 3940)
@@ -1,85 +1,1 @@
-
-! $Id: ini_undefSTD.F90 3435 2019-01-22 15:21:59Z fairhead $
-
-
-SUBROUTINE ini_undefstd(itap, itapm1)
-  USE dimphy
-  USE phys_state_var_mod ! Variables sauvegardees de la physique
-  USE phys_cal_mod, ONLY: mth_len
-  IMPLICIT NONE
-  include "clesphys.h"
-
-  ! ====================================================================
-
-  ! I. Musat : 09.2004
-
-  ! Initialisation - a des frequences differentes :
-
-  ! 1) des variables moyennees sur la journee "day" ou sur le mois "mth"
-  ! calculees a partir des valeurs "instantannees" de la physique
-
-  ! 2) des variables moyennes mensuelles "NMC" calculees a partir des val.
-  ! toutes les 6 heures
-
-  ! nout=1 !var. journaliere "day" moyenne sur tous les pas de temps
-  ! ! de la physique
-  ! nout=2 !var. mensuelle "mth" moyennee sur tous les pas de temps
-  ! ! de la physique
-  ! nout=3 !var. mensuelle "NMC" moyennee toutes les 6heures
-
-  ! NB: mettre "inst(X)" dans le write_hist*NMC.h !
-  ! ====================================================================
-
-  ! ym #include "dimphy.h"
-  ! variables Input/Output
-  ! INTEGER nlevSTD, klevSTD, itap
-  INTEGER itap, itapm1
-  ! PARAMETER(klevSTD=17)
-  ! REAL dtime
-
-  ! variables locales
-  ! INTEGER i, k, nout, n
-  INTEGER i, k, n
-  ! PARAMETER(nout=3) !nout=1 day/nout=2 mth/nout=3 NMC
-  ! REAL freq_outNMC(nout)
-  REAL un_jour
-  PARAMETER (un_jour=86400.)
-
-  ! variables Output
-  ! REAL tnondef(klon,klevSTD,nout)
-  ! REAL tsumSTD(klon,klevSTD,nout)
-
-  DO n = 1, nout
-
-    ! initialisation variables en debut du mois, de la journee ou des 6h
-
-    IF (n==1 .AND. itap-itapm1==1 .OR. n>1 .AND. mod(itap,nint( &
-        freq_outnmc(n)/phys_tstep))==1) THEN
-      ! print*,'ini_undefSTD n itap',n,itap
-      DO k = 1, nlevstd
-        DO i = 1, klon
-          tnondef(i, k, n) = 0.
-          tsumstd(i, k, n) = 0.
-          usumstd(i, k, n) = 0.
-          vsumstd(i, k, n) = 0.
-          wsumstd(i, k, n) = 0.
-          phisumstd(i, k, n) = 0.
-          qsumstd(i, k, n) = 0.
-          rhsumstd(i, k, n) = 0.
-          uvsumstd(i, k, n) = 0.
-          vqsumstd(i, k, n) = 0.
-          vtsumstd(i, k, n) = 0.
-          wqsumstd(i, k, n) = 0.
-          vphisumstd(i, k, n) = 0.
-          wtsumstd(i, k, n) = 0.
-          u2sumstd(i, k, n) = 0.
-          v2sumstd(i, k, n) = 0.
-          t2sumstd(i, k, n) = 0.
-          o3sumstd(i, k, n) = 0.
-          o3daysumstd(i, k, n) = 0.
-        END DO !i
-      END DO !k
-    END IF !
-  END DO !n
-  RETURN
-END SUBROUTINE ini_undefstd
+link ../phylmd/ini_undefSTD.F90
Index: LMDZ6/trunk/libf/phylmdiso/ini_wake.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ini_wake.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ini_wake.F90	(revision 3940)
@@ -1,88 +1,1 @@
-
-! $Id: ini_wake.F90 2311 2015-06-25 07:45:24Z emillour $
-
-SUBROUTINE ini_wake(wape, fip, it_wape_prescr, wape_prescr, fip_prescr, &
-    alp_bl_prescr, ale_bl_prescr)
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-  ! **************************************************************
-  ! *
-  ! INI_WAKE : variables d'initialisation de la poche    *
-  ! froide, necessaires au declenchement      *
-  ! de la convection.                         *
-  ! *
-  ! *
-  ! **************************************************************
-  ! Arguments
-  ! =========
-  ! Input
-  ! -----
-  ! wape           : valeur de l'energie potentielle de la poche (WAPE)
-  ! dans l'etat initial
-  ! fip            : valeur de la puissance incidente sur le front (FIP)
-  ! dans l'etat initial
-  ! Output
-  ! ------
-  ! it_wape_prescr : nombre de pas de temps pendant lesquels la WAPE
-  ! doit etre imposee.
-  ! wape_prescr    : valeur prescrite de la WAPE.
-  ! fip_prescr     : valeur prescrite de la FIP.
-  ! ale_bl_prescr  : valeur prescrite de la Ale de PBL.
-  ! alp_bl_prescr  : valeur prescrite de la Alp de PBL.
-
-  ! Variables internes
-  ! ==================
-  ! it = nbre de pas de temps lu
-  ! w  = WAPE lue
-  ! f  = FIP lue
-  ! alebl  = Ale de PBL lue
-  ! alpbl  = Alp de PBL lue
-
-  ! declarations
-  REAL wape, fip, wape_prescr, fip_prescr
-  INTEGER it_wape_prescr
-  REAL ale_bl_prescr
-  REAL alp_bl_prescr
-  REAL it
-  REAL w,f,alebl,alpbl
-
-  ! FH A mettre si besoin dans physiq.def
-  ! FH : voir avec JYG
-  it = 0.
-  w = 4.
-  f = 0.1
-  alebl = 4.
-  alpbl = 0.1
-
-  ! CR: on rajoute ale et alp de la PBL precrits
-  OPEN (99, FILE='ini_wake_param.data', FORM='formatted', STATUS='old', &
-    ERR=902)
-  READ (99, *) it
-  READ (99, *) w
-  READ (99, *) f
-  READ (99, *, END=901) alebl
-  READ (99, *, END=901) alpbl
-901 CLOSE (99)
-902 CONTINUE
-
-  WRITE (lunout, *) ' it,wape ', it, wape
-  it_wape_prescr = it
-  IF (w<0) THEN
-    wape_prescr = wape
-    fip_prescr = fip
-  ELSE
-    wape_prescr = w
-    fip_prescr = f
-  END IF
-
-  WRITE (lunout, *) ' alebl, alpbl ', alebl, alpbl
-  ale_bl_prescr = alebl
-  alp_bl_prescr = alpbl
-  PRINT *, 'Initialisation de la poche : WAPE, FIP imposees =', wape_prescr, &
-    fip_prescr
-  PRINT *, '                   pendant ', it_wape_prescr, ' steps'
-
-  PRINT *, 'Initialisation de la BL: ALP, ALE imposees =', alp_bl_prescr, &
-    ale_bl_prescr
-  RETURN
-END SUBROUTINE ini_wake
+link ../phylmd/ini_wake.F90
Index: LMDZ6/trunk/libf/phylmdiso/inifis_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/inifis_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/inifis_mod.F90	(revision 3940)
@@ -1,81 +1,1 @@
-! $Id: inifis_mod.F90 3435 2019-01-22 15:21:59Z fairhead $
-MODULE inifis_mod
-
-CONTAINS
-
-  SUBROUTINE inifis(punjours, prad, pg, pr, pcpp)
-  ! Initialize some physical constants and settings
-  USE init_print_control_mod, ONLY : init_print_control
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-  REAL,INTENT(IN) :: prad, pg, pr, pcpp, punjours
-
-  CHARACTER (LEN=20) :: modname = 'inifis'
-  CHARACTER (LEN=80) :: abort_message
-
-  ! Initialize flags lunout, prt_level, debug
-  CALL init_print_control
-
-  ! suphel => initialize some physical constants (orbital parameters,
-  !           geoid, gravity, thermodynamical constants, etc.) in the
-  !           physics
-  CALL suphel
-
-  ! check that physical constants set in 'suphel' are coherent
-  ! with values set in the dynamics:
-  IF (rday/=punjours) THEN
-    WRITE (lunout, *) 'inifis: length of day discrepancy!!!'
-    WRITE (lunout, *) '  in the dynamics punjours=', punjours
-    WRITE (lunout, *) '   but in the physics RDAY=', rday
-    IF (abs(rday-punjours)>0.01*punjours) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'length of day discrepancy'
-      CALL abort_physic(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (rg/=pg) THEN
-    WRITE (lunout, *) 'inifis: gravity discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pg=', pg
-    WRITE (lunout, *) '  but in the physics RG=', rg
-    IF (abs(rg-pg)>0.01*pg) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'gravity discrepancy'
-      CALL abort_physic(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (ra/=prad) THEN
-    WRITE (lunout, *) 'inifis: planet radius discrepancy !!!'
-    WRITE (lunout, *) '   in the dynamics prad=', prad
-    WRITE (lunout, *) '  but in the physics RA=', ra
-    IF (abs(ra-prad)>0.01*prad) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'planet radius discrepancy'
-      CALL abort_physic(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (rd/=pr) THEN
-    WRITE (lunout, *) 'inifis: reduced gas constant discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pr=', pr
-    WRITE (lunout, *) '  but in the physics RD=', rd
-    IF (abs(rd-pr)>0.01*pr) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'reduced gas constant discrepancy'
-      CALL abort_physic(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (rcpd/=pcpp) THEN
-    WRITE (lunout, *) 'inifis: specific heat discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
-    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
-    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'specific heat discrepancy'
-      CALL abort_physic(modname, abort_message, 1)
-    END IF
-  END IF
-
-  END SUBROUTINE inifis
-  
-END MODULE inifis_mod
+link ../phylmd/inifis_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/iniorbit.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iniorbit.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iniorbit.F90	(revision 3940)
@@ -1,103 +1,1 @@
-SUBROUTINE iniorbit(paphelie, pperiheli, pyear_day, pperi_day, pobliq)
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Auteur:
-  ! -------
-  ! Frederic Hourdin      22 Fevrier 1991
-
-  ! Objet:
-  ! ------
-  ! Initialisation du sous programme orbite qui calcule
-  ! a une date donnee de l'annee de duree year_day commencant
-  ! a l'equinoxe de printemps et dont le perihelie se situe
-  ! a la date peri_day, la distance au soleil et la declinaison.
-
-  ! Interface:
-  ! ----------
-  ! - Doit etre appele avant d'utiliser orbite.
-  ! - initialise une partie du common planete.h
-
-  ! Arguments:
-  ! ----------
-
-  ! Input:
-  ! ------
-  ! aphelie       \   aphelie et perihelie de l'orbite
-  ! periheli      /   en millions de kilometres.
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! Declarations:
-  ! -------------
-
-  include "planete.h"
-  include "YOMCST.h"
-
-  ! Arguments:
-  ! ----------
-
-  REAL paphelie, pperiheli, pyear_day, pperi_day, pobliq
-
-  ! Local:
-  ! ------
-
-  REAL zxref, zanom, zz, zx0, zdx, pi
-  INTEGER iter
-
-  ! -----------------------------------------------------------------------
-
-  pi = 2.*asin(1.)
-
-  aphelie = paphelie
-  periheli = pperiheli
-  year_day = pyear_day
-  obliquit = pobliq
-  peri_day = pperi_day
-
-  PRINT *, 'Perihelie en Mkm  ', periheli
-  PRINT *, 'Aphelie  en Mkm   ', aphelie
-  PRINT *, 'obliquite en degres  :', obliquit
-  PRINT *, 'Jours dans l annee : ', year_day
-  PRINT *, 'Date perihelie : ', peri_day
-  unitastr = 149.597870
-  e_elips = (aphelie-periheli)/(periheli+aphelie)
-  p_elips = 0.5*(periheli+aphelie)*(1-e_elips*e_elips)/unitastr
-
-  PRINT *, 'e_elips', e_elips
-  PRINT *, 'p_elips', p_elips
-
-  ! -----------------------------------------------------------------------
-  ! calcul de l'angle polaire et de la distance au soleil :
-  ! -------------------------------------------------------
-
-  ! calcul de l'zanomalie moyenne
-
-  zz = (year_day-pperi_day)/year_day
-  zanom = 2.*pi*(zz-nint(zz))
-  zxref = abs(zanom)
-  PRINT *, 'zanom  ', zanom
-
-  ! resolution de l'equation horaire  zx0 - e * sin (zx0) = zxref
-  ! methode de Newton
-
-  zx0 = zxref + r_ecc*sin(zxref)
-  DO iter = 1, 100
-    zdx = -(zx0-r_ecc*sin(zx0)-zxref)/(1.-r_ecc*cos(zx0))
-    IF (abs(zdx)<=(1.E-12)) GO TO 120
-    zx0 = zx0 + zdx
-  END DO
-120 CONTINUE
-  zx0 = zx0 + zdx
-  IF (zanom<0.) zx0 = -zx0
-  PRINT *, 'zx0   ', zx0
-
-  ! zteta est la longitude solaire
-
-  timeperi = 2.*atan(sqrt((1.+r_ecc)/(1.-r_ecc))*tan(zx0/2.))
-  PRINT *, 'longitude solaire du perihelie timeperi = ', timeperi
-
-  RETURN
-END SUBROUTINE iniorbit
+link ../phylmd/iniorbit.F90
Index: LMDZ6/trunk/libf/phylmdiso/iniradia.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iniradia.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iniradia.F90	(revision 3940)
@@ -1,38 +1,1 @@
-SUBROUTINE iniradia(klon, klev, pres)
-
-  IMPLICIT NONE
-  ! ======================================================================
-
-  ! Auteur(s) MP Lefebvre        date: 20080827
-
-  ! Objet: initialise le rayonnement RRTM
-  ! ======================================================================
-  ! Arguments:
-
-  ! klon----input-I-nombre de points horizontaux
-  ! klev----input-I-nombre de couches verticales
-  ! pres----input-R-pression pour chaque inter-couche (en Pa)
-  ! ======================================================================
-
-  INTEGER klon
-  INTEGER klev
-  REAL pres(klev+1)
-
-  include "clesphys.h"
-
-  ! CALL suphel     ! initialiser constantes et parametres phys.
-  ! print*,'Physiq: apres suphel '
-#if CPP_RRTM
-  if (iflag_rrtm .eq. 1) then 
-     CALL suinit(klon, klev)
-     PRINT *, 'iniradia: apres suinit '
-     ! calcul des niveaux de pression de reference au bord des couches pour
-     ! l'intialisation des aerosols. Momentannement, on passe un point de
-     ! grille du profil de pression.
-     CALL surayolmd          ! initialiser le rayonnement RRTM
-     PRINT *, 'iniradia: apres surayolmd '
-  endif
-#endif
-
-  RETURN
-END SUBROUTINE iniradia
+link ../phylmd/iniradia.F90
Index: LMDZ6/trunk/libf/phylmdiso/init_be.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/init_be.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/init_be.F90	(revision 3940)
@@ -1,565 +1,1 @@
-!$Id $
-
-SUBROUTINE init_be(pctsrf,pplay,masktr,tautr,vdeptr,scavtr,srcbe)
-!!!SUBROUTINE init_be(pctsrf,masktr,tautr,vdeptr,scavtr,srcbe)
-
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr
-  USE indice_sol_mod
-  USE geometry_mod, ONLY : longitude, latitude
-    
-  IMPLICIT NONE 
-!=====================================================================
-! Objet : prescription d'une source de Beryllium 7 
-!         pour 19 niveaux verticaux
-!        (d'apres le diagramme de Lal and Peters, 1967)
-!
-!
-! written by : O. Coindreau (CEA/LDG) 05/2005
-! last modified by : A. Jamelot (LMD/CEA)  04/03/2009 
-!=====================================================================
-
-  INCLUDE "YOMCST.h"
-  INCLUDE "YOECUMF.h" 
-
-!
-! Input Arguments
-!
-  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf !Pourcentage de sol (f(nature du sol))
-  REAL,DIMENSION(klon,klev), INTENT(IN) :: pplay  ! Pressions en milieu de couches
-!
-! Output Arguments
-!
-  REAL,DIMENSION(klon),INTENT(OUT)      :: masktr ! Masque de l'echange avec la surface (possible => 1 )
-  REAL,INTENT(OUT)                      :: tautr  ! Constante de decroissance radioactive
-  REAL,INTENT(OUT)                      :: vdeptr ! Vitesse de depot sec dans la couche Brownienne
-  REAL,INTENT(OUT)                      :: scavtr ! Coefficient de lessivage
-  REAL,DIMENSION(klon,klev),INTENT(OUT) :: srcbe  ! source volumique de 7Be      
-!
-! Local Variables
-!
-!!!  INTEGER              :: iref      ! numero d'un point oceanique donnant la grille de pression de reference
-  REAL,DIMENSION(klon) :: rlatgeo   ! latitudes geomagnetiques de la grille
-  REAL                 :: glt       ! latitude du pole geomagnetique
-  REAL                 :: glg       ! longitude du pole geomagnetique
-  REAL                 :: latgeo,qcos
-  INTEGER              :: k,i, kref, k2
-  INTEGER              :: nref
-  PARAMETER (nref=39)
-  REAL,DIMENSION(nref), SAVE :: pref      ! grille de pression de reference (bas des couches)
-  DATA pref  /   &
-      101249.99999999994, 100387.17261011522, 99447.35334189111,  98357.43412194174,   &
-      97046.47707771382,  95447.1116450629,   93496.85259615642,  91139.46548240296,   &
-      88326.55568744117,  85019.60710580258,  81192.7404556645,   76836.48366938648,   &
-      71962.81275769137,  66611.56331321516,  60857.914829743604, 54819.84484441629,   &
-      48663.06257114699,  42598.95465845692,  36869.104365898806, 31709.927925633147,  &
-      27296.757208636915, 23682.282929080895, 20766.025578936627, 18336.105961406534,  &
-      16178.04816768436,  14168.286905562818, 12275.719926478887, 10507.798835225762,  &
-      8876.585404909414,  7391.283929569539,  6057.514475749798,  4877.165909157005,   &
-      3848.34936408203,   2965.444753540027,  2219.2391544640013, 1597.15366044666,    &
-      1083.5531161631498, 660.1311067852655,  306.36072267002805 / 
-!$OMP THREADPRIVATE(pref)
-
-  WRITE(*,*)'PASSAGE init_be ...'
-
-! la source est maintenant définie independemment de la valeur de klev.
-!!! Source actuellement definie pour klev = 19 et klev >= 39
-!!  IF (klev /= 19 .AND. klev<39) CALL abort_physic("init_be","Source du be7 necessite klev=19 ou klev>=39",1)
-!!!
-! Definition des constantes
-! -------------------------
-  tautr = 6645000.
-  vdeptr = 1.E-3 
-  scavtr = 0.5 
-!!!!!jyg le 13/03/2013; puis 20/03/2013 : pref est maintenant une table.
-!!!
-!!!   Recherche d'un point rlat=0., rlon=180.
-!!      iref=(klon+1)/2
-!!      DO i = 1,klon
-!!        IF (abs(rlatd(i)) .LT. 0.15 .AND. cos(rlond(i)) .LT. -0.85) iref=i
-!!      ENDDO
-!!!
-!!!   Grille de pression de reference (= approx de sommets de couches)
-!!      pref(1) = pplay(iref,1)+0.5*(pplay(iref,1)-pplay(iref,2))
-!!      DO k = 2,klev
-!!        pref(k) = 0.5*(pplay(iref,k-1)+pplay(iref,k))
-!!      ENDDO
-!!!
-
-  WRITE(*,*) '-------------- SOURCE DE BERYLLIUM ------------------- '
-  WRITE(*,*)'Decroissance (s): ', tautr
-  WRITE(*,*)'Vitesse de depot sec: ',vdeptr
-  WRITE(*,*)'Facteur de lessivage: ',scavtr
-
-  DO i = 1,klon
-     masktr(i) = 0.
-     IF ( NINT(pctsrf(i,1)) .EQ. 1 ) masktr(i) = 1.
-  END DO
-
-! Premiers niveaux: source nulle
-! ------------------------------
-  DO k = 1,6
-     DO i = 1,klon
-        srcbe(i,k) = 0.
-     END DO
-  END DO
-!
-! Pour les autres niveaux:
-! 1-passer des coordonnees geographiques a la latitude geomagnetique
-! 2-prescrire la source de Be (en 10exp5 at/g/s) dans ce repere
-! 3-mettre la source de Be ds la bonne unite (en at/kgA/s)
-!
-  glt =  78.5*rpi/180.
-  glg = -69.0*rpi/180.
-
-  DO i = 1,klon
-     qcos=sin(glt)*sin(latitude(i))
-!!jyg
-!!     qcos=qcos+cos(glt)*cos(latitude(i))*cos(longitude(i)+glg)
-     qcos=qcos+cos(glt)*cos(latitude(i))*cos(longitude(i)-glg)
-!!jyg end
-     IF ( qcos .LT. -1.) qcos = -1.
-     IF ( qcos .GT. 1.)  qcos = 1.
-     rlatgeo(i)=rpi/2.-acos(qcos)
-  ENDDO
-
-!!!===========================
-!!!  Cas 19 niveaux verticaux
-!!!===========================
-!!  IF (klev.eq.19) then
-!!     DO k = 1,klev
-!!        DO i = 1,klon
-!!!!!jyg le 13/03/2013
-!!!
-!!! k est le niveau dans la grille locale
-!!! Determination du niveau kref dans la grille de refernce
-!!      kref = 1
-!!      DO k2 = 1,klev
-!!        IF (pref(k2) .GT. pplay(i,k)) kref=k2
-!!      ENDDO
-!!!!!
-!!           latgeo=(180./rpi)*abs(rlatgeo(i))
-!!           IF ( kref .EQ. 1 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.09
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.07
-!!           END IF
-!!           IF ( kref .EQ. 2 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=0.12
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.09
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.07
-!!           END IF
-!!           IF ( kref .EQ. 3 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=0.14
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.12
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.09
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.07
-!!           END IF
-!!           IF ( kref .EQ. 4 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=0.175
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.14
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.12
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.09
-!!           END IF
-!!           IF ( kref .EQ. 5 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=0.28
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.26
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.23
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.175
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.14
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.12
-!!           END IF
-!!           IF ( kref .EQ. 6 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=0.56
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.49
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.42
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.28
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.26
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.245
-!!           END IF
-!!           IF ( kref .EQ. 7 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=1.05
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.875
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.7
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.52
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.44
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.385
-!!           END IF
-!!           IF ( kref .EQ. 8 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=2.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=1.8
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=1.5
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=1.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.8
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.75
-!!           END IF
-!!           IF ( kref .EQ. 9 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=4.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=3.5
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=3.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=2.5
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=1.8
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=1.4
-!!           END IF
-!!           IF ( kref .EQ. 10 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=8.5
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=8.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=7.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=4.5
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=3.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3.
-!!           END IF
-!!           IF ( kref .EQ. 11 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=17.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=15.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=11.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=8.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=5.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4.
-!!           END IF
-!!           IF ( kref .EQ. 12 ) THEN
-!!              IF (latgeo.GE.50.0) srcbe(i,k)=25.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=22.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=11.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=7.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.
-!!           END IF
-!!           IF ( kref .EQ. 13 ) THEN
-!!              IF (latgeo.GE.60.0) srcbe(i,k)=33.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=32.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=30.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=22.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=11.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=8.
-!!           END IF
-!!           IF ( kref .EQ. 14 ) THEN
-!!              IF (latgeo.GE.60.0) srcbe(i,k)=48.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=36.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=26.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=17.5
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
-!!           END IF
-!!           IF ( kref .EQ. 15 ) THEN
-!!              IF (latgeo.GE.70.0) srcbe(i,k)=58.
-!!              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=57.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=38.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=25.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
-!!           END IF
-!!           IF ( kref .EQ. 16 ) THEN
-!!              IF (latgeo.GE.70.0) srcbe(i,k)=70.
-!!              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=65.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=32.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=20.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=13.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=9.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.5
-!!           END IF
-!!           IF ( kref .GE. 17 ) THEN
-!!              IF (latgeo.GE.70.0) srcbe(i,k)=80.
-!!              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=70.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=27.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17.5
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=12.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=8.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.
-!!           END IF
-!!        END DO
-!!     END DO
-!!  END IF ! fin de 19 niveaux verticaux
-!!
-!!!!!!  IF (klev .ge. 39) then
-     DO k = 1,klev
-        DO i = 1,klon
-!!!jyg le 13/03/2013
-!
-! k est le niveau dans la grille locale
-! Determination du niveau kref dans la grille de refernce
-      kref = 1
-      DO k2 = 1,nref
-        IF (pref(k2) .GT. pplay(i,k)) kref=k2
-      ENDDO
-!!!
-           latgeo=(180./rpi)*abs(rlatgeo(i))
-           IF ( kref .LE. 4 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.07
-           END IF
-           IF ( kref .EQ. 5 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.1
-              IF (latgeo.GE.20.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.09
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.07
-           END IF
-           IF ( kref .EQ. 6 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.14
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.12
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.1
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.09
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.07
-           END IF
-           IF ( kref .EQ. 7 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.16
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.14
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.12
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.1
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.09
-           END IF
-           IF ( kref .EQ. 8 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.175
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.14
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.12
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.1
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.1
-           END IF
-           IF ( kref .EQ. 9 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.245
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.21
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.175
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.14
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.12
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.12
-           END IF
-           IF ( kref .EQ. 10 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.31
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.28
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.245
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.21
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.16
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.14
-           END IF
-           IF ( kref .EQ. 11 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.35
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.3
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.3
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.2
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.18
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.16
-           END IF
-           IF ( kref .EQ. 12 ) THEN
-              IF (latgeo.GE.40.0) srcbe(i,k)=0.5
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.4
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.35
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.3
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.25
-           END IF
-           IF ( kref .EQ. 13 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=0.8
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.7
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.6
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.5
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.4
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.35
-           END IF
-           IF ( kref .EQ. 14 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=1.2
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=1.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.75
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.6
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.4
-           END IF
-           IF ( kref .EQ. 15 ) THEN
-              IF (latgeo.GE.60.0) srcbe(i,k)=1.75
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=1.8 
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=1.6
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=1.4
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.9
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.75
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.65
-           END IF
-           IF ( kref .EQ. 16 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=3.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=2.5
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=1.8
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=1.5
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=1.2
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.9
-           END IF
-           IF ( kref .EQ. 17 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=4.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=3.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=2.5
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=2.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=1.6
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=1.4
-           END IF
-           IF ( kref .EQ. 18 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=7.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=6.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=4.5
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=3.5
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=3.
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=2.
-           END IF
-           IF ( kref .EQ. 19 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=8.5
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=8.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=7.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=4.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=3.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3.
-           END IF
-           IF ( kref .EQ. 20 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=12.5
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=12.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=8.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=6.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=4.
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3.5
-           END IF
-           IF ( kref .EQ. 21 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=16.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=13.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=10.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=7.5
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=4.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4.
-           END IF
-           IF ( kref .EQ. 22 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=20.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=17.5
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=12.5
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=9.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=6.
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4.5
-           END IF
-           IF ( kref .EQ. 23 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=25.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=22.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=15.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=10.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=7.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6.
-           END IF
-           IF ( kref .EQ. 24 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=28.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=26.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=18.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=12.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=8.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.
-           END IF
-           IF ( kref .EQ. 25 ) THEN
-              IF (latgeo.GE.50.0) srcbe(i,k)=33.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=28.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=20.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=14.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=10.
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=8.5
-           END IF
-           IF ( kref .EQ. 26 ) THEN
-              IF (latgeo.GE.60.0) srcbe(i,k)=38.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=36.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=32.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=24.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=11.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
-!!jyg
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6.
-!!jyg end
-           END IF
-           IF ( kref .EQ. 27 ) THEN
-              IF (latgeo.GE.60.0) srcbe(i,k)=46.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=44.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=35.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=25.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=16.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
-           END IF
-           IF ( kref .EQ. 28 ) THEN
-              IF (latgeo.GE.60.0) srcbe(i,k)=53.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=48.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=37.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=25.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=16.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
-           END IF
-           IF ( kref .EQ. 29 ) THEN
-              IF (latgeo.GE.70.0) srcbe(i,k)=58.
-              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=56.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=36.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=24.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=11.5
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
-           END IF
-           IF ( kref .EQ. 30 ) THEN
-              IF (latgeo.GE.70.0) srcbe(i,k)=65.
-              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=60.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=35.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=22.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=14.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=10.
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=9.
-           END IF
-           IF ( kref .EQ. 31 ) THEN
-              IF (latgeo.GE.70.0) srcbe(i,k)=70.
-              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=62.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=48.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=32.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=21.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=13.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=9.
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.6
-           END IF
-           IF ( kref .EQ. 32 ) THEN
-              IF (latgeo.GE.70.0) srcbe(i,k)=80.
-              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=60.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=46.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=30.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17.5
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=11.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=8.
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.4
-           END IF
-           IF ( kref .GE. 33 ) THEN
-              IF (latgeo.GE.70.0) srcbe(i,k)=80.
-              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=70.
-              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45.
-              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=27.
-              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=15.
-              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=10.
-              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=7.6
-              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.
-           END IF
-        END DO
-     END DO
-!!!!!!  END IF ! fin de 39 niveaux verticaux
-
-
-!====================================
-! Conversion de la source en U/s/kgA
-!====================================
-  DO k = 1,klev
-     DO i = 1,klon
-       ! La source est  at/min/m3 -> at/s/kgA
-       ! avec une masse volumique de l'air = 1.295 kg/m3
-       ! 1/(60*1.295) = 0.01287
-       srcbe(i,k)=srcbe(i,k)*0.01287
-!!       print *,'  k, srcbe(i,k) ',   &
-!!                  k, srcbe(i,k)
-       ! La source est  at/min/m3 -> at/s/m3
-       ! srcbe(i,k)=srcbe(i,k)*0.0166667
-    END DO
- END DO
-
-END SUBROUTINE init_be
+link ../phylmd/init_be.F90
Index: LMDZ6/trunk/libf/phylmdiso/initphysto.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/initphysto.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/initphysto.F90	(revision 3940)
@@ -1,206 +1,1 @@
-!
-! $Id: initphysto.F90 2343 2015-08-20 10:02:53Z emillour $
-!
-SUBROUTINE initphysto(infile,tstep,t_ops,t_wrt,fileid)
-  
-  USE dimphy
-  USE mod_phys_lmdz_para
-  USE IOIPSL
-  USE iophy
-  USE indice_sol_mod
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
-  USE time_phylmdz_mod, ONLY: day_ref, annee_ref
-  
-  IMPLICIT NONE
-
-!
-!   Routine d'initialisation des ecritures des fichiers histoires LMDZ
-!   au format IOIPSL
-!
-!   Appels succesifs des routines: histbeg
-!                                  histhori
-!                                  histver
-!                                  histdef
-!                                  histend
-!
-!   Entree:
-!
-!      infile: nom du fichier histoire a creer
-!      day0,anne0: date de reference
-!      tstep: duree du pas de temps en seconde
-!      t_ops: frequence de l'operation pour IOIPSL
-!      t_wrt: frequence d'ecriture sur le fichier
-!
-!   Sortie:
-!      fileid: ID du fichier netcdf cree
-!
-!   L. Fairhead, LMD, 03/99
-!
-! =====================================================================
-
-!   Arguments
-  CHARACTER(len=*), INTENT(IN) :: infile
-  REAL, INTENT(IN)             :: tstep
-  REAL, INTENT(IN)             :: t_ops
-  REAL, INTENT(IN)             :: t_wrt
-  INTEGER, INTENT(OUT)         :: fileid
-
-! Variables locales
-  INTEGER nhoriid, i
-  INTEGER l,k
-  REAL nivsigs(nbp_lev)
-  INTEGER tau0
-  REAL zjulian
-  INTEGER iq
-  INTEGER uhoriid, vhoriid, thoriid, zvertiid
-  INTEGER ii,jj
-  INTEGER zan, idayref
-  LOGICAL ok_sync
-  REAL zx_lon(nbp_lon,nbp_lat), zx_lat(nbp_lon,nbp_lat)
-  CHARACTER(len=12) :: nvar
-
-!  Initialisations
-!
-  ok_sync= .TRUE.
-!
-!  Appel a histbeg: creation du fichier netcdf et initialisations diverses
-!         
-
-  zan = annee_ref
-  idayref = day_ref
-  CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
-  tau0 = 0
-  
-  CALL histbeg_phy(infile,tau0, zjulian, tstep, &
-       nhoriid, fileid)
-
-!$OMP MASTER	
-!  Appel a histvert pour la grille verticale
-!
-  DO l=1,nbp_lev
-     nivsigs(l)=REAL(l)
-  ENDDO
-  
-  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', &
-       'sigma_level', &
-       nbp_lev, nivsigs, zvertiid)
-!
-!  Appels a histdef pour la definition des variables a sauvegarder
-!
-  CALL histdef(fileid, "phis", "Surface geop. height", "-", &
-       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
-       "once", t_ops, t_wrt)
-  
-  CALL histdef(fileid, "aire", "Grid area", "-", &
-       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
-       "once", t_ops, t_wrt)
-
-  CALL histdef(fileid, "longitudes", "longitudes", "-", &
-       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
-       "once", t_ops, t_wrt)
-
-  CALL histdef(fileid, "latitudes", "latitudes", "-", &
-       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
-       "once", t_ops, t_wrt)
-! T 
-  CALL histdef(fileid, 't', 'Temperature', 'K', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-! mfu 
-  CALL histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
-! mfd 
-  CALL histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-! en_u 
-  CALL histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
-! de_u 
-  CALL histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
-! en_d 
-  CALL histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
-! de_d 
-  CALL histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-! coefh
-  CALL histdef(fileid, "coefh", " ", " ", nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, "inst(X)", t_ops, t_wrt)
-! fm_th
-  CALL histdef(fileid, "fm_th", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, "inst(X)", t_ops, t_wrt)
-! en_th
-  CALL histdef(fileid, "en_th", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, "inst(X)", t_ops, t_wrt)
-! frac_impa
-  CALL histdef(fileid, 'frac_impa', ' ', ' ',nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
-! frac_nucl
-  CALL histdef(fileid, 'frac_nucl', ' ', ' ',nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
-! pyu1
-  CALL histdef(fileid, "pyu1", " ", " ", nbp_lon,jj_nb,nhoriid, &
-       1,1,1, -99, 32, "inst(X)", t_ops, t_wrt)
-! pyv1
-  CALL histdef(fileid, "pyv1", " ", " ", nbp_lon,jj_nb,nhoriid, &
-       1,1,1, -99, 32,"inst(X)", t_ops, t_wrt)    
-! ftsol1
-  CALL histdef(fileid, "ftsol1", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
-! ftsol2
-  CALL histdef(fileid, "ftsol2", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
-! ftsol3
-  CALL histdef(fileid, "ftsol3", " ", " ", nbp_lon, jj_nb, nhoriid, &
-       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
-! ftsol4
-  CALL histdef(fileid, "ftsol4", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       1, 1,1, -99, 32, "inst(X)", t_ops, t_wrt)
-! psrf1
-  CALL histdef(fileid, "psrf1", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt)
-! psrf2
-  CALL histdef(fileid, "psrf2", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt)
-! psrf3
-  CALL histdef(fileid, "psrf3", " ", " ",nbp_lon, jj_nb, nhoriid, &
-       1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt)
-! psrf4
-  CALL histdef(fileid, "psrf4", " ", " ", nbp_lon, jj_nb, nhoriid, &
-       1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt)
-! sh
-  CALL histdef(fileid, 'sh', '', '', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-! da
-  CALL histdef(fileid, 'da', '', '', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-! mp
-  CALL histdef(fileid, 'mp', '', '', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-! upwd
-  CALL histdef(fileid, 'upwd', '', '', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-! dnwd
-  CALL histdef(fileid, 'dnwd', '', '', nbp_lon, jj_nb, nhoriid, &
-       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-
-! phi
-  DO k=1,nbp_lev
-     IF (k<10) THEN
-        WRITE(nvar,'(i1)') k
-     ELSE IF (k<100) THEN
-        WRITE(nvar,'(i2)') k
-     ELSE
-        WRITE(nvar,'(i3)') k
-     END IF
-     nvar='phi_lev'//trim(nvar)
-     
-     CALL histdef(fileid, nvar, '', '', nbp_lon, jj_nb, nhoriid, &
-          nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
-  END DO
-
-  CALL histend(fileid)
-  IF (ok_sync) CALL histsync
-!$OMP END MASTER
-	
-END SUBROUTINE initphysto
+link ../phylmd/initphysto.F90
Index: LMDZ6/trunk/libf/phylmdiso/initrrnpb.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/initrrnpb.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/initrrnpb.F90	(revision 3940)
@@ -1,95 +1,1 @@
-!
-! $Id: initrrnpb.F90 2320 2015-07-01 13:57:32Z emillour $
-!
-SUBROUTINE  initrrnpb(ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr
-  USE traclmdz_mod, ONLY : id_rn, id_pb
-  USE indice_sol_mod
-  IMPLICIT NONE
-!======================================================================
-! Auteur(s): AA + CG (LGGE/CNRS) Date 24-06-94
-! Objet: initialisation des constantes des traceurs
-! id_rn : identificateur du traceur radon
-! id_pb : identificateur du traceur plomb
-!======================================================================
-! Arguments:
-! nbtr.............. nombre de vrais traceurs (sans l'eau)
-! ftsol....input-R-  Temperature du sol (Kelvin)
-! pctsrf...input-R-  Nature de sol (pourcentage de sol)
-! masktr...output-R- Masque reservoir de sol traceur (1 = reservoir)
-! fshtr....output-R- Flux surfacique de production dans le reservoir de sol
-! hsoltr...output-R- Epaisseur equivalente du reservoir de sol
-! tautr....output-R- Constante de decroissance radioactive du traceur
-! vdeptr...output-R- Vitesse de depot sec dans la couche Brownienne
-! scavtr...output-R- Coefficient de lessivage
-!======================================================================
- 
-  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf
-  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol
-  REAL,DIMENSION(klon,nbtr),INTENT(OUT) :: masktr
-  REAL,DIMENSION(klon,nbtr),INTENT(OUT) :: fshtr
-  REAL,DIMENSION(nbtr),INTENT(OUT)      :: hsoltr
-  REAL,DIMENSION(nbtr),INTENT(OUT)      :: tautr
-  REAL,DIMENSION(nbtr),INTENT(OUT)      :: vdeptr
-  REAL,DIMENSION(nbtr),INTENT(OUT)      :: scavtr
-  INTEGER                               :: i, it
-  REAL                                  :: s
-
-  CHARACTER (LEN=20) :: modname='initrrnpb'
-  CHARACTER (LEN=80) :: abort_message
-
-!
-! Radon it = id_rn
-!----------------
-  IF (id_rn /= 0) THEN
-     it = id_rn
-     s = 1.E4             ! Source: atome par m2
-     hsoltr(it) = 0.1     ! Hauteur equivalente du reservoir : 
-                          ! 1 m * porosite 0.1
-     tautr(it) = 4.765E5  ! Decroissance du radon, secondes
-     vdeptr(it) = 0.      ! Pas de depot sec pour le radon
-     scavtr(it) = 0.      ! Pas de lessivage pour le radon
-     
-     WRITE(*,*)'-------------- SOURCE DU RADON ------------------------ '
-     WRITE(*,*)'it = ',it
-     WRITE(*,*)'Source : ', s
-     WRITE(*,*)'Hauteur equivalente du reservoir de sol: ',hsoltr(it) 
-     WRITE(*,*)'Decroissance (s): ', tautr(it)
-     WRITE(*,*)'Vitesse de depot sec: ',vdeptr(it) 
-     WRITE(*,*)'Facteur de lessivage: ',scavtr(it)
-
-     DO i = 1,klon
-        masktr(i,it) = 0.
-        IF ( NINT(pctsrf(i,1)) .EQ. 1 ) masktr(i,it) = 1.
-        fshtr(i,it) = s * masktr(i,it)
-     END DO
-
-  END IF ! id_rn /= 0
-
-!
-! 210Pb it = id_pb
-!----------------
-  IF (id_pb /= 0) THEN
-     it = id_pb
-     s = 0.                ! Pas de source 
-     hsoltr(it) = 10.      ! Hauteur equivalente du reservoir 
-                           ! a partir duquel le depot Brownien a lieu
-     tautr(it) = 1.028E9   ! Decroissance du Pb210, secondes
-     vdeptr(it) = 1.E-3    ! 1 mm/s pour le 210Pb
-     scavtr(it) =  .5      ! Lessivage du Pb210
-     DO i = 1,klon
-        masktr(i,it) = 1.  ! Le depot sec peut avoir lieu partout
-        fshtr(i,it) = s * masktr(i,it)
-     END DO
-     WRITE(*,*)'-------------- SOURCE DU PLOMB ------------------------ '
-     WRITE(*,*)'it = ',it
-     WRITE(*,*)'Source : ', s
-     WRITE(*,*)'Hauteur equivalente du reservoir : ',hsoltr(it) 
-     WRITE(*,*)'Decroissance (s): ', tautr(it)
-     WRITE(*,*)'Vitesse de depot sec: ',vdeptr(it) 
-     WRITE(*,*)'Facteur de lessivage: ',scavtr(it)
-     
-  END IF
-     
-END SUBROUTINE initrrnpb
+link ../phylmd/initrrnpb.F90
Index: LMDZ6/trunk/libf/phylmdiso/interfoce_lim.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/interfoce_lim.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/interfoce_lim.F90	(revision 3940)
@@ -1,289 +1,1 @@
-!
-! $Header$
-!
-SUBROUTINE interfoce_lim(itime, dtime, jour, &
-     knon, knindex, &
-     debut,  &
-     lmt_sst_p, pctsrf_new_p)
-  
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-  USE indice_sol_mod
-  
-  IMPLICIT NONE
-  
-  INCLUDE "netcdf.inc"
-
-! Cette routine sert d'interface entre le modele atmospherique et un fichier
-! de conditions aux limites
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps courant
-!   dtime        pas de temps de la physique (en s)
-!   jour         jour a lire dans l'annee
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points dans le domaine a traiter
-!   knindex      index des points de la surface a traiter
-!   klon         taille de la grille
-!   debut        logical: 1er appel a la physique (initialisation)
-!
-! output:
-!   lmt_sst_p      SST lues dans le fichier de CL
-!   pctsrf_new-p   sous-maille fractionnelle
-!
-
-
-! Parametres d'entree
-!****************************************************************************************
-  INTEGER, INTENT(IN)                       :: itime
-  INTEGER, INTENT(IN)                       :: jour
-  INTEGER, INTENT(IN)                       :: knon
-  INTEGER, DIMENSION(klon_loc), INTENT(IN)  :: knindex
-  REAL   , INTENT(IN)                       :: dtime
-  LOGICAL, INTENT(IN)                       :: debut
-  
-! Parametres de sortie
-!****************************************************************************************
-  REAL, INTENT(OUT), DIMENSION(klon_loc)       :: lmt_sst_p
-  REAL, INTENT(OUT), DIMENSION(klon_loc,nbsrf) :: pctsrf_new_p
-
-
-! Variables locales avec l'attribut SAVE
-!****************************************************************************************
-! frequence de lecture des conditions limites (en pas de physique) 
-  INTEGER,SAVE                              :: lmt_pas   
-  !$OMP THREADPRIVATE(lmt_pas)
-! pour indiquer que le jour a lire est deja lu pour une surface precedente
-  LOGICAL,SAVE                              :: deja_lu   
-  !$OMP THREADPRIVATE(deja_lu)
-  INTEGER,SAVE                              :: jour_lu 
-  !$OMP THREADPRIVATE(jour_lu)
-  CHARACTER (len = 20),SAVE                 :: fich ='limit.nc'
-  !$OMP THREADPRIVATE(fich)
-  LOGICAL, SAVE                             :: newlmt = .TRUE.
-  !$OMP THREADPRIVATE(newlmt)
-  LOGICAL, SAVE                             :: check = .FALSE.
-  !$OMP THREADPRIVATE(check)
-  REAL, ALLOCATABLE , SAVE, DIMENSION(:)    :: sst_lu_p
-  !$OMP THREADPRIVATE(sst_lu_p)
-  REAL, ALLOCATABLE , SAVE, DIMENSION(:,:)  :: pct_tmp_p
-  !$OMP THREADPRIVATE(pct_tmp_p)
-
-! Variables locales 
-!****************************************************************************************
-  INTEGER                                   :: nid, nvarid
-  INTEGER                                   :: ii
-  INTEGER                                   :: ierr
-  INTEGER, DIMENSION(2)                     :: start, epais
-  CHARACTER (len = 20)                      :: modname = 'interfoce_lim'
-  CHARACTER (len = 80)                      :: abort_message
-  REAL, DIMENSION(klon_glo,nbsrf)           :: pctsrf_new
-  REAL, DIMENSION(klon_glo,nbsrf)           :: pct_tmp
-  REAL, DIMENSION(klon_glo)                 :: sst_lu
-  REAL, DIMENSION(klon_glo)                 :: nat_lu
-!
-! Fin declaration
-!****************************************************************************************
-
-!****************************************************************************************
-! Start calculation
-!
-!****************************************************************************************
-  IF (debut .AND. .NOT. ALLOCATED(sst_lu_p)) THEN
-     lmt_pas = NINT(86400./dtime * 1.0) ! pour une lecture une fois par jour
-     jour_lu = jour - 1
-     ALLOCATE(sst_lu_p(klon_loc))
-     ALLOCATE(pct_tmp_p(klon_loc,nbsrf))
-  ENDIF
-  
-  IF ((jour - jour_lu) /= 0) deja_lu = .FALSE.
-  
-  IF (check) WRITE(*,*) modname, ' :: jour, jour_lu, deja_lu', jour, jour_lu, deja_lu 
-  IF (check) WRITE(*,*) modname, ' :: itime, lmt_pas ', itime, lmt_pas,dtime
-
-!****************************************************************************************
-! Ouverture et lecture du fichier pour le master process si c'est le bon moment
-!
-!****************************************************************************************
-! Tester d'abord si c'est le moment de lire le fichier
-  IF (MOD(itime-1, lmt_pas) == 0 .AND. .NOT. deja_lu) THEN
-
-!$OMP MASTER
-     IF (is_mpi_root) THEN
-
-        fich = TRIM(fich)
-        ierr = NF_OPEN (fich, NF_NOWRITE,nid)
-        IF (ierr.NE.NF_NOERR) THEN
-           abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-
-        ! La tranche de donnees a lire:
-
-        start(1) = 1
-        start(2) = jour
-        epais(1) = klon_glo
-        epais(2) = 1
-
-        IF (newlmt) THEN
-           !
-           ! Fraction "ocean" 
-           !
-           ierr = NF_INQ_VARID(nid, 'FOCE', nvarid)
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Le champ <FOCE> est absent'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_oce))
-#else
-           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_oce))
-#endif
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Lecture echouee pour <FOCE>'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-           !
-           ! Fraction "glace de mer" 
-           !
-           ierr = NF_INQ_VARID(nid, 'FSIC', nvarid)
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Le champ <FSIC> est absent'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_sic))
-#else
-           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_sic))
-#endif
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Lecture echouee pour <FSIC>'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-           !
-           ! Fraction "terre" 
-           !
-           ierr = NF_INQ_VARID(nid, 'FTER', nvarid)
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Le champ <FTER> est absent'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_ter))
-#else
-           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_ter))
-#endif
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Lecture echouee pour <FTER>'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-           !
-           ! Fraction "glacier terre" 
-           !
-           ierr = NF_INQ_VARID(nid, 'FLIC', nvarid)
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Le champ <FLIC> est absent'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_lic))
-#else
-           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_lic))
-#endif
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Lecture echouee pour <FLIC>'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-           !
-        ELSE  ! on en est toujours a rnatur
-           ! 
-           ierr = NF_INQ_VARID(nid, 'NAT', nvarid)
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Le champ <NAT> est absent'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, nat_lu)
-#else
-           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, nat_lu)
-#endif
-           IF (ierr /= NF_NOERR) THEN
-              abort_message = 'Lecture echouee pour <NAT>'
-              CALL abort_physic(modname,abort_message,1)
-           ENDIF
-!
-! Remplissage des fractions de surface
-! nat = 0, 1, 2, 3 pour ocean, terre, glacier, seaice
-! 
-           pct_tmp = 0.0
-           DO ii = 1, klon_glo
-              pct_tmp(ii,NINT(nat_lu(ii)) + 1) = 1.
-           ENDDO
-
-!
-!  On se retrouve avec ocean en 1 et terre en 2 alors qu'on veut le contraire
-!
-           pctsrf_new = pct_tmp
-           pctsrf_new (:,2)= pct_tmp (:,1)
-           pctsrf_new (:,1)= pct_tmp (:,2)
-           pct_tmp = pctsrf_new 
-        ENDIF ! fin test sur newlmt
-!
-! Lecture SST
-!
-        ierr = NF_INQ_VARID(nid, 'SST', nvarid)
-        IF (ierr /= NF_NOERR) THEN
-           abort_message = 'Le champ <SST> est absent'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, sst_lu)
-#else
-        ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, sst_lu)
-#endif
-        IF (ierr /= NF_NOERR) THEN
-           abort_message = 'Lecture echouee pour <SST>'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-          
-!****************************************************************************************
-! Fin de lecture, fermeture de fichier
-!
-!****************************************************************************************
-        ierr = NF_CLOSE(nid)
-     ENDIF ! is_mpi_root
-
-!$OMP END MASTER
-!$OMP BARRIER
-
-
-!****************************************************************************************
-! Distribue les variables sur tous les processus
-!
-!****************************************************************************************
-     CALL Scatter(sst_lu,sst_lu_p)
-     CALL Scatter(pct_tmp(:,is_oce),pct_tmp_p(:,is_oce))
-     CALL Scatter(pct_tmp(:,is_sic),pct_tmp_p(:,is_sic))
-     deja_lu = .TRUE.
-     jour_lu = jour
-  ENDIF
-
-!****************************************************************************************
-! Recopie des variables dans les champs de sortie
-!
-!****************************************************************************************
-  lmt_sst_p = 999999999.
-  
-  DO ii = 1, knon
-     lmt_sst_p(ii) = sst_lu_p(knindex(ii))
-  ENDDO
-  
-  DO ii=1,klon_loc
-     pctsrf_new_p(ii,is_oce)=pct_tmp_p(ii,is_oce)
-     pctsrf_new_p(ii,is_sic)=pct_tmp_p(ii,is_sic)
-  ENDDO
-  
-  
-END SUBROUTINE interfoce_lim
+link ../phylmd/interfoce_lim.F90
Index: LMDZ6/trunk/libf/phylmdiso/iophy.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iophy.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iophy.F90	(revision 3940)
@@ -1,1545 +1,1 @@
-!
-! $Id: iophy.F90 3488 2019-04-26 11:41:36Z fairhead $
-!
-MODULE iophy
-
-! abd  REAL,private,allocatable,DIMENSION(:),save :: io_lat
-! abd  REAL,private,allocatable,DIMENSION(:),save :: io_lon
-  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat
-  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon
-  INTEGER, SAVE :: phys_domain_id
-  INTEGER, SAVE :: npstn
-  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij
-  INTEGER, SAVE :: itau_iophy
-  LOGICAL :: check_dim = .false.
-
-!$OMP THREADPRIVATE(itau_iophy)
-
-#ifdef CPP_XIOS
-  INTERFACE histwrite_phy
-    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios
-  END INTERFACE
-#else
-  INTERFACE histwrite_phy
-    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old
-  END INTERFACE
-#endif
-
-  INTERFACE histbeg_phy_all
-    MODULE PROCEDURE histbeg_phy,histbeg_phyxios,histbeg_phy_points
-  END INTERFACE
-
-
-CONTAINS
-
-! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
-  SUBROUTINE set_itau_iophy(ito)
-    IMPLICIT NONE
-    INTEGER, INTENT(IN) :: ito
-    itau_iophy = ito
-  END SUBROUTINE
-
-  SUBROUTINE init_iophy_new(rlat,rlon)
-
-    USE dimphy, ONLY: klon
-    USE mod_phys_lmdz_para, ONLY: gather, bcast, &
-                                  jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
-                                  mpi_size, mpi_rank, klon_mpi, &
-                                is_sequential, is_south_pole_dyn
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
-  USE print_control_mod, ONLY: prt_level,lunout 
-#ifdef CPP_IOIPSL
-    USE ioipsl, ONLY: flio_dom_set
-#endif
-#ifdef CPP_XIOS
-  use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init
-#endif
-    IMPLICIT NONE
-    REAL,DIMENSION(klon),INTENT(IN) :: rlon
-    REAL,DIMENSION(klon),INTENT(IN) :: rlat
-
-    REAL,DIMENSION(klon_glo)        :: rlat_glo
-    REAL,DIMENSION(klon_glo)        :: rlon_glo
-    
-    INTEGER,DIMENSION(2) :: ddid
-    INTEGER,DIMENSION(2) :: dsg
-    INTEGER,DIMENSION(2) :: dsl
-    INTEGER,DIMENSION(2) :: dpf
-    INTEGER,DIMENSION(2) :: dpl
-    INTEGER,DIMENSION(2) :: dhs
-    INTEGER,DIMENSION(2) :: dhe 
-    INTEGER :: i    
-    INTEGER :: data_ibegin, data_iend
-
-#ifdef CPP_XIOS
-      CALL wxios_context_init
-#endif
-    
-
-    IF (grid_type==unstructured) THEN
-    
-#ifdef CPP_XIOS
-      CALL wxios_domain_param_unstructured("dom_glo")
-#endif
-
-    ELSE
-
-      CALL gather(rlat,rlat_glo)
-      CALL bcast(rlat_glo)
-      CALL gather(rlon,rlon_glo)
-      CALL bcast(rlon_glo)
-    
-!$OMP MASTER  
-    ALLOCATE(io_lat(nbp_lat))
-    IF (klon_glo == 1) THEN
-      io_lat(1)=rlat_glo(1)
-    ELSE
-      io_lat(1)=rlat_glo(1)
-      io_lat(nbp_lat)=rlat_glo(klon_glo)
-      DO i=2,nbp_lat-1
-        io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
-      ENDDO
-    ENDIF
-
-    ALLOCATE(io_lon(nbp_lon))
-    IF (klon_glo == 1) THEN
-      io_lon(1)=rlon_glo(1)
-    ELSE 
-      io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
-    ENDIF
-
-!! (I) dtnb   : total number of domains
-!! (I) dnb    : domain number
-!! (I) did(:) : distributed dimensions identifiers
-!!              (up to 5 dimensions are supported)
-!! (I) dsg(:) : total number of points for each dimension
-!! (I) dsl(:) : local number of points for each dimension
-!! (I) dpf(:) : position of first local point for each dimension
-!! (I) dpl(:) : position of last local point for each dimension
-!! (I) dhs(:) : start halo size for each dimension
-!! (I) dhe(:) : end halo size for each dimension
-!! (C) cdnm   : Model domain definition name.
-!!              The names actually supported are :
-!!              "BOX", "APPLE", "ORANGE".
-!!              These names are case insensitive.
-
-    ddid=(/ 1,2 /)
-    dsg=(/ nbp_lon, nbp_lat /)
-    dsl=(/ nbp_lon, jj_nb /)
-    dpf=(/ 1,jj_begin /)
-    dpl=(/ nbp_lon, jj_end /)
-    dhs=(/ ii_begin-1,0 /)
-    IF (mpi_rank==mpi_size-1) THEN
-      dhe=(/0,0/)
-    ELSE
-      dhe=(/ nbp_lon-ii_end,0 /)  
-    ENDIF
-
-#ifndef CPP_IOIPSL_NO_OUTPUT    
-    CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
-                      'APPLE',phys_domain_id)
-#endif
-#ifdef CPP_XIOS
-      ! Set values for the mask:
-      IF (mpi_rank == 0) THEN
-          data_ibegin = 0
-      ELSE 
-          data_ibegin = ii_begin - 1
-      END IF
-
-      IF (mpi_rank == mpi_size-1) THEN
-          data_iend = nbp_lon
-      ELSE
-          data_iend = ii_end + 1
-      END IF
-
-      IF (prt_level>=10) THEN
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn
-      ENDIF
-
-      ! Initialize the XIOS domain coreesponding to this process:
-#endif
-!$OMP END MASTER
-
-#ifdef CPP_XIOS    
-        CALL wxios_domain_param("dom_glo")
-#endif
-      
-    ENDIF
-      
-  END SUBROUTINE init_iophy_new
-
-
-  SUBROUTINE init_iophy(lat,lon)
-
-    USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
-                                  mpi_size, mpi_rank 
-    USE ioipsl, ONLY: flio_dom_set
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-    IMPLICIT NONE
-
-    REAL,DIMENSION(nbp_lon),INTENT(IN) :: lon
-    REAL,DIMENSION(nbp_lat),INTENT(IN) :: lat
-
-    INTEGER,DIMENSION(2) :: ddid
-    INTEGER,DIMENSION(2) :: dsg
-    INTEGER,DIMENSION(2) :: dsl
-    INTEGER,DIMENSION(2) :: dpf
-    INTEGER,DIMENSION(2) :: dpl
-    INTEGER,DIMENSION(2) :: dhs
-    INTEGER,DIMENSION(2) :: dhe 
-
-!$OMP MASTER  
-    ALLOCATE(io_lat(nbp_lat))
-    io_lat(:)=lat(:)
-    ALLOCATE(io_lon(nbp_lon))
-    io_lon(:)=lon(:)
-   
-    ddid=(/ 1,2 /)
-    dsg=(/ nbp_lon, nbp_lat /)
-    dsl=(/ nbp_lon, jj_nb /)
-    dpf=(/ 1,jj_begin /)
-    dpl=(/ nbp_lon, jj_end /)
-    dhs=(/ ii_begin-1,0 /)
-    IF (mpi_rank==mpi_size-1) THEN
-      dhe=(/0,0/)
-    ELSE
-      dhe=(/ nbp_lon-ii_end,0 /)  
-    ENDIF
-    
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-    call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
-                      'APPLE',phys_domain_id)
-#endif
-!$OMP END MASTER
-      
-  END SUBROUTINE init_iophy
-
- SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
-!  USE dimphy
-  USE mod_phys_lmdz_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, &
-                                jj_begin, jj_end, jj_nb
-  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-  USE ioipsl, ONLY: histbeg
-#ifdef CPP_XIOS
-  USE wxios, ONLY: wxios_add_file
-#endif
-  IMPLICIT NONE
-  INCLUDE 'clesphys.h'
-    
-  CHARACTER*(*), INTENT(IN) :: name
-  INTEGER, INTENT(IN) :: itau0
-  REAL,INTENT(IN) :: zjulian
-  REAL,INTENT(IN) :: dtime
-  CHARACTER(LEN=*), INTENT(IN) :: ffreq
-  INTEGER,INTENT(IN) :: lev
-  INTEGER,INTENT(OUT) :: nhori
-  INTEGER,INTENT(OUT) :: nid_day
-
-!$OMP MASTER    
-  IF (is_sequential) THEN
-    CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
-                 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
-  ELSE
-    CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
-                 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
-  ENDIF
-
-#ifdef CPP_XIOS
-  ! ug OMP en chantier...
-  IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
-      ! ug Création du fichier
-    IF (.not. ok_all_xml) THEN
-      CALL wxios_add_file(name, ffreq, lev)
-    ENDIF
-  ENDIF
-#endif
-!$OMP END MASTER
-  
-  END SUBROUTINE histbeg_phyxios
-  
-  SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
-
-  USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential
-  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-  USE ioipsl, ONLY: histbeg
-
-  IMPLICIT NONE
-    
-    CHARACTER*(*), INTENT(IN) :: name
-    INTEGER, INTENT(IN) :: itau0
-    REAL,INTENT(IN) :: zjulian
-    REAL,INTENT(IN) :: dtime
-    INTEGER,INTENT(OUT) :: nhori
-    INTEGER,INTENT(OUT) :: nid_day
-
-!$OMP MASTER    
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-    IF (is_sequential) THEN
-      CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
-                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
-    ELSE
-      CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
-                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
-    ENDIF
-#endif
-!$OMP END MASTER
-  
-  END SUBROUTINE histbeg_phy
-
-
-  SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &
-             plon,plat,plon_bounds,plat_bounds, &
-             nname,itau0,zjulian,dtime,nnhori,nnid_day)
-  USE dimphy, ONLY: klon
-  USE mod_phys_lmdz_para, ONLY: gather, bcast, &
-                                is_sequential, klon_mpi_begin, klon_mpi_end, &
-                                mpi_rank
-  USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo
-  USE ioipsl, ONLY: histbeg
-
-  IMPLICIT NONE
-
-    REAL,DIMENSION(klon),INTENT(IN) :: rlon
-    REAL,DIMENSION(klon),INTENT(IN) :: rlat
-    INTEGER, INTENT(IN) :: itau0
-    REAL,INTENT(IN) :: zjulian
-    REAL,INTENT(IN) :: dtime
-    INTEGER, INTENT(IN) :: pim
-    INTEGER, intent(out) :: nnhori
-    CHARACTER(len=20), INTENT(IN) :: nname
-    INTEGER, INTENT(OUT) :: nnid_day
-    INTEGER :: i
-    REAL,DIMENSION(klon_glo)        :: rlat_glo
-    REAL,DIMENSION(klon_glo)        :: rlon_glo
-    INTEGER, DIMENSION(pim), INTENT(IN)  :: tabij
-    REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
-    INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
-    REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds
-
-    INTEGER, SAVE :: tabprocbeg, tabprocend
-!$OMP THREADPRIVATE(tabprocbeg, tabprocend)
-    INTEGER :: ip
-    INTEGER, PARAMETER :: nip=1
-    INTEGER :: npproc
-    REAL, allocatable, DIMENSION(:) :: npplat, npplon
-    REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds
-    REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat
-
-    CALL gather(rlat,rlat_glo)
-    CALL bcast(rlat_glo)
-    CALL gather(rlon,rlon_glo)
-    CALL bcast(rlon_glo)
-
-!$OMP MASTER
-    DO i=1,pim
-
-!    print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
-
-     plon_bounds(i,1)=rlon_glo(tabij(i)-1)
-     plon_bounds(i,2)=rlon_glo(tabij(i)+1)
-     IF (plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
-      IF (rlon_glo(tabij(i)).GE.0.) THEN
-       plon_bounds(i,2)=-1*plon_bounds(i,2)
-      ENDIF
-     ENDIF
-     IF (plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
-      IF (rlon_glo(tabij(i)).LE.0.) THEN
-       plon_bounds(i,2)=-1*plon_bounds(i,2)
-      ENDIF
-     ENDIF
-!
-     IF ( tabij(i).LE.nbp_lon) THEN
-      plat_bounds(i,1)=rlat_glo(tabij(i))
-     ELSE
-      plat_bounds(i,1)=rlat_glo(tabij(i)-nbp_lon)
-     ENDIF
-     plat_bounds(i,2)=rlat_glo(tabij(i)+nbp_lon)
-!
-!    print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon_glo(tabij(i)),plon_bounds(i,2) 
-!    print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat_glo(tabij(i)),plat_bounds(i,2) 
-!
-    ENDDO
-    if (is_sequential) then
-
-     npstn=pim
-     IF(.NOT. ALLOCATED(nptabij)) THEN
-      ALLOCATE(nptabij(pim))
-     ENDIF 
-     DO i=1,pim
-      nptabij(i)=tabij(i)
-     ENDDO
-
-       CALL grid1dTo2d_glo(rlon_glo,zx_lon)
-       IF ((nbp_lon*nbp_lat).GT.1) THEN
-       DO i = 1, nbp_lon
-         zx_lon(i,1) = rlon_glo(i+1)
-         zx_lon(i,nbp_lat) = rlon_glo(i+1)
-       ENDDO
-       ENDIF
-       CALL grid1dTo2d_glo(rlat_glo,zx_lat)
-
-    DO i=1,pim
-!    print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
-
-     plon_bounds(i,1)=zx_lon(ipt(i)-1,jpt(i))
-     plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i))
-
-     IF (ipt(i).EQ.1) THEN
-      plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i))
-      plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i))
-     ENDIF
- 
-     IF (ipt(i).EQ.nbp_lon) THEN
-      plon_bounds(i,2)=360.+zx_lon(1,jpt(i))
-     ENDIF
-
-     plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1)
-     plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1)
-
-     IF (jpt(i).EQ.1) THEN
-      plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001
-      plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001
-     ENDIF
- 
-     IF (jpt(i).EQ.nbp_lat) THEN
-      plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001
-      plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001
-     ENDIF
-!
-!    print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2) 
-!    print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat(tabij(i)),plat_bounds(i,2) 
-!
-    ENDDO
-
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-     CALL histbeg(nname,pim,plon,plon_bounds, & 
-                           plat,plat_bounds, &
-                           itau0, zjulian, dtime, nnhori, nnid_day)
-#endif
-    ELSE
-     npproc=0
-     DO ip=1, pim
-      tabprocbeg=klon_mpi_begin
-      tabprocend=klon_mpi_end
-      IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
-       npproc=npproc+1
-       npstn=npproc
-      ENDIF 
-     ENDDO
-!    print*,'CFMIP_iophy mpi_rank npstn',mpi_rank,npstn
-     IF(.NOT. ALLOCATED(nptabij)) THEN
-      ALLOCATE(nptabij(npstn))
-      ALLOCATE(npplon(npstn), npplat(npstn))
-      ALLOCATE(npplon_bounds(npstn,2), npplat_bounds(npstn,2))
-     ENDIF
-     npproc=0
-     DO ip=1, pim
-      IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
-       npproc=npproc+1
-       nptabij(npproc)=tabij(ip)
-!      print*,'mpi_rank npproc ip plon plat tabij=',mpi_rank,npproc,ip, &
-!      plon(ip),plat(ip),tabij(ip)
-       npplon(npproc)=plon(ip)
-       npplat(npproc)=plat(ip)
-       npplon_bounds(npproc,1)=plon_bounds(ip,1)
-       npplon_bounds(npproc,2)=plon_bounds(ip,2)
-       npplat_bounds(npproc,1)=plat_bounds(ip,1)
-       npplat_bounds(npproc,2)=plat_bounds(ip,2)
-!!!
-!!! print qui sert a reordonner les points stations selon l'ordre CFMIP
-!!! ne pas enlever
-        print*,'iophy_mpi rank ip lon lat',mpi_rank,ip,plon(ip),plat(ip)
-!!!
-      ENDIF
-     ENDDO
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-     CALL histbeg(nname,npstn,npplon,npplon_bounds, &
-                            npplat,npplat_bounds, &
-                            itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
-#endif
-    ENDIF
-!$OMP END MASTER
-
-  END SUBROUTINE histbeg_phy_points
-
-
-  SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
-
-    USE ioipsl, ONLY: histdef
-    USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
-    USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, &
-                                   nid_files, nhorim, swaero_diag, dryaod_diag, nfiles, &
-                                   ok_4xCO2atm
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-    USE aero_mod, ONLY : naero_tot, name_aero_tau
-    USE print_control_mod, ONLY: prt_level,lunout
-
-    IMPLICIT NONE
-
-    INCLUDE "clesphys.h"
-
-    INTEGER                          :: iff
-    INTEGER                          :: naero
-    LOGICAL                          :: lpoint
-    INTEGER, DIMENSION(nfiles)       :: flag_var
-    CHARACTER(LEN=20)                :: nomvar
-    CHARACTER(LEN=*)                 :: titrevar
-    CHARACTER(LEN=*)                 :: unitvar
-
-    REAL zstophym
-
-    IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
-       zstophym=zoutm(iff)
-    ELSE
-       zstophym=zdtime_moy
-    ENDIF
-    IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d_old for ', nomvar
-    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
-    CALL conf_physoutputs(nomvar,flag_var)
-
-    IF(.NOT.lpoint) THEN  
-       IF ( flag_var(iff)<=lev_files(iff) ) THEN
-          CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
-               nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
-               type_ecri(iff), zstophym,zoutm(iff))                
-       ENDIF
-    ELSE
-       IF ( flag_var(iff)<=lev_files(iff) ) THEN
-          CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
-               npstn,1,nhorim(iff), 1,1,1, -99, 32, &
-               type_ecri(iff), zstophym,zoutm(iff))                
-       ENDIF
-    ENDIF
-
-    ! Set swaero_diag=true if at least one of the concerned variables are defined 
-    IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. & 
-        nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. & 
-        nomvar=='topswai' .OR. nomvar=='solswai' ) THEN 
-       IF  ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
-    ENDIF
-
-    ! Set dryaod_diag=true if at least one of the concerned variables are defined 
-    IF (nomvar=='dryod550aer') THEN
-      IF  ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
-    ENDIF
-    DO naero = 1, naero_tot-1
-      IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN
-        IF  ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
-      ENDIF
-    ENDDO
-
-    ! Set ok_4xCO2atm=true if at least one of the concerned variables are
-    ! defined
-    IF (nomvar=='rsut4co2'.OR.nomvar=='rlut4co2'.OR.nomvar=='rsutcs4co2' & 
-        .OR. nomvar=='rlutcs4co2'.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2' &
-        .OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2'.OR.nomvar=='rsd4co2'.OR. &
-        nomvar=='rsdcs4co2'.OR.nomvar=='rlu4co2'.OR.nomvar=='rlucs4co2'.OR.&
-        nomvar=='rld4co2'.OR.nomvar=='rldcs4co2') THEN
-        IF ( flag_var(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
-    ENDIF 
-  END SUBROUTINE histdef2d_old
-
-  SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
-
-    USE ioipsl, ONLY: histdef
-    USE dimphy, ONLY: klev
-    USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
-    USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
-                                   nhorim, zdtime_moy, levmin, levmax, &
-                                   nvertm, nfiles
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-    USE print_control_mod, ONLY: prt_level,lunout
-    IMPLICIT NONE
-
-    INCLUDE "clesphys.h"
-
-    INTEGER                          :: iff
-    LOGICAL                          :: lpoint
-    INTEGER, DIMENSION(nfiles)       :: flag_var
-    CHARACTER(LEN=20)                 :: nomvar
-    CHARACTER(LEN=*)                 :: titrevar
-    CHARACTER(LEN=*)                 :: unitvar
-
-    REAL zstophym
-
-    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
-    CALL conf_physoutputs(nomvar,flag_var)
-
-    IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d_old for ', nomvar
-
-    IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
-       zstophym=zoutm(iff)
-    ELSE
-       zstophym=zdtime_moy
-    ENDIF
-
-    IF(.NOT.lpoint) THEN
-       IF ( flag_var(iff)<=lev_files(iff) ) THEN
-          CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
-               nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
-               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), &
-               zstophym, zoutm(iff))
-       ENDIF
-    ELSE
-       IF ( flag_var(iff)<=lev_files(iff) ) THEN
-          CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
-               npstn,1,nhorim(iff), klev, levmin(iff), &
-               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
-               type_ecri(iff), zstophym,zoutm(iff))
-       ENDIF
-    ENDIF
-  END SUBROUTINE histdef3d_old
-
-  SUBROUTINE histdef2d (iff,var)
-
-    USE ioipsl, ONLY: histdef
-    USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
-    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
-                                   clef_stations, phys_out_filenames, lev_files, &
-                                   nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag,&
-                                   ok_4xCO2atm 
-    USE print_control_mod, ONLY: prt_level,lunout 
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-    USE aero_mod, ONLY : naero_tot, name_aero_tau
-#ifdef CPP_XIOS
-    USE wxios, ONLY: wxios_add_field_to_file
-#endif
-    USE print_control_mod, ONLY: prt_level,lunout
-    IMPLICIT NONE
-
-    INCLUDE "clesphys.h"
-
-    INTEGER                          :: iff
-    INTEGER                          :: naero
-    TYPE(ctrl_out)                   :: var
-
-    REAL zstophym
-    CHARACTER(LEN=20) :: typeecrit
-
-    IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d for ', var%name
-
-    ! ug On récupère le type écrit de la structure:
-    !       Assez moche, à refaire si meilleure méthode...
-    IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
-       typeecrit = 'once'
-    ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
-       typeecrit = 't_min(X)'
-    ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
-       typeecrit = 't_max(X)'
-    ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
-       typeecrit = 'inst(X)'
-    ELSE
-       typeecrit = type_ecri_files(iff)
-    ENDIF
-
-    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
-       zstophym=zoutm(iff)
-    ELSE
-       zstophym=zdtime_moy
-    ENDIF
-
-    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
-    CALL conf_physoutputs(var%name, var%flag)
-
-    IF(.NOT.clef_stations(iff)) THEN  
-
-#ifdef CPP_XIOS
-      IF (.not. ok_all_xml) THEN
-        IF ( var%flag(iff)<=lev_files(iff) ) THEN
-          CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
-          var%description, var%unit, var%flag(iff), typeecrit)
-          IF (prt_level >= 10) THEN
-            WRITE(lunout,*) 'histdef2d: call wxios_add_field_to_file var%name iff: ', &
-                            trim(var%name),iff
-          ENDIF
-        ENDIF
-      ENDIF
-#endif
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-
-       IF ( var%flag(iff)<=lev_files(iff) ) THEN
-          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
-               nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
-               typeecrit, zstophym,zoutm(iff))                
-       ENDIF
-    ELSE
-       IF ( var%flag(iff)<=lev_files(iff)) THEN
-          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
-               npstn,1,nhorim(iff), 1,1,1, -99, 32, &
-               typeecrit, zstophym,zoutm(iff))                
-       ENDIF
-#endif
-    ENDIF
-
-    ! Set swaero_diag=true if at least one of the concerned variables are defined
-    !--OB 30/05/2016 use wider set of variables
-    IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. &
-         var%name=='topswai' .OR. var%name=='solswai'  .OR. ( iflag_rrtm==1 .AND. (                            &
-         var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. &
-         var%name=='toplwai' .OR. var%name=='sollwai'  ) ) ) THEN
-       IF  ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
-    ENDIF
-
-    ! Set swaerofree_diag=true if at least one of the concerned variables are defined 
-    IF (var%name=='SWupTOAcleanclr' .OR. var%name=='SWupSFCcleanclr' .OR. var%name=='SWdnSFCcleanclr' .OR. & 
-        var%name=='LWupTOAcleanclr' .OR. var%name=='LWdnSFCcleanclr' ) THEN
-       IF  ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
-    ENDIF
-
-    ! set dryaod_dry=true if at least one of the concerned variables are defined
-    IF (var%name=='dryod550aer') THEN 
-      IF  ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
-    ENDIF
-    !
-    DO naero = 1, naero_tot-1 
-      IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN
-        IF  ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
-      ENDIF
-    ENDDO
-    ! Set ok_4xCO2atm=true if at least one of the concerned variables are
-    ! defined
-    IF (var%name=='rsut4co2'.OR.var%name=='rlut4co2'.OR.var%name=='rsutcs4co2' & 
-        .OR. var%name=='rlutcs4co2'.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2' &
-        .OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2'.OR.var%name=='rsd4co2'.OR. &
-        var%name=='rsdcs4co2'.OR.var%name=='rlu4co2'.OR.var%name=='rlucs4co2'.OR.&
-        var%name=='rld4co2'.OR.var%name=='rldcs4co2') THEN
-        IF ( var%flag(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
-    ENDIF 
-  END SUBROUTINE histdef2d
-
-  SUBROUTINE histdef3d (iff,var)
-
-    USE ioipsl, ONLY: histdef
-    USE dimphy, ONLY: klev
-    USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
-    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
-                                   clef_stations, phys_out_filenames, lev_files, &
-                                   nid_files, nhorim, swaerofree_diag, levmin, &
-                                   levmax, nvertm
-    USE print_control_mod, ONLY: prt_level,lunout
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-#ifdef CPP_XIOS
-    USE wxios, ONLY: wxios_add_field_to_file
-#endif
-    USE print_control_mod, ONLY: prt_level,lunout
-    IMPLICIT NONE
-
-    INCLUDE "clesphys.h"
-
-    INTEGER                          :: iff
-    TYPE(ctrl_out)                   :: var
-
-    REAL zstophym
-    CHARACTER(LEN=20) :: typeecrit
-
-    IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d for ', var%name
-
-    ! ug On récupère le type écrit de la structure:
-    !       Assez moche, à refaire si meilleure méthode...
-    IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
-       typeecrit = 'once'
-    ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
-       typeecrit = 't_min(X)'
-    ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
-       typeecrit = 't_max(X)'
-    ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
-       typeecrit = 'inst(X)'
-    ELSE
-       typeecrit = type_ecri_files(iff)
-    ENDIF
-
-    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
-    CALL conf_physoutputs(var%name,var%flag)
-
-    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
-       zstophym=zoutm(iff)
-    ELSE
-       zstophym=zdtime_moy
-    ENDIF
-
-    IF(.NOT.clef_stations(iff)) THEN
-
-#ifdef CPP_XIOS
-       IF (.not. ok_all_xml) THEN
-         IF ( var%flag(iff)<=lev_files(iff) ) THEN
-         CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
-         var%description, var%unit, var%flag(iff), typeecrit)
-           IF (prt_level >= 10) THEN
-             WRITE(lunout,*) 'histdef3d: call wxios_add_field_to_file var%name iff: ', &
-                             trim(var%name),iff
-           ENDIF
-         ENDIF
-       ENDIF
-#endif
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-
-       IF ( var%flag(iff)<=lev_files(iff) ) THEN
-          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
-               nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
-               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, &
-               zstophym, zoutm(iff))
-       ENDIF
-    ELSE
-       IF ( var%flag(iff)<=lev_files(iff)) THEN
-          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
-               npstn,1,nhorim(iff), klev, levmin(iff), &
-               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
-               typeecrit, zstophym,zoutm(iff))
-       ENDIF
-#endif
-    ENDIF
-
-    ! Set swaerofree_diag=true if at least one of the concerned variables are defined 
-    IF (var%name=='rsucsaf' .OR. var%name=='rsdcsaf') THEN
-       IF  ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
-    ENDIF
-
-  END SUBROUTINE histdef3d
-
-  SUBROUTINE conf_physoutputs(nam_var,flag_var)
-!!! Lecture des noms et niveau de sortie des variables dans output.def
-    !   en utilisant les routines getin de IOIPSL  
-    USE ioipsl, ONLY: getin
-    USE phys_output_var_mod, ONLY: nfiles
-    USE print_control_mod, ONLY: prt_level,lunout
-    IMPLICIT NONE
-
-    CHARACTER(LEN=20)                :: nam_var
-    INTEGER, DIMENSION(nfiles)      :: flag_var
-
-    IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
-    CALL getin('flag_'//nam_var,flag_var)
-    CALL getin('name_'//nam_var,nam_var)
-    IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
-
-  END SUBROUTINE conf_physoutputs
-
- 
-  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
-
-    USE dimphy, ONLY: klon
-    USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
-                                  is_sequential, klon_mpi_begin, klon_mpi_end, &
-                                  jj_nb, klon_mpi, is_master
-    USE ioipsl, ONLY: histwrite
-    USE print_control_mod, ONLY: prt_level,lunout
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: nid
-    LOGICAL,INTENT(IN) :: lpoint 
-    CHARACTER*(*), INTENT(IN) :: name
-    INTEGER, INTENT(IN) :: itau
-    REAL,DIMENSION(:),INTENT(IN) :: field
-    REAL,DIMENSION(klon_mpi) :: buffer_omp
-    INTEGER, allocatable, DIMENSION(:) :: index2d
-    REAL :: Field2d(nbp_lon,jj_nb)
-
-    INTEGER :: ip
-    REAL,ALLOCATABLE,DIMENSION(:) :: fieldok
-
-    IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
-    IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy_old for ', name
-
-    CALL Gather_omp(field,buffer_omp)    
-!$OMP MASTER
-    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
-    IF (.NOT.lpoint) THEN
-     ALLOCATE(index2d(nbp_lon*jj_nb))
-     ALLOCATE(fieldok(nbp_lon*jj_nb))
-     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
-     CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
-     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
-    ELSE
-     ALLOCATE(fieldok(npstn))
-     ALLOCATE(index2d(npstn))
-
-     IF (is_sequential) THEN
-!     klon_mpi_begin=1
-!     klon_mpi_end=klon
-      DO ip=1, npstn
-       fieldok(ip)=buffer_omp(nptabij(ip))
-      ENDDO
-     ELSE
-      DO ip=1, npstn
-!     print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
-       IF(nptabij(ip).GE.klon_mpi_begin.AND. &
-          nptabij(ip).LE.klon_mpi_end) THEN
-         fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
-       ENDIF
-      ENDDO
-     ENDIF
-     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
-     CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
-     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
-!
-    ENDIF
-    DEALLOCATE(index2d)
-    DEALLOCATE(fieldok)
-!$OMP END MASTER   
-
- 
-  END SUBROUTINE histwrite2d_phy_old
-
-  SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
-
-    USE dimphy, ONLY: klon
-    USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
-                                  is_sequential, klon_mpi_begin, klon_mpi_end, &
-                                  jj_nb, klon_mpi, is_master
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-    USE ioipsl, ONLY: histwrite
-    USE print_control_mod, ONLY: prt_level,lunout
-
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: nid
-    LOGICAL,INTENT(IN) :: lpoint
-    CHARACTER*(*), INTENT(IN) :: name
-    INTEGER, INTENT(IN) :: itau
-    REAL,DIMENSION(:,:),INTENT(IN) :: field  ! --> field(klon,:)
-    REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
-    REAL :: Field3d(nbp_lon,jj_nb,size(field,2))
-    INTEGER :: ip, n, nlev
-    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
-    REAL,allocatable, DIMENSION(:,:) :: fieldok
-
-    IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name
-
-    IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
-    nlev=size(field,2)
-
-    CALL Gather_omp(field,buffer_omp)
-!$OMP MASTER
-    CALL grid1Dto2D_mpi(buffer_omp,field3d)
-    IF (.NOT.lpoint) THEN
-      ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
-      ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
-      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
-      CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
-      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
-    ELSE
-      nlev=size(field,2)
-      ALLOCATE(index3d(npstn*nlev))
-      ALLOCATE(fieldok(npstn,nlev))
-
-      IF (is_sequential) THEN
-!       klon_mpi_begin=1
-!       klon_mpi_end=klon
-        DO n=1, nlev
-        DO ip=1, npstn
-          fieldok(ip,n)=buffer_omp(nptabij(ip),n)
-        ENDDO
-        ENDDO
-      ELSE
-        DO n=1, nlev
-        DO ip=1, npstn
-          IF(nptabij(ip).GE.klon_mpi_begin.AND. &
-           nptabij(ip).LE.klon_mpi_end) THEN
-           fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
-          ENDIF
-        ENDDO
-        ENDDO
-      ENDIF
-      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
-      CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
-      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
-    ENDIF 
-    DEALLOCATE(index3d)
-    DEALLOCATE(fieldok)
-!$OMP END MASTER    
-
-  END SUBROUTINE histwrite3d_phy_old
-
-
-! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
-  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
-
-  USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
-  USE dimphy, ONLY: klon, klev
-  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
-                                jj_nb, klon_mpi, klon_mpi_begin, &
-                                klon_mpi_end, is_sequential, is_master
-  USE ioipsl, ONLY: histwrite
-  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
-                                 nfiles, vars_defined, clef_stations, &
-                                 nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
-  USE print_control_mod, ONLY: prt_level,lunout
-  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
-#ifdef CPP_XIOS
-  USE xios, ONLY: xios_send_field
-#endif
-  USE print_control_mod, ONLY: lunout, prt_level
-
-  IMPLICIT NONE
-  INCLUDE 'clesphys.h'
-
-  TYPE(ctrl_out), INTENT(IN) :: var
-  REAL, DIMENSION(:), INTENT(IN) :: field
-  INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
-      
-  INTEGER :: iff, iff_beg, iff_end
-  LOGICAL, SAVE  :: firstx
-!$OMP THREADPRIVATE(firstx)
-
-  REAL,DIMENSION(klon_mpi) :: buffer_omp
-  INTEGER, allocatable, DIMENSION(:) :: index2d
-  REAL :: Field2d(nbp_lon,jj_nb)
-
-  INTEGER :: ip
-  REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
-
-  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
-
-  IF (prt_level >= 10) THEN
-    WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
-  ENDIF
-
-! ug RUSTINE POUR LES STD LEVS.....
-  IF (PRESENT(STD_iff)) THEN
-        iff_beg = STD_iff
-        iff_end = STD_iff
-  ELSE
-        iff_beg = 1
-        iff_end = nfiles
-  ENDIF
-
-  ! On regarde si on est dans la phase de définition ou d'écriture:
-  IF (.NOT.vars_defined) THEN
-!$OMP MASTER
-      !Si phase de définition.... on définit
-      IF (.not. ok_all_xml) THEN
-      IF (prt_level >= 10) THEN
-      write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
-                     trim(var%name)
-      ENDIF
-      DO iff=iff_beg, iff_end
-         IF (clef_files(iff)) THEN
-            CALL histdef2d(iff, var)
-         ENDIF
-      ENDDO
-      ENDIF
-!$OMP END MASTER
-!--broadcasting the flags that have been changed in histdef2d on OMP masters
-      CALL bcast_omp(swaero_diag)
-      CALL bcast_omp(swaerofree_diag)
-      CALL bcast_omp(dryaod_diag)
-      CALL bcast_omp(ok_4xCO2atm)
-
-  ELSE
-
-    !Et sinon on.... écrit
-    IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon/klev',1)    
-    IF (prt_level >= 10) THEn
-      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
-    ENDIF
-    
-    
-    IF (SIZE(field) == klon) then
-        CALL Gather_omp(field,buffer_omp)
-    ELSE
-        buffer_omp(:)=0.
-    ENDIF
-!$OMP MASTER
-    IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d)
-
-! La boucle sur les fichiers:
-      firstx=.true.
-
-      IF (ok_all_xml) THEN
-#ifdef CPP_XIOS
-          IF (prt_level >= 10) THEN
-             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
-          ENDIF
-          
-          IF (grid_type==regular_lonlat) THEN
-            IF (SIZE(field) == klon) then
-              CALL xios_send_field(var%name, Field2d)
-            ELSE
-               CALL xios_send_field(var%name, field)
-            ENDIF 
-          ELSE IF (grid_type==unstructured) THEN
-            IF (SIZE(field) == klon) then
-              CALL xios_send_field(var%name, buffer_omp)
-            ELSE
-               CALL xios_send_field(var%name, field)
-            ENDIF
-
-          ENDIF
-          IF (prt_level >= 10) THEN
-             write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
-                             trim(var%name)                       
-          ENDIF
-#else
-        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
-#endif
-      ELSE  
-        DO iff=iff_beg, iff_end
-            IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN 
-
-#ifdef CPP_XIOS
-               IF (firstx) THEN
-                  IF (prt_level >= 10) THEN
-                     write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
-                                    iff,trim(var%name)                       
-                     write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
-                  ENDIF
-                  IF (grid_type==regular_lonlat) THEN
-                    IF (SIZE(field) == klon) then
-                       CALL xios_send_field(var%name, Field2d)
-                    ELSE
-                       CALL xios_send_field(var%name, field)
-                    ENDIF
-                  ELSE IF (grid_type==unstructured) THEN
-                    IF (SIZE(field) == klon) then
-                      CALL xios_send_field(var%name, buffer_omp)
-                    ELSE
-                      CALL xios_send_field(var%name, field)
-                    ENDIF
-                  ENDIF
-
-                  firstx=.false.
-               ENDIF
-#endif
-
-                  IF (.NOT.clef_stations(iff)) THEN
-                        ALLOCATE(index2d(nbp_lon*jj_nb))
-                        ALLOCATE(fieldok(nbp_lon*jj_nb))
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,nbp_lon*jj_nb,index2d)
-#endif
-!#ifdef CPP_XIOS
-!                        IF (iff == iff_beg) THEN
-!                          IF (prt_level >= 10) THEN
-!                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field"
-!                          ENDIF
-!                          CALL xios_send_field(var%name, Field2d)
-!                        ENDIF
-!#endif
-                  ELSE 
-                        ALLOCATE(fieldok(npstn))
-                        ALLOCATE(index2d(npstn))
-
-                        IF (is_sequential) THEN
-                          DO ip=1, npstn
-                            fieldok(ip)=buffer_omp(nptabij(ip))
-                          ENDDO
-                        ELSE
-                              DO ip=1, npstn
-                                write(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
-                                     IF(nptabij(ip).GE.klon_mpi_begin.AND. &
-                                        nptabij(ip).LE.klon_mpi_end) THEN
-                                       fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
-                                     ENDIF
-                              ENDDO
-                       ENDIF ! of IF (is_sequential)
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-                       IF (prt_level >= 10) THEN
-                         write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
-                       ENDIF
-                       CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
-#endif
-                  ENDIF ! of IF(.NOT.clef_stations(iff))
-                  
-                DEALLOCATE(index2d)
-                DEALLOCATE(fieldok)
-            ENDIF !levfiles
-        ENDDO ! of DO iff=iff_beg, iff_end
-      ENDIF
-!$OMP END MASTER   
-  ENDIF ! vars_defined
-
-  IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
-
-  END SUBROUTINE histwrite2d_phy
-
-
-! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
-  SUBROUTINE histwrite3d_phy(var, field, STD_iff)
-
-  USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
-  USE dimphy, ONLY: klon, klev
-  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
-                                jj_nb, klon_mpi, klon_mpi_begin, &
-                                klon_mpi_end, is_sequential, is_master
-  USE ioipsl, ONLY: histwrite
-  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
-                                 nfiles, vars_defined, clef_stations, &
-                                 nid_files, swaerofree_diag
-  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
-#ifdef CPP_XIOS
-  USE xios, ONLY: xios_send_field
-#endif
-  USE print_control_mod, ONLY: prt_level,lunout
-
-  IMPLICIT NONE
-  INCLUDE 'clesphys.h'
-
-  TYPE(ctrl_out), INTENT(IN) :: var
-  REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
-  INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
-      
-  INTEGER :: iff, iff_beg, iff_end
-  LOGICAL, SAVE  :: firstx
-!$OMP THREADPRIVATE(firstx)
-  REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
-  REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
-  INTEGER :: ip, n, nlev, nlevx
-  INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
-  REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
-
-  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
-
-  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name
-
-! ug RUSTINE POUR LES STD LEVS.....
-      IF (PRESENT(STD_iff)) THEN
-            iff_beg = STD_iff
-            iff_end = STD_iff
-      ELSE
-            iff_beg = 1
-            iff_end = nfiles
-      ENDIF
-
-  ! On regarde si on est dans la phase de définition ou d'écriture:
-  IF (.NOT.vars_defined) THEN
-      !Si phase de définition.... on définit
-!$OMP MASTER
-      DO iff=iff_beg, iff_end
-        IF (clef_files(iff)) THEN
-          CALL histdef3d(iff, var)
-        ENDIF
-      ENDDO
-!$OMP END MASTER
-!--broadcasting the flag that have been changed in histdef3d on OMP masters
-      CALL bcast_omp(swaerofree_diag)
-  ELSE
-    !Et sinon on.... écrit
-
-    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) CALL abort_physic('iophy::histwrite3d_phy','Field first DIMENSION not equal to klon/klev',1)
-
-    nlev=SIZE(field,2)
-    IF (nlev.EQ.klev+1) THEN
-        nlevx=klev
-    ELSE
-        nlevx=nlev
-    ENDIF
-
-    IF (SIZE(field,1) == klon) then
-        CALL Gather_omp(field,buffer_omp)
-    ELSE
-        buffer_omp(:,:)=0.
-    ENDIF
-!$OMP MASTER
-    IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
-
-! BOUCLE SUR LES FICHIERS
-    firstx=.true.
-
-    IF (ok_all_xml) THEN
-#ifdef CPP_XIOS
-          IF (prt_level >= 10) THEN
-             write(lunout,*)'Dans iophy histwrite3D,var%name ',&
-                             trim(var%name)                       
-          ENDIF
-          IF (grid_type==regular_lonlat) THEN
-            IF (SIZE(field,1) == klon) then
-               CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
-            ELSE
-               CALL xios_send_field(var%name, field)
-            ENDIF
-          ELSE IF (grid_type==unstructured) THEN
-            IF (SIZE(field,1) == klon) then
-               CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
-            ELSE
-               CALL xios_send_field(var%name, field)
-            ENDIF
-        ENDIF
-
-#else
-        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
-#endif
-    ELSE  
-
-      DO iff=iff_beg, iff_end
-          IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
-#ifdef CPP_XIOS
-              IF (firstx) THEN
-                IF (prt_level >= 10) THEN
-                  write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
-                                  iff,nlev,klev, firstx                       
-                  write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
-                                  trim(var%name), ' with iim jjm nlevx = ', &
-                                  nbp_lon,jj_nb,nlevx
-                ENDIF
-                IF (grid_type==regular_lonlat) THEN
-                  IF (SIZE(field,1) == klon) then
-                      CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
-                  ELSE
-                       CALL xios_send_field(var%name, field)
-                  ENDIF
-                ELSE IF (grid_type==unstructured) THEN
-                  IF (SIZE(field,1) == klon) then
-                     CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
-                  ELSE
-                     CALL xios_send_field(var%name, field)
-                  ENDIF
-                ENDIF
-
-                firstx=.false.
-              ENDIF
-#endif
-              IF (.NOT.clef_stations(iff)) THEN
-                        ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
-                        ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
-
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,nbp_lon*jj_nb*nlev,index3d)
-#endif
-
-!#ifdef CPP_XIOS
-!                        IF (iff == 1) THEN
-!                              CALL xios_send_field(var%name, Field3d(:,:,1:klev))
-!                        ENDIF
-!#endif
-!                        
-              ELSE 
-                        nlev=size(field,2)
-                        ALLOCATE(index3d(npstn*nlev))
-                        ALLOCATE(fieldok(npstn,nlev))
-
-                        IF (is_sequential) THEN
-                              DO n=1, nlev
-                                    DO ip=1, npstn
-                                          fieldok(ip,n)=buffer_omp(nptabij(ip),n)
-                                    ENDDO
-                              ENDDO
-                        ELSE
-                              DO n=1, nlev
-                                    DO ip=1, npstn
-                                                IF(nptabij(ip).GE.klon_mpi_begin.AND. &
-                                                      nptabij(ip).LE.klon_mpi_end) THEN
-                                                fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
-                                          ENDIF
-                                    ENDDO
-                              ENDDO
-                        ENDIF
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
-#endif
-              ENDIF 
-              DEALLOCATE(index3d)
-              DEALLOCATE(fieldok)
-          ENDIF
-      ENDDO
-    ENDIF
-!$OMP END MASTER   
-  ENDIF ! vars_defined
-
-  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
-
-  END SUBROUTINE histwrite3d_phy
-  
-
-! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
-#ifdef CPP_XIOS
-  SUBROUTINE histwrite2d_xios(field_name,field)
-
-  USE dimphy, ONLY: klon, klev
-  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
-                                is_sequential, klon_mpi_begin, klon_mpi_end, &
-                                jj_nb, klon_mpi, is_master
-  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
-  USE xios, ONLY: xios_send_field
-  USE print_control_mod, ONLY: prt_level,lunout
-
-  IMPLICIT NONE
-
-  CHARACTER(LEN=*), INTENT(IN) :: field_name
-  REAL, DIMENSION(:), INTENT(IN) :: field
-      
-  REAL,DIMENSION(klon_mpi) :: buffer_omp
-  INTEGER, allocatable, DIMENSION(:) :: index2d
-  REAL :: Field2d(nbp_lon,jj_nb)
-
-  INTEGER :: ip
-  REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
-
-  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name
-
-  IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
-
-    !Et sinon on.... écrit
-    IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
-    IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) then
-!$OMP MASTER
-
-        CALL xios_send_field(field_name,field)
-!$OMP END MASTER   
-  ELSE
-        CALL Gather_omp(field,buffer_omp)    
-!$OMP MASTER
-
-      IF (grid_type==unstructured) THEN
-  
-        CALL xios_send_field(field_name, buffer_omp)
-
-      ELSE
-
-        CALL grid1Dto2D_mpi(buffer_omp,Field2d)
-    
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!ATTENTION, STATIONS PAS GEREES !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !IF(.NOT.clef_stations(iff)) THEN
-        IF (.TRUE.) THEN
-    
-            CALL xios_send_field(field_name, Field2d)
-    
-        ELSE 
-            ALLOCATE(fieldok(npstn))
-            ALLOCATE(index2d(npstn))
-    
-            IF (is_sequential) THEN
-                DO ip=1, npstn
-                    fieldok(ip)=buffer_omp(nptabij(ip))
-                ENDDO
-            ELSE
-                DO ip=1, npstn
-                    PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip)
-                    IF(nptabij(ip).GE.klon_mpi_begin.AND. &
-                    nptabij(ip).LE.klon_mpi_end) THEN
-                        fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
-                    ENDIF
-                ENDDO
-            ENDIF
-            DEALLOCATE(index2d)
-            DEALLOCATE(fieldok)
-    
-        ENDIF                  
-      ENDIF
-!$OMP END MASTER   
-  ENDIF
-
-  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
-  END SUBROUTINE histwrite2d_xios
-
-
-! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
-  SUBROUTINE histwrite3d_xios(field_name, field)
-
-  USE dimphy, ONLY: klon, klev
-  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
-                                is_sequential, klon_mpi_begin, klon_mpi_end, &
-                                jj_nb, klon_mpi, is_master
-  USE xios, ONLY: xios_send_field
-  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
-  USE print_control_mod, ONLY: prt_level,lunout
-
-  IMPLICIT NONE
-
-  CHARACTER(LEN=*), INTENT(IN) :: field_name
-  REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
-
-  REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
-  REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
-  INTEGER :: ip, n, nlev
-  INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
-  REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
-
-  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
-
-  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
-
-    !Et on.... écrit
-    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) then
-      write(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field)
-      CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
-    ENDIF
-    
-    IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) then
-!$OMP MASTER
-        CALL xios_send_field(field_name,field)
-!$OMP END MASTER   
-  ELSE
-        nlev=SIZE(field,2)
-
-
-        CALL Gather_omp(field,buffer_omp)
-!$OMP MASTER
-
-    IF (grid_type==unstructured) THEN
-
-      CALL xios_send_field(field_name, buffer_omp(:,1:nlev))
-
-    ELSE
-        CALL grid1Dto2D_mpi(buffer_omp,field3d)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!ATTENTION, STATIONS PAS GEREES !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !IF (.NOT.clef_stations(iff)) THEN
-        IF(.TRUE.)THEN
-
-           CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
-                            
-        ELSE 
-            nlev=size(field,2)
-            ALLOCATE(index3d(npstn*nlev))
-            ALLOCATE(fieldok(npstn,nlev))
-    
-            IF (is_sequential) THEN
-                DO n=1, nlev
-                    DO ip=1, npstn
-                        fieldok(ip,n)=buffer_omp(nptabij(ip),n)
-                    ENDDO
-                ENDDO
-            ELSE
-                DO n=1, nlev
-                    DO ip=1, npstn
-                        IF(nptabij(ip).GE.klon_mpi_begin.AND. &
-                        nptabij(ip).LE.klon_mpi_end) THEN
-                            fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
-                        ENDIF
-                    ENDDO
-                ENDDO
-            ENDIF
-            DEALLOCATE(index3d)
-            DEALLOCATE(fieldok)
-        ENDIF 
-      ENDIF
-!$OMP END MASTER   
-  ENDIF
-
-  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
-
-  END SUBROUTINE histwrite3d_xios
-
-#ifdef CPP_XIOS
-  SUBROUTINE histwrite0d_xios(field_name, field)
-  USE xios, ONLY: xios_send_field
-  USE mod_phys_lmdz_para, ONLY: is_master
-  USE print_control_mod, ONLY: prt_level,lunout
-  IMPLICIT NONE
-
-  CHARACTER(LEN=*), INTENT(IN) :: field_name
-  REAL, INTENT(IN) :: field ! --> scalar
-
-  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name
-
-!$OMP MASTER
-  CALL xios_send_field(field_name, field)
-!$OMP END MASTER
-
-  END SUBROUTINE histwrite0d_xios
-#endif
-
-#endif
-END MODULE iophy
+link ../phylmd/iophy.F90
Index: LMDZ6/trunk/libf/phylmdiso/iophys.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iophys.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iophys.F90	(revision 3940)
@@ -1,184 +1,1 @@
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Interface pour ecrire en netcdf avec les routines d'enseignement
-! iotd de Frederic Hourdin
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      subroutine iophys_ecrit(nom,lllm,titre,unite,px)
-
-      USE mod_phys_lmdz_para, ONLY: klon_omp, is_mpi_root
-      USE mod_phys_lmdz_transfert_para, ONLY: gather
-      USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dto2d_glo
-      IMPLICIT NONE
-
-
-
-!  Ecriture de variables diagnostiques au choix dans la physique 
-!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
-!  3d (ex : temperature), 2d (ex : temperature de surface), ou
-!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
-!  solaire)
-!  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
-!  La periode d'ecriture est donnee par 
-!  "ecritphy " regle dans le fichier de controle de run :  run.def
-!
-!    writediagfi peut etre appele de n'importe quelle subroutine
-!    de la physique, plusieurs fois. L'initialisation et la creation du
-!    fichier se fait au tout premier appel.
-!
-! WARNING : les variables dynamique (u,v,t,q,ps)
-!  sauvees par writediagfi avec une
-! date donnee sont legerement differentes que dans le fichier histoire car 
-! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
-! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
-! avant l'ecriture dans diagfi (cf. physiq.F)
-!  
-! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
-!
-!  parametres (input) :
-!  ----------
-!      unit : unite logique du fichier de sortie (toujours la meme)
-!      nom  : nom de la variable a sortir (chaine de caracteres)
-!      titre: titre de la variable (chaine de caracteres)
-!      unite : unite de la variable (chaine de caracteres)
-!      px : variable a sortir (real 0, 1, 2, ou 3d)
-!
-!=================================================================
-
-
-! Arguments on input:
-      integer lllm
-      character (len=*) :: nom,titre,unite
-      integer imjmax
-      parameter (imjmax=100000)
-      real px(klon_omp,lllm)
-      real xglo(klon_glo,lllm)
-      real zx(nbp_lon,nbp_lat,lllm)
-
-
-      CALL Gather(px,xglo)
-!$OMP MASTER
-      IF (is_mpi_root) THEN       
-        CALL Grid1Dto2D_glo(xglo,zx)
-        call iotd_ecrit(nom,lllm,titre,unite,zx)
-      ENDIF
-!$OMP END MASTER
-
-      return
-      end
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Version avec reindexation pour appeler depuis les routines internes
-! à la sous surface
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-    subroutine iophys_ecrit_index(nom,lllm,titre,unite,knon,knindex,px)
-
-    USE mod_phys_lmdz_para, ONLY: klon_omp
-    USE dimphy, ONLY : klon
-    USE mod_grid_phy_lmdz, ONLY: klon_glo
-    IMPLICIT NONE
-
-! This subroutine returns the sea surface temperature already read from limit.nc
-!
-
-! Arguments on input:
-    INTEGER lllm
-    CHARACTER (len=*) :: nom,titre,unite
-    REAL px(klon_omp,lllm)
-    INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
-    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
-    REAL, DIMENSION(klon,lllm) :: varout
-
-    INTEGER :: i,l
-
-    IF (klon/=klon_omp) THEN
-      print*,'klon, klon_omp',klon,klon_omp
-      CALL abort_physic('iophys_ecrit','probleme de dimension parallele',1)
-    ENDIF
-
-    varout(1:klon,1:lllm)=0.
-    DO l = 1, lllm
-    DO i = 1, knon
-       varout(knindex(i),l) = px(i,l)
-    END DO
-    END DO
-    CALL iophys_ecrit(nom,lllm,titre,unite,varout)
-
-  END SUBROUTINE iophys_ecrit_index
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      SUBROUTINE iophys_ini
-      USE mod_phys_lmdz_para, ONLY: is_mpi_root
-      USE vertical_layers_mod, ONLY: presnivs
-      USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
-      USE dimphy, ONLY: klev
-      USE mod_grid_phy_lmdz, ONLY: klon_glo
-
-      IMPLICIT NONE
-
-!=======================================================================
-!
-!   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
-!   -------
-!
-!   Objet:
-!   ------
-!
-!   'Initialize' the diagfi.nc file: write down dimensions as well
-!   as time-independent fields (e.g: geopotential, mesh area, ...)
-!
-!=======================================================================
-!-----------------------------------------------------------------------
-!   Declarations:
-!   -------------
-
-real pi
-INTEGER nlat_eff
-
-!   Arguments:
-!   ----------
-
-!$OMP MASTER
-    IF (is_mpi_root) THEN       
-
-! Bidouille pour gerer le fait que lat_reg contient deux latitudes
-! en version uni-dimensionnelle (chose qui pourrait être résolue
-! par ailleurs)
-IF (klon_glo==1) THEN
-   nlat_eff=1
-ELSE
-   nlat_eff=size(lat_reg)
-ENDIF
-pi=2.*asin(1.)
-call iotd_ini('phys.nc   ', &
-size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs)
-    ENDIF
-!$OMP END MASTER
-
-      END
-
-#ifdef und
-      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
-      IMPLICIT none
-
-!=======================================================================
-      INTEGER nfield,nlon,iim,jjmp1, jjm
-      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
-
-      INTEGER i, n, ig
-
-      jjm = jjmp1 - 1
-      DO n = 1, nfield
-         DO i=1,iim
-            ecrit(i,n) = fi(1,n)
-            ecrit(i+jjm*iim,n) = fi(nlon,n)
-         ENDDO
-         DO ig = 1, nlon - 2
-           ecrit(iim+ig,n) = fi(1+ig,n)
-         ENDDO
-      ENDDO
-      RETURN
-      END
-
-#endif
+link ../phylmd/iophys.F90
Index: LMDZ6/trunk/libf/phylmdiso/iostart.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iostart.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iostart.F90	(revision 3940)
@@ -1,556 +1,1 @@
-MODULE iostart
-
-PRIVATE
-    INTEGER,SAVE :: nid_start 
-    INTEGER,SAVE :: nid_restart
-    
-    INTEGER,SAVE :: idim1,idim2,idim3,idim4
-    INTEGER,PARAMETER :: length=100
-    
-    INTERFACE get_field
-      MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
-    END INTERFACE get_field
-    
-    INTERFACE get_var
-      MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
-    END INTERFACE get_var
-
-    INTERFACE put_field
-      MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
-    END INTERFACE put_field
-
-    INTERFACE put_var
-      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
-    END INTERFACE put_var
-
-    PUBLIC get_field,get_var,put_field,put_var
-    PUBLIC Open_startphy,close_startphy,open_restartphy,close_restartphy, enddef_restartphy
-    
-CONTAINS
-
-  SUBROUTINE Open_startphy(filename)
-  USE netcdf
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: filename
-    INTEGER          :: ierr
-
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      ierr = NF90_OPEN (filename, NF90_NOWRITE,nid_start)
-      IF (ierr.NE.NF90_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//filename
-        write(6,*)' ierr = ', ierr
-        CALL abort_physic("", "", 1)
-      ENDIF
-    ENDIF
-   
-  END SUBROUTINE Open_startphy
-
-  SUBROUTINE Close_startphy
-  USE netcdf
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    INTEGER          :: ierr
-
-    IF (is_mpi_root .AND. is_omp_root) THEN
-        ierr = NF90_CLOSE (nid_start)
-    ENDIF
-
-  END SUBROUTINE close_startphy
-
-
-  FUNCTION Inquire_Field(Field_name)
-  USE netcdf
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: Field_name
-    LOGICAL :: inquire_field
-    INTEGER :: varid
-    INTEGER :: ierr
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
-      IF (ierr==NF90_NOERR) THEN
-        Inquire_field=.TRUE.
-      ELSE
-        Inquire_field=.FALSE.
-      ENDIF
-    ENDIF
-
-    CALL bcast(Inquire_field)
-
-  END FUNCTION Inquire_Field
-  
- 
-  SUBROUTINE Get_Field_r1(field_name,field,found)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
-    REAL,INTENT(INOUT)               :: Field(:)
-    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
-
-    CALL Get_field_rgen(field_name,field,1,found)
-      
-  END SUBROUTINE Get_Field_r1
-  
-  SUBROUTINE Get_Field_r2(field_name,field,found)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
-    REAL,INTENT(INOUT)               :: Field(:,:)
-    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
-
-    CALL Get_field_rgen(field_name,field,size(field,2),found)
-
-      
-  END SUBROUTINE Get_Field_r2
-  
-  SUBROUTINE Get_Field_r3(field_name,field,found)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
-    REAL,INTENT(INOUT)               :: Field(:,:,:)
-    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
-
-    CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),found)
-      
-  END SUBROUTINE Get_Field_r3
-  
-  SUBROUTINE Get_field_rgen(field_name,field,field_size,found)
-  USE netcdf
-  USE dimphy
-  USE geometry_mod
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: Field_name
-    INTEGER          :: field_size
-    REAL             :: field(klon,field_size)
-    LOGICAL,OPTIONAL :: found
-    
-    REAL,ALLOCATABLE    :: field_glo(:,:)
-    REAL,ALLOCATABLE    :: field_glo_tmp(:,:)
-    INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:)
-    LOGICAL :: tmp_found
-    INTEGER :: varid
-    INTEGER :: ierr,i
-
-    IF (is_master) THEN 
-      ALLOCATE(ind_cell_glo_glo(klon_glo))
-      ALLOCATE(field_glo(klon_glo,field_size))
-      ALLOCATE(field_glo_tmp(klon_glo,field_size))
-    ELSE
-      ALLOCATE(ind_cell_glo_glo(0))
-      ALLOCATE(field_glo(0,0))
-    ENDIF
-    
-    CALL gather(ind_cell_glo,ind_cell_glo_glo)
-    
-    IF (is_master) THEN
-  
-      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
-      
-      IF (ierr==NF90_NOERR) THEN
-        CALL body(field_glo_tmp)
-        tmp_found=.TRUE.
-      ELSE
-        tmp_found=.FALSE.
-      ENDIF
-    
-    ENDIF
-    
-    CALL bcast(tmp_found)
-
-    IF (tmp_found) THEN
-      IF (is_master) THEN  
-        DO i=1,klon_glo
-         field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:)
-        ENDDO
-      ENDIF
-      CALL scatter(field_glo,field)
-    ENDIF
-    
-    IF (PRESENT(found)) THEN
-      found=tmp_found
-    ELSE
-      IF (.NOT. tmp_found) THEN
-        PRINT*, 'phyetat0: Le champ <'//field_name//'> est absent'
-        call abort_physic("", "", 1)
-      ENDIF
-    ENDIF
- 
-    
-    CONTAINS
-     
-     SUBROUTINE body(field_glo)
-       REAL :: field_glo(klon_glo*field_size)
-         ierr=NF90_GET_VAR(nid_start,varid,field_glo)
-         IF (ierr/=NF90_NOERR) THEN
-           ! La variable exist dans le fichier mais la lecture a echouee. 
-           PRINT*, 'phyetat0: Lecture echouee pour <'//field_name//'>'
-
-           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
-              ! Essaye de lire le variable sur surface uniqument, comme fait avant
-              field_glo(:)=0.
-              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
-              IF (ierr/=NF90_NOERR) THEN
-                 PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
-                 call abort_physic("", "", 1)
-              ELSE
-                 PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
-              END IF
-           ELSE
-              call abort_physic("", "", 1)
-           ENDIF
-         ENDIF
-
-     END SUBROUTINE body
-
-  END SUBROUTINE Get_field_rgen
-  
-
-  SUBROUTINE get_var_r0(var_name,var,found)
-  IMPLICIT NONE  
-    CHARACTER(LEN=*),INTENT(IN)  :: var_name
-    REAL,INTENT(INOUT)             :: var
-    LOGICAL,OPTIONAL,INTENT(OUT) :: found
-
-    REAL                         :: varout(1)
-    
-    CALL Get_var_rgen(var_name,varout,size(varout),found)
-    var=varout(1)
- 
-  END SUBROUTINE get_var_r0
-
-  SUBROUTINE get_var_r1(var_name,var,found)
-  IMPLICIT NONE  
-    CHARACTER(LEN=*),INTENT(IN)  :: var_name
-    REAL,INTENT(INOUT)             :: var(:)
-    LOGICAL,OPTIONAL,INTENT(OUT) :: found
-    
-    CALL Get_var_rgen(var_name,var,size(var),found)
-  
-  END SUBROUTINE get_var_r1
-
-  SUBROUTINE get_var_r2(var_name,var,found)
-  IMPLICIT NONE  
-    CHARACTER(LEN=*),INTENT(IN)  :: var_name
-    REAL,INTENT(OUT)             :: var(:,:)
-    LOGICAL,OPTIONAL,INTENT(OUT) :: found
-    
-    CALL Get_var_rgen(var_name,var,size(var),found)
-  
-  END SUBROUTINE get_var_r2
-
-  SUBROUTINE get_var_r3(var_name,var,found)
-  IMPLICIT NONE  
-    CHARACTER(LEN=*),INTENT(IN)  :: var_name
-    REAL,INTENT(INOUT)             :: var(:,:,:)
-    LOGICAL,OPTIONAL,INTENT(OUT) :: found
-    
-    CALL Get_var_rgen(var_name,var,size(var),found)
-  
-  END SUBROUTINE get_var_r3
-
-  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
-  USE netcdf
-  USE dimphy
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    CHARACTER(LEN=*) :: var_name
-    INTEGER          :: var_size
-    REAL             :: var(var_size)
-    LOGICAL,OPTIONAL :: found
-    
-    LOGICAL :: tmp_found
-    INTEGER :: varid
-    INTEGER :: ierr
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-  
-      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
-      
-      IF (ierr==NF90_NOERR) THEN
-        ierr=NF90_GET_VAR(nid_start,varid,var)
-        IF (ierr/=NF90_NOERR) THEN
-          PRINT*, 'phyetat0: Lecture echouee pour <'//var_name//'>'
-          call abort_physic("", "", 1)
-        ENDIF
-        tmp_found=.TRUE.
-      ELSE
-        tmp_found=.FALSE.
-      ENDIF
-    
-    ENDIF
-    
-    CALL bcast(tmp_found)
-
-    IF (tmp_found) THEN
-      CALL bcast(var)
-    ENDIF
-    
-    IF (PRESENT(found)) THEN
-      found=tmp_found
-    ELSE
-      IF (.NOT. tmp_found) THEN
-        PRINT*, 'phyetat0: La variable champ <'//var_name//'> est absente'
-        call abort_physic("", "", 1)
-      ENDIF
-    ENDIF
-
-  END SUBROUTINE Get_var_rgen
-
-
-  SUBROUTINE open_restartphy(filename)
-  USE netcdf
-  USE mod_phys_lmdz_para, ONLY: is_master
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-  USE dimphy, ONLY: klev, klevp1
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN) :: filename
-    INTEGER                     :: ierr
-    
-    IF (is_master) THEN
-      ierr = NF90_CREATE(filename, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
-                          nid_restart)
-      IF (ierr/=NF90_NOERR) THEN
-        write(lunout,*)'open_restartphy: problem creating file '//trim(filename)
-        write(lunout,*)trim(nf90_strerror(ierr))
-        CALL abort_physic("open_restartphy", trim(nf90_strerror(ierr)), 1)
-      ENDIF
-
-      ierr = NF90_PUT_ATT (nid_restart, NF90_GLOBAL, "title","Fichier redemmarage physique")
-
-      ierr = NF90_DEF_DIM (nid_restart, "index", length, idim1)
-      ierr = NF90_DEF_DIM (nid_restart, "points_physiques", klon_glo, idim2)
-      ierr = NF90_DEF_DIM (nid_restart, "horizon_vertical", klon_glo*klev, idim3)
-      ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)
-
-!      ierr = NF90_ENDDEF(nid_restart)
-    ENDIF
-
-  END SUBROUTINE open_restartphy
-  
-  SUBROUTINE enddef_restartphy
-  USE netcdf
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    INTEGER          :: ierr
-
-    IF (is_master) ierr = NF90_ENDDEF(nid_restart)
- 
-  END SUBROUTINE enddef_restartphy
-
-  SUBROUTINE close_restartphy
-  USE netcdf
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    INTEGER          :: ierr
-
-    IF (is_master) ierr = NF90_CLOSE (nid_restart)
- 
-  END SUBROUTINE close_restartphy
-
-  
-  SUBROUTINE put_field_r1(pass, field_name,title,field)
-  IMPLICIT NONE
-  INTEGER, INTENT(IN)            :: pass
-  CHARACTER(LEN=*),INTENT(IN)    :: field_name
-  CHARACTER(LEN=*),INTENT(IN)    :: title
-  REAL,INTENT(IN)                :: field(:)
-    CALL put_field_rgen(pass, field_name,title,field,1)
-  
-  END SUBROUTINE put_field_r1
-
-  SUBROUTINE put_field_r2(pass, field_name,title,field)
-  IMPLICIT NONE
-  INTEGER, INTENT(IN)            :: pass
-  CHARACTER(LEN=*),INTENT(IN)    :: field_name
-  CHARACTER(LEN=*),INTENT(IN)    :: title
-  REAL,INTENT(IN)                :: field(:,:)
-  
-    CALL put_field_rgen(pass, field_name,title,field,size(field,2))
-  
-  END SUBROUTINE put_field_r2
-
-  SUBROUTINE put_field_r3(pass, field_name,title,field)
-  IMPLICIT NONE
-  INTEGER, INTENT(IN)            :: pass
-  CHARACTER(LEN=*),INTENT(IN)    :: field_name
-  CHARACTER(LEN=*),INTENT(IN)    :: title
-  REAL,INTENT(IN)                :: field(:,:,:)
-  
-    CALL put_field_rgen(pass, field_name,title,field,size(field,2)*size(field,3))
-  
-  END SUBROUTINE put_field_r3
-  
-  SUBROUTINE put_field_rgen(pass, field_name,title,field,field_size)
-  USE netcdf
-  USE dimphy
-  USE geometry_mod
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-  INTEGER, INTENT(IN)            :: pass
-  CHARACTER(LEN=*),INTENT(IN)    :: field_name
-  CHARACTER(LEN=*),INTENT(IN)    :: title
-  INTEGER,INTENT(IN)             :: field_size
-  REAL,INTENT(IN)                :: field(klon,field_size)
-  
-!  REAL                           :: field_glo(klon_glo,field_size)
-!  REAL                           :: field_glo_tmp(klon_glo,field_size)
-  REAL ,ALLOCATABLE              :: field_glo(:,:)
-  REAL ,ALLOCATABLE              :: field_glo_tmp(:,:)
-  INTEGER,ALLOCATABLE            :: ind_cell_glo_glo(:)
-!  INTEGER                        :: ind_cell_glo_glo(klon_glo)
-  INTEGER                        :: ierr,i
-  INTEGER                        :: nvarid
-  INTEGER                        :: idim
-   
-! first pass : definition   
-  IF (pass==1) THEN
-    
-    IF (is_master) THEN
-
-      IF (field_size==1) THEN
-        idim=idim2
-      ELSE IF (field_size==klev) THEN
-        idim=idim3
-      ELSE IF (field_size==klevp1) THEN
-        idim=idim4
-      ELSE
-        PRINT *, "erreur phyredem : probleme de dimension"
-        CALL abort_physic("", "", 1)
-      ENDIF
-         
-!      ierr = NF90_REDEF (nid_restart)
-#ifdef NC_DOUBLE
-      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
-#else
-      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid)
-#endif
-      IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
-!      ierr = NF90_ENDDEF(nid_restart)
-     ENDIF
-
-! second pass : write     
-   ELSE IF (pass==2) THEN 
-    
-     IF (is_master) THEN
-       ALLOCATE(ind_cell_glo_glo(klon_glo))
-       ALLOCATE(field_glo(klon_glo,field_size))
-       ALLOCATE(field_glo_tmp(klon_glo,field_size))
-     ELSE
-       ALLOCATE(ind_cell_glo_glo(0))
-       ALLOCATE(field_glo_tmp(0,0))
-     ENDIF
-     
-     CALL gather(ind_cell_glo,ind_cell_glo_glo) 
-
-     CALL gather(field,field_glo_tmp)
-    
-     IF (is_master) THEN
-
-       DO i=1,klon_glo
-         field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:)
-       ENDDO
-
-       ierr = NF90_INQ_VARID(nid_restart, field_name, nvarid)
-       ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
-      ENDIF
-   ENDIF
-    
- END SUBROUTINE put_field_rgen  
-  
-
- SUBROUTINE put_var_r0(pass, var_name,title,var)
-   IMPLICIT NONE
-     INTEGER, INTENT(IN)            :: pass
-     CHARACTER(LEN=*),INTENT(IN) :: var_name
-     CHARACTER(LEN=*),INTENT(IN) :: title
-     REAL,INTENT(IN)             :: var
-     REAL                        :: varin(1)
-     
-     varin(1)=var
-     
-     CALL put_var_rgen(pass, var_name,title,varin,size(varin))
-
-  END SUBROUTINE put_var_r0
-
-
-   SUBROUTINE put_var_r1(pass, var_name,title,var)
-   IMPLICIT NONE
-     INTEGER, INTENT(IN)            :: pass
-     CHARACTER(LEN=*),INTENT(IN) :: var_name
-     CHARACTER(LEN=*),INTENT(IN) :: title
-     REAL,INTENT(IN)             :: var(:)
-     
-     CALL put_var_rgen(pass, var_name,title,var,size(var))
-
-  END SUBROUTINE put_var_r1
- 
-  SUBROUTINE put_var_r2(pass, var_name,title,var)
-   IMPLICIT NONE
-     INTEGER, INTENT(IN)            :: pass
-     CHARACTER(LEN=*),INTENT(IN) :: var_name
-     CHARACTER(LEN=*),INTENT(IN) :: title
-     REAL,INTENT(IN)             :: var(:,:)
-     
-     CALL put_var_rgen(pass, var_name,title,var,size(var))
-
-  END SUBROUTINE put_var_r2     
-  
-  SUBROUTINE put_var_r3(pass, var_name,title,var)
-   IMPLICIT NONE
-     INTEGER, INTENT(IN)            :: pass
-     CHARACTER(LEN=*),INTENT(IN) :: var_name
-     CHARACTER(LEN=*),INTENT(IN) :: title
-     REAL,INTENT(IN)             :: var(:,:,:)
-     
-     CALL put_var_rgen(pass, var_name,title,var,size(var))
-
-  END SUBROUTINE put_var_r3
-
-  SUBROUTINE put_var_rgen(pass, var_name,title,var,var_size)
-  USE netcdf
-  USE dimphy
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    INTEGER, INTENT(IN)         :: pass
-    CHARACTER(LEN=*),INTENT(IN) :: var_name
-    CHARACTER(LEN=*),INTENT(IN) :: title
-    INTEGER,INTENT(IN)          :: var_size
-    REAL,INTENT(IN)             :: var(var_size)
-    
-    INTEGER :: ierr
-    INTEGER :: nvarid
-         
-    IF (is_master) THEN
-
-      IF (var_size/=length) THEN
-        PRINT *, "erreur phyredem : probleme de dimension"
-        call abort_physic("", "", 1)
-      ENDIF
-
-     ! first pass : definition   
-      IF (pass==1) THEN
-        
-!      ierr = NF90_REDEF (nid_restart)
-
-#ifdef NC_DOUBLE
-        ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
-#else
-        ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
-#endif
-        IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
-!      ierr = NF90_ENDDEF(nid_restart)
-
-    ! second pass : write     
-      ELSE IF (pass==2) THEN 
-        ierr = NF90_INQ_VARID(nid_restart, var_name, nvarid)
-        ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
-      ENDIF
-    ENDIF
-    
-  END SUBROUTINE put_var_rgen     
-    
-END MODULE iostart
+link ../phylmd/iostart.F90
Index: LMDZ6/trunk/libf/phylmdiso/iotd.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iotd.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iotd.h	(revision 3940)
@@ -1,16 +1,1 @@
-!=======================================================================
-!
-!   Auteur:  F. Hourdin
-!   -------
-!
-!   Objet:
-!   ------
-!   Light interface for netcdf outputs. can be used outside LMDZ
-!
-!=======================================================================
-
-      integer imax,jmax,lmax,nid
-      INTEGER dim_coord(4)
-      real iotd_ts
-
-      common/ecritd_c/imax,jmax,lmax,nid,dim_coord,iotd_ts
+link ../phylmd/iotd.h
Index: LMDZ6/trunk/libf/phylmdiso/iotd_ecrit.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iotd_ecrit.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iotd_ecrit.F90	(revision 3940)
@@ -1,180 +1,1 @@
-      subroutine iotd_ecrit(nom,llm,titre,unite,px)
-
-
-!=======================================================================
-!
-!   Auteur:  F. Hourdin
-!   -------
-!
-!   Objet:
-!   ------
-!   Light interface for netcdf outputs. can be used outside LMDZ
-!
-!=======================================================================
-!-----------------------------------------------------------------------
-!  ----------
-!      nom  : nom de la variable a sortir (chaine de caracteres)
-!      llm  : nombre de couches
-!      titre: titre de la variable (chaine de caracteres)
-!      unite : unite de la variable (chaine de caracteres)
-!      px : variable a sortir
-!
-!=================================================================
- 
-      implicit none
-
-! Commons
-
-#include "netcdf.inc"
-#include "iotd.h"
-
-
-! Arguments on input:
-      integer llm
-      character (len=*) :: nom,titre,unite
-      integer imjmax
-      parameter (imjmax=100000)
-      real px(imjmax*llm)
-
-! Local variables:
-
-      real*4 date
-      real*4 zx(imjmax*llm)
-
-
-      integer ierr,ndim,dim_cc(4)
-      integer iq
-      integer i,j,l
-
-      integer zitau
-      character firstnom*20
-      SAVE firstnom
-      SAVE zitau
-      SAVE date
-      data firstnom /'1234567890'/
-      data zitau /0/
-
-! Ajouts
-      integer, save :: ntime=0
-      integer :: idim,varid
-      character (len =50):: fichnom
-      integer, dimension(4) :: id
-      integer, dimension(4) :: edges,corner
-      
-
-!***************************************************************
-! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
-! ------------------------------------------------------------------------
-! (Au tout premier appel de la subroutine durant le run.)
-
-
-!--------------------------------------------------------
-! Write the variables to output file if it's time to do so
-!--------------------------------------------------------
-
-
-! Compute/write/extend 'Time' coordinate (date given in days)
-! (done every "first call" (at given time level) to writediagfi)
-! Note: date is incremented as 1 step ahead of physics time
-!--------------------------------------------------------
-
-        zx(1:imax*jmax*llm)=px(1:imax*jmax*llm)
-        if (firstnom =='1234567890') then
-            firstnom=nom
-        endif
-
-!      print*,'nom ',nom,firstnom
-
-!! Quand on tombe sur la premiere variable on ajoute un pas de temps
-        if (nom.eq.firstnom) then
-        ! We have identified a "first call" (at given date)
-
-           ntime=ntime+1 ! increment # of stored time steps
-
-!!          print*,'ntime ',ntime
-           date=ntime
-!          date= float (zitau +1)/float (day_step)
-
-           ! compute corresponding date (in days and fractions thereof)
-           ! Get NetCDF ID of 'Time' variable
-
-           ierr=NF_SYNC(nid)
-
-           ierr= NF_INQ_VARID(nid,"Time",varid)
-           ! Write (append) the new date to the 'Time' array
-
-
-           ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
-
-!          print*,'date ',date,ierr,nid
-!        print*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date
-
-           if (ierr.ne.NF_NOERR) then
-              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
-              write(*,*) "***** with time"
-              write(*,*) 'ierr=', ierr   
-           endif
-
-!          write(6,*)'WRITEDIAGFI: date= ', date
-        end if ! of if (nom.eq.firstnom)
-
-
-!Case of a 3D variable
-!---------------------
-        if (llm==lmax) then
-           ndim=4
-           corner(1)=1
-           corner(2)=1
-           corner(3)=1
-           corner(4)=ntime
-           edges(1)=imax
-           edges(2)=jmax
-           edges(3)=llm
-           edges(4)=1
-           dim_cc=dim_coord
-
-
-!Case of a 2D variable
-!---------------------
-
-        else if (llm==1) then
-           ndim=3
-           corner(1)=1
-           corner(2)=1
-           corner(3)=ntime
-           corner(4)=1
-           edges(1)=imax
-           edges(2)=jmax
-           edges(3)=1
-           edges(4)=1
-           dim_cc(1:2)=dim_coord(1:2)
-           dim_cc(3)=dim_coord(4)
-
-        endif ! of if llm=1 ou llm
-
-! AU premier pas de temps, on crée les variables
-!-----------------------------------------------
-
-      if (ntime==1) then
-          ierr = NF_REDEF (nid)
-          ierr = NF_DEF_VAR(nid,nom,NF_FLOAT,ndim,dim_cc,varid)
-          print*,'DEF ',nom,nid,varid
-          ierr = NF_ENDDEF(nid)
-      else
-         ierr= NF_INQ_VARID(nid,nom,varid)
-          print*,'INQ ',nom,nid,varid
-! Commandes pour recuperer automatiquement les coordonnees
-!             ierr= NF_INQ_DIMID(nid,"longitude",id(1))
-      endif
-
-
-      ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,zx)
-
-      if (ierr.ne.NF_NOERR) then
-           write(*,*) "***** PUT_VAR problem in writediagfi"
-           write(*,*) "***** with ",nom
-           write(*,*) 'ierr=', ierr
-      endif 
-
-
-      end
+link ../phylmd/iotd_ecrit.F90
Index: LMDZ6/trunk/libf/phylmdiso/iotd_fin.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iotd_fin.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iotd_fin.F90	(revision 3940)
@@ -1,25 +1,1 @@
-      SUBROUTINE iotd_fin
-      IMPLICIT NONE
-
-!=======================================================================
-!
-!   Auteur:  F. Hourdin
-!   -------
-!
-!   Objet:
-!   ------
-!   Light interface for netcdf outputs. can be used outside LMDZ
-!
-!=======================================================================
-
-
-#include "netcdf.inc"
-#include "iotd.h"
-      integer ierr
-
-!   Arguments:
-!   ----------
-
-      ierr=NF_close(nid)
-
-      END
+link ../phylmd/iotd_fin.F90
Index: LMDZ6/trunk/libf/phylmdiso/iotd_ini.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/iotd_ini.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/iotd_ini.F90	(revision 3940)
@@ -1,116 +1,1 @@
-      SUBROUTINE iotd_ini(fichnom,iim,jjm,llm,prlonv,prlatu,pcoordv)
-      IMPLICIT NONE
-
-!=======================================================================
-!
-!   Auteur:  F. Hourdin
-!   -------
-!
-!   Objet:
-!   ------
-!   Light interface for netcdf outputs. can be used outside LMDZ
-!
-!=======================================================================
-!-----------------------------------------------------------------------
-!   Declarations:
-!   -------------
-
-#include "netcdf.inc"
-#include "iotd.h"
-
-!   Arguments:
-!   ----------
-
-      integer iim,jjm,llm
-      real prlonv(iim),prlatu(jjm),pcoordv(llm),timestep
-      INTEGER id_FOCE
-
-      integer corner(4),edges(4),ndim
-      real  px(1000)
-      character (len=10) :: nom
-
-!   Local:
-!   ------
-      INTEGER ierr
-
-      integer :: nvarid
-      integer, dimension(2) :: id  
-      integer :: varid
-
-      character*10 fichnom
-      real*4 rlonv(iim),rlatu(jjm),coordv(llm)
-
-      real pi
-
-      print*,'INIIO prlonv ',prlonv
-      imax=iim
-      jmax=jjm
-      lmax=llm
-
-      rlonv=prlonv
-      rlatu=prlatu
-      coordv=pcoordv
-
-!-----------------------------------------------------------------------
-
-
-      pi=2.*asin(1.)
-
-! Define dimensions
-    
-         ! Create the NetCDF file
-         ierr=NF_CREATE(fichnom, NF_CLOBBER, nid)
-         ! Define the 'Time' dimension
-         ierr=nf_def_dim(nid,"Time",NF_UNLIMITED,dim_coord(4))
-         ! Define the 'Time' variable
-         ierr=NF_DEF_VAR(nid, "Time", NF_FLOAT, 1, dim_coord(4),varid)
-!        ! Add a long_name attribute
-!        ierr=NF_PUT_ATT_TEXT(nid, varid, "long_name",4,"Time")
-!        ! Add a units attribute
-         ierr=NF_PUT_ATT_TEXT(nid, varid,'units',29,"days since 0000-00-0 00:00:00")
-         ! Switch out of NetCDF Define mode
-
-      ierr=NF_DEF_DIM(nid, "longitude", iim, dim_coord(1))
-      ierr=NF_DEF_DIM(nid, "latitude", jjm, dim_coord(2))
-      ierr=NF_DEF_DIM(nid, "altitude", llm, dim_coord(3))
-
-
-      ierr=NF_ENDDEF(nid)
-!
-!  Contol parameters for this run
-! --------------------------
-
-      ierr=NF_REDEF(nid)
-      ierr=NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, dim_coord(1),nvarid)
-!     ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name", 14,
-!    .      "East longitude")
-!     ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
-      ierr=NF_ENDDEF(nid)
-      ierr=NF_PUT_VAR_REAL(nid,nvarid,rlonv)
-       print*,ierr
-
-! --------------------------
-      ierr=NF_REDEF(nid)
-      ierr=NF_DEF_VAR(nid, "latitude", NF_FLOAT, 1, dim_coord(2),nvarid)
-!     ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
-!     ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name", 14,"North latitude")
-      ierr=NF_ENDDEF(nid)
-      ierr=NF_PUT_VAR_REAL(nid,nvarid,rlatu)
-!
-! --------------------------
-      ierr=NF_REDEF(nid)
-      ierr=NF_DEF_VAR(nid, "altitude", NF_FLOAT, 1,dim_coord(3),nvarid)
-      ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"pseudo-alt")
-!     ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',2,"km")
-      if ( pcoordv(2)>pcoordv(1) ) then
-         ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"pseudo-alt")
-         ierr=NF_PUT_ATT_TEXT(nid,nvarid,'positive',2,"up")
-      else
-         ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",8,"pressure")
-         ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',4,"down")
-      endif
-      ierr=NF_ENDDEF(nid)
-
-      ierr=NF_PUT_VAR_REAL(nid,nvarid,coordv)
-!
-      END
+link ../phylmd/iotd_ini.F90
Index: LMDZ6/trunk/libf/phylmdiso/isccp_cloud_types.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/isccp_cloud_types.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/isccp_cloud_types.F90	(revision 3940)
@@ -1,1611 +1,1 @@
-
-! $Id $
-
-SUBROUTINE isccp_cloud_types(debug, debugcol, npoints, sunlit, nlev, ncol, &
-    seed, pfull, phalf, qv, cc, conv, dtau_s, dtau_c, top_height, overlap, &
-    tautab, invtau, skt, emsfc_lw, at, dem_s, dem_c, fq_isccp, totalcldarea, &
-    meanptop, meantaucld, boxtau, boxptop)
-
-
-  ! Copyright Steve Klein and Mark Webb 2002 - all rights reserved.
-
-  ! This code is available without charge with the following conditions:
-
-  ! 1. The code is available for scientific purposes and is not for
-  ! commercial use.
-  ! 2. Any improvements you make to the code should be made available
-  ! to the to the authors for incorporation into a future release.
-  ! 3. The code should not be used in any way that brings the authors
-  ! or their employers into disrepute.
-
-  IMPLICIT NONE
-
-  ! NOTE:   the maximum number of levels and columns is set by
-  ! the following parameter statement
-
-  INTEGER ncolprint
-
-  ! -----
-  ! Input
-  ! -----
-
-  INTEGER npoints !  number of model points in the horizontal
-  ! PARAMETER(npoints=6722)
-  INTEGER nlev !  number of model levels in column
-  INTEGER ncol !  number of subcolumns
-
-  INTEGER sunlit(npoints) !  1 for day points, 0 for night time
-
-  INTEGER seed(npoints) !  seed value for random number generator
-  ! !  ( see Numerical Recipes Chapter 7)
-  ! !  It is recommended that the seed is set
-  ! !  to a different value for each model
-  ! !  gridbox it is called on, as it is
-  ! !  possible that the choice of the samec
-  ! !  seed value every time may introduce some
-  ! !  statistical bias in the results, particularly
-  ! !  for low values of NCOL.
-
-  REAL pfull(npoints, nlev) !  pressure of full model levels (Pascals)
-  ! !  pfull(npoints,1)    is    top level of model
-  ! !  pfull(npoints,nlev) is bottom level of model
-
-  REAL phalf(npoints, nlev+1) !  pressure of half model levels (Pascals)
-  ! !  phalf(npoints,1)    is    top       of model
-  ! !  phalf(npoints,nlev+1) is the surface pressure
-
-  REAL qv(npoints, nlev) !  water vapor specific humidity (kg vapor/ kg air)
-  ! !         on full model levels
-
-  REAL cc(npoints, nlev) !  input cloud cover in each model level (fraction)
-  ! !  NOTE:  This is the HORIZONTAL area of each
-  ! !         grid box covered by clouds
-
-  REAL conv(npoints, nlev) !  input convective cloud cover in each model level (fraction)
-  ! !  NOTE:  This is the HORIZONTAL area of each
-  ! !         grid box covered by convective clouds
-
-  REAL dtau_s(npoints, nlev) !  mean 0.67 micron optical depth of stratiform
-  ! !  clouds in each model level
-  ! !  NOTE:  this the cloud optical depth of only the
-  ! !         cloudy part of the grid box, it is not weighted
-  ! !         with the 0 cloud optical depth of the clear
-  ! !         part of the grid box
-
-  REAL dtau_c(npoints, nlev) !  mean 0.67 micron optical depth of convective
-  ! !  clouds in each
-  ! !  model level.  Same note applies as in dtau_s.
-
-  INTEGER overlap !  overlap type
-
-  ! 1=max
-
-  ! 2=rand
-  ! 3=max/rand
-
-  INTEGER top_height !  1 = adjust top height using both a computed
-  ! !  infrared brightness temperature and the visible
-  ! !  optical depth to adjust cloud top pressure. Note
-  ! !  that this calculation is most appropriate to compare
-  ! !  to ISCCP data during sunlit hours.
-  ! !  2 = do not adjust top height, that is cloud top
-  ! !  pressure is the actual cloud top pressure
-  ! !  in the model
-  ! !  3 = adjust top height using only the computed
-  ! !  infrared brightness temperature. Note that this
-  ! !  calculation is most appropriate to compare to ISCCP
-  ! !  IR only algortihm (i.e. you can compare to nighttime
-  ! !  ISCCP data with this option)
-
-  REAL tautab(0:255) !  ISCCP table for converting count value to
-  ! !  optical thickness
-
-  INTEGER invtau(-20:45000) !  ISCCP table for converting optical thickness
-  ! !  to count value
-
-  ! The following input variables are used only if top_height = 1 or
-  ! top_height = 3
-
-  REAL skt(npoints) !  skin Temperature (K)
-  REAL emsfc_lw !  10.5 micron emissivity of surface (fraction)
-  REAL at(npoints, nlev) !  temperature in each model level (K)
-  REAL dem_s(npoints, nlev) !  10.5 micron longwave emissivity of stratiform
-  ! !  clouds in each
-  ! !  model level.  Same note applies as in dtau_s.
-  REAL dem_c(npoints, nlev) !  10.5 micron longwave emissivity of convective
-  ! !  clouds in each
-  ! !  model level.  Same note applies as in dtau_s.
-  ! IM reg.dyn BEG
-  REAL t1, t2
-  ! REAL w(npoints)                   !vertical wind at 500 hPa
-  ! LOGICAL pct_ocean(npoints)        !TRUE if oceanic point, FALSE otherway
-  ! INTEGER iw(npoints) , nw
-  ! REAL wmin, pas_w
-  ! INTEGER k, l, iwmx
-  ! PARAMETER(wmin=-100.,pas_w=10.,iwmx=30)
-  ! REAL fq_dynreg(7,7,iwmx)
-  ! REAL nfq_dynreg(7,7,iwmx)
-  ! LOGICAL pctj(7,7,iwmx)
-  ! IM reg.dyn END
-  ! ------
-  ! Output
-  ! ------
-
-  REAL fq_isccp(npoints, 7, 7) !  the fraction of the model grid box covered by
-  ! !  each of the 49 ISCCP D level cloud types
-
-  REAL totalcldarea(npoints) !  the fraction of model grid box columns
-  ! !  with cloud somewhere in them.  This should
-  ! !  equal the sum over all entries of fq_isccp
-
-
-  ! ! The following three means are averages over the cloudy areas only.  If
-  ! no
-  ! ! clouds are in grid box all three quantities should equal zero.
-
-  REAL meanptop(npoints) !  mean cloud top pressure (mb) - linear averaging
-  ! !  in cloud top pressure.
-
-  REAL meantaucld(npoints) !  mean optical thickness
-  ! !  linear averaging in albedo performed.
-
-  REAL boxtau(npoints, ncol) !  optical thickness in each column
-
-  REAL boxptop(npoints, ncol) !  cloud top pressure (mb) in each column
-
-
-
-  ! ------
-  ! Working variables added when program updated to mimic Mark Webb's PV-Wave
-  ! code
-  ! ------
-
-  REAL frac_out(npoints, ncol, nlev) ! boxes gridbox divided up into
-  ! ! Equivalent of BOX in original version, but
-  ! ! indexed by column then row, rather than
-  ! ! by row then column
-
-  REAL tca(npoints, 0:nlev) ! total cloud cover in each model level (fraction)
-  ! ! with extra layer of zeroes on top
-  ! ! in this version this just contains the values input
-  ! ! from cc but with an extra level
-  REAL cca(npoints, nlev) ! convective cloud cover in each model level (fraction)
-  ! ! from conv
-
-  REAL threshold(npoints, ncol) ! pointer to position in gridbox
-  REAL maxocc(npoints, ncol) ! Flag for max overlapped conv cld
-  REAL maxosc(npoints, ncol) ! Flag for max overlapped strat cld
-
-  REAL boxpos(npoints, ncol) ! ordered pointer to position in gridbox
-
-  REAL threshold_min(npoints, ncol) ! minimum value to define range in with new threshold
-  ! ! is chosen
-
-  REAL dem(npoints, ncol), bb(npoints) !  working variables for 10.5 micron longwave
-  ! !  emissivity in part of
-  ! !  gridbox under consideration
-
-  REAL ran(npoints) ! vector of random numbers
-  REAL ptrop(npoints)
-  REAL attrop(npoints)
-  REAL attropmin(npoints)
-  REAL atmax(npoints)
-  REAL atmin(npoints)
-  REAL btcmin(npoints)
-  REAL transmax(npoints)
-
-  INTEGER i, j, ilev, ibox, itrop(npoints)
-  INTEGER ipres(npoints)
-  INTEGER itau(npoints), ilev2
-  INTEGER acc(nlev, ncol)
-  INTEGER match(npoints, nlev-1)
-  INTEGER nmatch(npoints)
-  INTEGER levmatch(npoints, ncol)
-
-  ! !variables needed for water vapor continuum absorption
-  REAL fluxtop_clrsky(npoints), trans_layers_above_clrsky(npoints)
-  REAL taumin(npoints)
-  REAL dem_wv(npoints, nlev), wtmair, wtmh20, navo, grav, pstd, t0
-  REAL press(npoints), dpress(npoints), atmden(npoints)
-  REAL rvh20(npoints), wk(npoints), rhoave(npoints)
-  REAL rh20s(npoints), rfrgn(npoints)
-  REAL tmpexp(npoints), tauwv(npoints)
-
-  CHARACTER *1 cchar(6), cchar_realtops(6)
-  INTEGER icycle
-  REAL tau(npoints, ncol)
-  LOGICAL box_cloudy(npoints, ncol)
-  REAL tb(npoints, ncol)
-  REAL ptop(npoints, ncol)
-  REAL emcld(npoints, ncol)
-  REAL fluxtop(npoints, ncol)
-  REAL trans_layers_above(npoints, ncol)
-  REAL isccp_taumin, fluxtopinit(npoints), tauir(npoints)
-  REAL meanalbedocld(npoints)
-  REAL albedocld(npoints, ncol)
-  REAL boxarea
-  INTEGER debug ! set to non-zero value to print out inputs
-  ! ! with step debug
-  INTEGER debugcol ! set to non-zero value to print out column
-  ! ! decomposition with step debugcol
-
-  INTEGER index1(npoints), num1, jj
-  REAL rec2p13, tauchk
-
-  CHARACTER *10 ftn09
-
-  DATA isccp_taumin/0.3/
-  DATA cchar/' ', '-', '1', '+', 'I', '+'/
-  DATA cchar_realtops/' ', ' ', '1', '1', 'I', 'I'/
-
-  tauchk = -1.*log(0.9999999)
-  rec2p13 = 1./2.13
-
-  ncolprint = 0
-
-  ! IM
-  ! PRINT*,' isccp_cloud_types npoints=',npoints
-
-  ! if ( debug.ne.0 ) then
-  ! j=1
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write(6,'(a10)') 'debug='
-  ! write(6,'(8I10)') debug
-  ! write(6,'(a10)') 'debugcol='
-  ! write(6,'(8I10)') debugcol
-  ! write(6,'(a10)') 'npoints='
-  ! write(6,'(8I10)') npoints
-  ! write(6,'(a10)') 'nlev='
-  ! write(6,'(8I10)') nlev
-  ! write(6,'(a10)') 'ncol='
-  ! write(6,'(8I10)') ncol
-  ! write(6,'(a10)') 'top_height='
-  ! write(6,'(8I10)') top_height
-  ! write(6,'(a10)') 'overlap='
-  ! write(6,'(8I10)') overlap
-  ! write(6,'(a10)') 'emsfc_lw='
-  ! write(6,'(8f10.2)') emsfc_lw
-  ! write(6,'(a10)') 'tautab='
-  ! write(6,'(8f10.2)') tautab
-  ! write(6,'(a10)') 'invtau(1:100)='
-  ! write(6,'(8i10)') (invtau(i),i=1,100)
-  ! do j=1,npoints,debug
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write(6,'(a10)') 'sunlit='
-  ! write(6,'(8I10)') sunlit(j)
-  ! write(6,'(a10)') 'seed='
-  ! write(6,'(8I10)') seed(j)
-  ! write(6,'(a10)') 'pfull='
-  ! write(6,'(8f10.2)') (pfull(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'phalf='
-  ! write(6,'(8f10.2)') (phalf(j,i),i=1,nlev+1)
-  ! write(6,'(a10)') 'qv='
-  ! write(6,'(8f10.3)') (qv(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'cc='
-  ! write(6,'(8f10.3)') (cc(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'conv='
-  ! write(6,'(8f10.2)') (conv(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dtau_s='
-  ! write(6,'(8g12.5)') (dtau_s(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dtau_c='
-  ! write(6,'(8f10.2)') (dtau_c(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'skt='
-  ! write(6,'(8f10.2)') skt(j)
-  ! write(6,'(a10)') 'at='
-  ! write(6,'(8f10.2)') (at(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dem_s='
-  ! write(6,'(8f10.3)') (dem_s(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dem_c='
-  ! write(6,'(8f10.2)') (dem_c(j,i),i=1,nlev)
-  ! enddo
-  ! endif
-
-  ! ---------------------------------------------------!
-
-  ! assign 2d tca array using 1d input array cc
-
-  DO j = 1, npoints
-    tca(j, 0) = 0
-  END DO
-
-  DO ilev = 1, nlev
-    DO j = 1, npoints
-      tca(j, ilev) = cc(j, ilev)
-    END DO
-  END DO
-
-  ! assign 2d cca array using 1d input array conv
-
-  DO ilev = 1, nlev
-    ! IM pas besoin        do ibox=1,ncol
-    DO j = 1, npoints
-      cca(j, ilev) = conv(j, ilev)
-    END DO
-    ! IM        enddo
-  END DO
-
-  ! IM
-  ! do j=1, iwmx
-  ! do l=1, 7
-  ! do k=1, 7
-  ! fq_dynreg(k,l,j) =0.
-  ! nfq_dynreg(k,l,j) =0.
-  ! enddo !k
-  ! enddo !l
-  ! enddo !j
-  ! IM
-  ! IM
-  ! if (ncolprint.ne.0) then
-  ! do j=1,npoints,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write (6,'(a)') 'seed:'
-  ! write (6,'(I3.2)') seed(j)
-
-  ! write (6,'(a)') 'tca_pp_rev:'
-  ! write (6,'(8f5.2)')
-  ! &   ((tca(j,ilev)),
-  ! &      ilev=1,nlev)
-
-  ! write (6,'(a)') 'cca_pp_rev:'
-  ! write (6,'(8f5.2)')
-  ! &   ((cca(j,ilev),ibox=1,ncolprint),ilev=1,nlev)
-  ! enddo
-  ! endif
-
-  IF (top_height==1 .OR. top_height==3) THEN
-
-    DO j = 1, npoints
-      ptrop(j) = 5000.
-      atmin(j) = 400.
-      attropmin(j) = 400.
-      atmax(j) = 0.
-      attrop(j) = 120.
-      itrop(j) = 1
-    END DO
-
-    DO ilev = 1, nlev
-      DO j = 1, npoints
-        IF (pfull(j,ilev)<40000. .AND. pfull(j,ilev)>5000. .AND. &
-            at(j,ilev)<attropmin(j)) THEN
-          ptrop(j) = pfull(j, ilev)
-          attropmin(j) = at(j, ilev)
-          attrop(j) = attropmin(j)
-          itrop(j) = ilev
-        END IF
-        IF (at(j,ilev)>atmax(j)) atmax(j) = at(j, ilev)
-        IF (at(j,ilev)<atmin(j)) atmin(j) = at(j, ilev)
-      END DO
-    END DO
-
-  END IF
-
-  ! -----------------------------------------------------!
-
-  ! ---------------------------------------------------!
-
-  ! IM
-  ! do 13 ilev=1,nlev
-  ! num1=0
-  ! do j=1,npoints
-  ! if (cc(j,ilev) .lt. 0. .or. cc(j,ilev) .gt. 1.) then
-  ! num1=num1+1
-  ! index1(num1)=j
-  ! end if
-  ! enddo
-  ! do jj=1,num1
-  ! j=index1(jj)
-  ! write(6,*)  ' error = cloud fraction less than zero'
-  ! write(6,*) ' or '
-  ! write(6,*)  ' error = cloud fraction greater than 1'
-  ! write(6,*) 'value at point ',j,' is ',cc(j,ilev)
-  ! write(6,*) 'level ',ilev
-  ! STOP
-  ! enddo
-  ! num1=0
-  ! do j=1,npoints
-  ! if (conv(j,ilev) .lt. 0. .or. conv(j,ilev) .gt. 1.) then
-  ! num1=num1+1
-  ! index1(num1)=j
-  ! end if
-  ! enddo
-  ! do jj=1,num1
-  ! j=index1(jj)
-  ! write(6,*)
-  ! &           ' error = convective cloud fraction less than zero'
-  ! write(6,*) ' or '
-  ! write(6,*)
-  ! &           ' error = convective cloud fraction greater than 1'
-  ! write(6,*) 'value at point ',j,' is ',conv(j,ilev)
-  ! write(6,*) 'level ',ilev
-  ! STOP
-  ! enddo
-
-  ! num1=0
-  ! do j=1,npoints
-  ! if (dtau_s(j,ilev) .lt. 0.) then
-  ! num1=num1+1
-  ! index1(num1)=j
-  ! end if
-  ! enddo
-  ! do jj=1,num1
-  ! j=index1(jj)
-  ! write(6,*)
-  ! &           ' error = stratiform cloud opt. depth less than zero'
-  ! write(6,*) 'value at point ',j,' is ',dtau_s(j,ilev)
-  ! write(6,*) 'level ',ilev
-  ! STOP
-  ! enddo
-  ! num1=0
-  ! do j=1,npoints
-  ! if (dtau_c(j,ilev) .lt. 0.) then
-  ! num1=num1+1
-  ! index1(num1)=j
-  ! end if
-  ! enddo
-  ! do jj=1,num1
-  ! j=index1(jj)
-  ! write(6,*)
-  ! &           ' error = convective cloud opt. depth less than zero'
-  ! write(6,*) 'value at point ',j,' is ',dtau_c(j,ilev)
-  ! write(6,*) 'level ',ilev
-  ! STOP
-  ! enddo
-
-  ! num1=0
-  ! do j=1,npoints
-  ! if (dem_s(j,ilev) .lt. 0. .or. dem_s(j,ilev) .gt. 1.) then
-  ! num1=num1+1
-  ! index1(num1)=j
-  ! end if
-  ! enddo
-  ! do jj=1,num1
-  ! j=index1(jj)
-  ! write(6,*)
-  ! &           ' error = stratiform cloud emissivity less than zero'
-  ! write(6,*)'or'
-  ! write(6,*)
-  ! &           ' error = stratiform cloud emissivity greater than 1'
-  ! write(6,*) 'value at point ',j,' is ',dem_s(j,ilev)
-  ! write(6,*) 'level ',ilev
-  ! STOP
-  ! enddo
-
-  ! num1=0
-  ! do j=1,npoints
-  ! if (dem_c(j,ilev) .lt. 0. .or. dem_c(j,ilev) .gt. 1.) then
-  ! num1=num1+1
-  ! index1(num1)=j
-  ! end if
-  ! enddo
-  ! do jj=1,num1
-  ! j=index1(jj)
-  ! write(6,*)
-  ! &           ' error = convective cloud emissivity less than zero'
-  ! write(6,*)'or'
-  ! write(6,*)
-  ! &           ' error = convective cloud emissivity greater than 1'
-  ! write (6,*)
-  ! &          'j=',j,'ilev=',ilev,'dem_c(j,ilev) =',dem_c(j,ilev)
-  ! STOP
-  ! enddo
-  ! 13    continue
-
-
-  DO ibox = 1, ncol
-    DO j = 1, npoints
-      boxpos(j, ibox) = (ibox-.5)/ncol
-    END DO
-  END DO
-
-  ! ---------------------------------------------------!
-  ! Initialise working variables
-  ! ---------------------------------------------------!
-
-  ! Initialised frac_out to zero
-
-  DO ilev = 1, nlev
-    DO ibox = 1, ncol
-      DO j = 1, npoints
-        frac_out(j, ibox, ilev) = 0.0
-      END DO
-    END DO
-  END DO
-
-  ! IM
-  ! if (ncolprint.ne.0) then
-  ! write (6,'(a)') 'frac_out_pp_rev:'
-  ! do j=1,npoints,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write (6,'(8f5.2)')
-  ! &     ((frac_out(j,ibox,ilev),ibox=1,ncolprint),ilev=1,nlev)
-
-  ! enddo
-  ! write (6,'(a)') 'ncol:'
-  ! write (6,'(I3)') ncol
-  ! endif
-  ! if (ncolprint.ne.0) then
-  ! write (6,'(a)') 'last_frac_pp:'
-  ! do j=1,npoints,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write (6,'(8f5.2)') (tca(j,0))
-  ! enddo
-  ! endif
-
-  ! ---------------------------------------------------!
-  ! ALLOCATE CLOUD INTO BOXES, FOR NCOLUMNS, NLEVELS
-  ! frac_out is the array that contains the information
-  ! where 0 is no cloud, 1 is a stratiform cloud and 2 is a
-  ! convective cloud
-
-    !loop over vertical levels
-  DO ilev = 1, nlev
-
-    ! Initialise threshold
-
-    IF (ilev==1) THEN
-        ! If max overlap
-      IF (overlap==1) THEN
-          ! select pixels spread evenly
-          ! across the gridbox
-        DO ibox = 1, ncol
-          DO j = 1, npoints
-            threshold(j, ibox) = boxpos(j, ibox)
-          END DO
-        END DO
-      ELSE
-        DO ibox = 1, ncol
-          CALL ran0_vec(npoints, seed, ran)
-            ! select random pixels from the non-convective
-            ! part the gridbox ( some will be converted into
-            ! convective pixels below )
-          DO j = 1, npoints
-            threshold(j, ibox) = cca(j, ilev) + (1-cca(j,ilev))*ran(j)
-          END DO
-        END DO
-      END IF
-      ! IM
-      ! IF (ncolprint.ne.0) then
-      ! write (6,'(a)') 'threshold_nsf2:'
-      ! do j=1,npoints,1000
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
-      ! write (6,'(8f5.2)') (threshold(j,ibox),ibox=1,ncolprint)
-      ! enddo
-      ! ENDIF
-    END IF
-
-    ! IF (ncolprint.ne.0) then
-    ! write (6,'(a)') 'ilev:'
-    ! write (6,'(I2)') ilev
-    ! ENDIF
-
-    DO ibox = 1, ncol
-
-        ! All versions
-      DO j = 1, npoints
-        IF (boxpos(j,ibox)<=cca(j,ilev)) THEN
-          ! IM REAL           maxocc(j,ibox) = 1
-          maxocc(j, ibox) = 1.0
-        ELSE
-          ! IM REAL           maxocc(j,ibox) = 0
-          maxocc(j, ibox) = 0.0
-        END IF
-      END DO
-
-        ! Max overlap
-      IF (overlap==1) THEN
-        DO j = 1, npoints
-          threshold_min(j, ibox) = cca(j, ilev)
-          ! IM REAL           maxosc(j,ibox)=1
-          maxosc(j, ibox) = 1.0
-        END DO
-      END IF
-
-        ! Random overlap
-      IF (overlap==2) THEN
-        DO j = 1, npoints
-          threshold_min(j, ibox) = cca(j, ilev)
-          ! IM REAL           maxosc(j,ibox)=0
-          maxosc(j, ibox) = 0.0
-        END DO
-      END IF
-
-        ! Max/Random overlap
-      IF (overlap==3) THEN
-        DO j = 1, npoints
-          threshold_min(j, ibox) = max(cca(j,ilev), min(tca(j,ilev-1),tca(j, &
-            ilev)))
-          IF (threshold(j,ibox)<min(tca(j,ilev-1),tca(j, &
-              ilev)) .AND. (threshold(j,ibox)>cca(j,ilev))) THEN
-            ! IM REAL                maxosc(j,ibox)= 1
-            maxosc(j, ibox) = 1.0
-          ELSE
-            ! IM REAL                 maxosc(j,ibox)= 0
-            maxosc(j, ibox) = 0.0
-          END IF
-        END DO
-      END IF
-
-        ! Reset threshold
-      CALL ran0_vec(npoints, seed, ran)
-
-      DO j = 1, npoints
-        threshold(j, ibox) = &       !if max overlapped conv cloud
-          maxocc(j, ibox)*(boxpos(j,ibox)) + &   !else
-          (1-maxocc(j,ibox))*( &     !if max overlapped strat cloud
-          (maxosc(j,ibox))*( &       !threshold=boxpos
-          threshold(j,ibox))+ &      !else
-          (1-maxosc(j,ibox))*( &     !threshold_min=random[thrmin,1]
-          threshold_min(j,ibox)+(1-threshold_min(j,ibox))*ran(j)))
-      END DO
-
-    END DO ! ibox
-
-    ! Fill frac_out with 1's where tca is greater than the threshold
-
-    DO ibox = 1, ncol
-      DO j = 1, npoints
-        IF (tca(j,ilev)>threshold(j,ibox)) THEN
-          ! IM REAL             frac_out(j,ibox,ilev)=1
-          frac_out(j, ibox, ilev) = 1.0
-        ELSE
-          ! IM REAL             frac_out(j,ibox,ilev)=0
-          frac_out(j, ibox, ilev) = 0.0
-        END IF
-      END DO
-    END DO
-
-    ! Code to partition boxes into startiform and convective parts
-    ! goes here
-
-    DO ibox = 1, ncol
-      DO j = 1, npoints
-        IF (threshold(j,ibox)<=cca(j,ilev)) THEN
-            ! = 2 IF threshold le cca(j)
-          ! IM REAL                  frac_out(j,ibox,ilev) = 2
-          frac_out(j, ibox, ilev) = 2.0
-        ELSE
-            ! = the same IF NOT threshold le cca(j)
-          frac_out(j, ibox, ilev) = frac_out(j, ibox, ilev)
-        END IF
-      END DO
-    END DO
-
-    ! Set last_frac to tca at this level, so as to be tca
-    ! from last level next time round
-
-    ! IM
-    ! if (ncolprint.ne.0) then
-
-    ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
-    ! write (6,'(a)') 'last_frac:'
-    ! write (6,'(8f5.2)') (tca(j,ilev-1))
-
-    ! write (6,'(a)') 'cca:'
-    ! write (6,'(8f5.2)') (cca(j,ilev),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'max_overlap_cc:'
-    ! write (6,'(8f5.2)') (maxocc(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'max_overlap_sc:'
-    ! write (6,'(8f5.2)') (maxosc(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'threshold_min_nsf2:'
-    ! write (6,'(8f5.2)') (threshold_min(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'threshold_nsf2:'
-    ! write (6,'(8f5.2)') (threshold(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'frac_out_pp_rev:'
-    ! write (6,'(8f5.2)')
-    ! &       ((frac_out(j,ibox,ilev2),ibox=1,ncolprint),ilev2=1,nlev)
-    ! enddo
-    ! endif
-
-
-  END DO
-
-  ! ---------------------------------------------------!
-
-
-
-  ! ---------------------------------------------------!
-  ! COMPUTE CLOUD OPTICAL DEPTH FOR EACH COLUMN and
-  ! put into vector tau
-
-    !initialize tau and albedocld to zero
-  ! loop over nlev
-  DO ibox = 1, ncol
-    DO j = 1, npoints
-      tau(j, ibox) = 0.
-      albedocld(j, ibox) = 0.
-      boxtau(j, ibox) = 0.
-      boxptop(j, ibox) = 0.
-      box_cloudy(j, ibox) = .FALSE.
-    END DO
-  END DO
-
-    !compute total cloud optical depth for each column
-  DO ilev = 1, nlev
-      !increment tau for each of the boxes
-    DO ibox = 1, ncol
-      DO j = 1, npoints
-        ! IM REAL              if (frac_out(j,ibox,ilev).eq.1) then
-        IF (frac_out(j,ibox,ilev)==1.0) THEN
-          tau(j, ibox) = tau(j, ibox) + dtau_s(j, ilev)
-        END IF
-        ! IM REAL              if (frac_out(j,ibox,ilev).eq.2) then
-        IF (frac_out(j,ibox,ilev)==2.0) THEN
-          tau(j, ibox) = tau(j, ibox) + dtau_c(j, ilev)
-        END IF
-      END DO
-    END DO ! ibox
-  END DO ! ilev
-  ! IM
-  ! if (ncolprint.ne.0) then
-
-  ! do j=1,npoints ,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write(6,'(i2,1X,8(f7.2,1X))')
-  ! &          ilev,
-  ! &          (tau(j,ibox),ibox=1,ncolprint)
-  ! enddo
-  ! endif
-
-  ! ---------------------------------------------------!
-
-
-
-
-  ! ---------------------------------------------------!
-  ! COMPUTE INFRARED BRIGHTNESS TEMPERUATRES
-  ! AND CLOUD TOP TEMPERATURE SATELLITE SHOULD SEE
-
-  ! again this is only done if top_height = 1 or 3
-
-  ! fluxtop is the 10.5 micron radiance at the top of the
-  ! atmosphere
-  ! trans_layers_above is the total transmissivity in the layers
-  ! above the current layer
-  ! fluxtop_clrsky(j) and trans_layers_above_clrsky(j) are the clear
-  ! sky versions of these quantities.
-
-  IF (top_height==1 .OR. top_height==3) THEN
-
-
-      !----------------------------------------------------------------------
-      !
-      !             DO CLEAR SKY RADIANCE CALCULATION FIRST
-      !
-      !compute water vapor continuum emissivity
-      !this treatment follows Schwarkzopf and Ramasamy
-      !JGR 1999,vol 104, pages 9467-9499.
-      !the emissivity is calculated at a wavenumber of 955 cm-1,
-      !or 10.47 microns
-    wtmair = 28.9644
-    wtmh20 = 18.01534
-    navo = 6.023E+23
-    grav = 9.806650E+02
-    pstd = 1.013250E+06
-    t0 = 296.
-    ! IM
-    ! if (ncolprint .ne. 0)
-    ! &         write(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
-    DO ilev = 1, nlev
-      DO j = 1, npoints
-          !press and dpress are dyne/cm2 = Pascals *10
-        press(j) = pfull(j, ilev)*10.
-        dpress(j) = (phalf(j,ilev+1)-phalf(j,ilev))*10
-          !atmden = g/cm2 = kg/m2 / 10
-        atmden(j) = dpress(j)/grav
-        rvh20(j) = qv(j, ilev)*wtmair/wtmh20
-        wk(j) = rvh20(j)*navo*atmden(j)/wtmair
-        rhoave(j) = (press(j)/pstd)*(t0/at(j,ilev))
-        rh20s(j) = rvh20(j)*rhoave(j)
-        rfrgn(j) = rhoave(j) - rh20s(j)
-        tmpexp(j) = exp(-0.02*(at(j,ilev)-t0))
-        tauwv(j) = wk(j)*1.E-20*((0.0224697*rh20s(j)*tmpexp(j))+(3.41817E-7* &
-          rfrgn(j)))*0.98
-        dem_wv(j, ilev) = 1. - exp(-1.*tauwv(j))
-      END DO
-      ! IM
-      ! if (ncolprint .ne. 0) then
-      ! do j=1,npoints ,1000
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
-      ! write(6,'(i2,1X,3(f8.3,3X))') ilev,
-      ! &           qv(j,ilev)*(phalf(j,ilev+1)-phalf(j,ilev))/(grav/100.),
-      ! &           tauwv(j),dem_wv(j,ilev)
-      ! enddo
-      ! endif
-    END DO
-
-      !initialize variables
-    DO j = 1, npoints
-      fluxtop_clrsky(j) = 0.
-      trans_layers_above_clrsky(j) = 1.
-    END DO
-
-    DO ilev = 1, nlev
-      DO j = 1, npoints
-
-          ! Black body emission at temperature of the layer
-
-        bb(j) = 1/(exp(1307.27/at(j,ilev))-1.)
-          !bb(j)= 5.67e-8*at(j,ilev)**4
-
-          ! increase TOA flux by flux emitted from layer
-          ! times total transmittance in layers above
-
-        fluxtop_clrsky(j) = fluxtop_clrsky(j) + dem_wv(j, ilev)*bb(j)* &
-          trans_layers_above_clrsky(j)
-
-          ! update trans_layers_above with transmissivity
-          ! from this layer for next time around loop
-
-        trans_layers_above_clrsky(j) = trans_layers_above_clrsky(j)* &
-          (1.-dem_wv(j,ilev))
-
-
-      END DO
-      ! IM
-      ! if (ncolprint.ne.0) then
-      ! do j=1,npoints ,1000
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
-      ! write (6,'(a)') 'ilev:'
-      ! write (6,'(I2)') ilev
-
-      ! write (6,'(a)')
-      ! &        'emiss_layer,100.*bb(j),100.*f,total_trans:'
-      ! write (6,'(4(f7.2,1X))') dem_wv(j,ilev),100.*bb(j),
-      ! &             100.*fluxtop_clrsky(j),trans_layers_above_clrsky(j)
-      ! enddo
-      ! endif
-
-    END DO !loop over level
-
-    DO j = 1, npoints
-        !add in surface emission
-      bb(j) = 1/(exp(1307.27/skt(j))-1.)
-        !bb(j)=5.67e-8*skt(j)**4
-
-      fluxtop_clrsky(j) = fluxtop_clrsky(j) + emsfc_lw*bb(j)* &
-        trans_layers_above_clrsky(j)
-    END DO
-
-    ! IM
-    ! if (ncolprint.ne.0) then
-    ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
-    ! write (6,'(a)') 'id:'
-    ! write (6,'(a)') 'surface'
-
-    ! write (6,'(a)') 'emsfc,100.*bb(j),100.*f,total_trans:'
-    ! write (6,'(4(f7.2,1X))') emsfc_lw,100.*bb(j),
-    ! &      100.*fluxtop_clrsky(j),
-    ! &       trans_layers_above_clrsky(j)
-    ! enddo
-    ! endif
-
-
-      !
-      !           END OF CLEAR SKY CALCULATION
-      !
-      !----------------------------------------------------------------
-
-
-    ! IM
-    ! if (ncolprint.ne.0) then
-
-    ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
-    ! write (6,'(a)') 'ts:'
-    ! write (6,'(8f7.2)') (skt(j),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'ta_rev:'
-    ! write (6,'(8f7.2)')
-    ! &       ((at(j,ilev2),ibox=1,ncolprint),ilev2=1,nlev)
-
-    ! enddo
-    ! endif
-      !loop over columns
-    DO ibox = 1, ncol
-      DO j = 1, npoints
-        fluxtop(j, ibox) = 0.
-        trans_layers_above(j, ibox) = 1.
-      END DO
-    END DO
-
-    DO ilev = 1, nlev
-      DO j = 1, npoints
-          ! Black body emission at temperature of the layer
-
-        bb(j) = 1/(exp(1307.27/at(j,ilev))-1.)
-          !bb(j)= 5.67e-8*at(j,ilev)**4
-      END DO
-
-      DO ibox = 1, ncol
-        DO j = 1, npoints
-
-            ! emissivity for point in this layer
-          ! IM REAL             if (frac_out(j,ibox,ilev).eq.1) then
-          IF (frac_out(j,ibox,ilev)==1.0) THEN
-            dem(j, ibox) = 1. - ((1.-dem_wv(j,ilev))*(1.-dem_s(j,ilev)))
-            ! IM REAL             else if (frac_out(j,ibox,ilev).eq.2) then
-          ELSE IF (frac_out(j,ibox,ilev)==2.0) THEN
-            dem(j, ibox) = 1. - ((1.-dem_wv(j,ilev))*(1.-dem_c(j,ilev)))
-          ELSE
-            dem(j, ibox) = dem_wv(j, ilev)
-          END IF
-
-
-            ! increase TOA flux by flux emitted from layer
-            ! times total transmittance in layers above
-
-          fluxtop(j, ibox) = fluxtop(j, ibox) + dem(j, ibox)*bb(j)* &
-            trans_layers_above(j, ibox)
-
-            ! update trans_layers_above with transmissivity
-            ! from this layer for next time around loop
-
-          trans_layers_above(j, ibox) = trans_layers_above(j, ibox)* &
-            (1.-dem(j,ibox))
-
-        END DO ! j
-      END DO ! ibox
-
-      ! IM
-      ! if (ncolprint.ne.0) then
-      ! do j=1,npoints,1000
-      ! write (6,'(a)') 'ilev:'
-      ! write (6,'(I2)') ilev
-
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
-      ! write (6,'(a)') 'emiss_layer:'
-      ! write (6,'(8f7.2)') (dem(j,ibox),ibox=1,ncolprint)
-
-      ! write (6,'(a)') '100.*bb(j):'
-      ! write (6,'(8f7.2)') (100.*bb(j),ibox=1,ncolprint)
-
-      ! write (6,'(a)') '100.*f:'
-      ! write (6,'(8f7.2)')
-      ! &         (100.*fluxtop(j,ibox),ibox=1,ncolprint)
-
-      ! write (6,'(a)') 'total_trans:'
-      ! write (6,'(8f7.2)')
-      ! &          (trans_layers_above(j,ibox),ibox=1,ncolprint)
-      ! enddo
-      ! endif
-
-    END DO ! ilev
-
-
-    DO j = 1, npoints
-        !add in surface emission
-      bb(j) = 1/(exp(1307.27/skt(j))-1.)
-        !bb(j)=5.67e-8*skt(j)**4
-    END DO
-
-    DO ibox = 1, ncol
-      DO j = 1, npoints
-
-          !add in surface emission
-
-        fluxtop(j, ibox) = fluxtop(j, ibox) + emsfc_lw*bb(j)* &
-          trans_layers_above(j, ibox)
-
-      END DO
-    END DO
-
-    ! IM
-    ! if (ncolprint.ne.0) then
-
-    ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
-    ! write (6,'(a)') 'id:'
-    ! write (6,'(a)') 'surface'
-
-    ! write (6,'(a)') 'emiss_layer:'
-    ! write (6,'(8f7.2)') (dem(1,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') '100.*bb(j):'
-    ! write (6,'(8f7.2)') (100.*bb(j),ibox=1,ncolprint)
-
-    ! write (6,'(a)') '100.*f:'
-    ! write (6,'(8f7.2)') (100.*fluxtop(j,ibox),ibox=1,ncolprint)
-    ! end do
-    ! endif
-
-      !now that you have the top of atmosphere radiance account
-      !for ISCCP procedures to determine cloud top temperature
-
-      !account for partially transmitting cloud recompute flux
-      !ISCCP would see assuming a single layer cloud
-      !note choice here of 2.13, as it is primarily ice
-      !clouds which have partial emissivity and need the
-      !adjustment performed in this section
-      !
-      !If it turns out that the cloud brightness temperature
-      !is greater than 260K, then the liquid cloud conversion
-      !factor of 2.56 is used.
-      !
-      !Note that this is discussed on pages 85-87 of
-      !the ISCCP D level documentation (Rossow et al. 1996)
-
-    DO j = 1, npoints
-        !compute minimum brightness temperature and optical depth
-      btcmin(j) = 1./(exp(1307.27/(attrop(j)-5.))-1.)
-    END DO
-    DO ibox = 1, ncol
-      DO j = 1, npoints
-        transmax(j) = (fluxtop(j,ibox)-btcmin(j))/(fluxtop_clrsky(j)-btcmin(j &
-          ))
-          !note that the initial setting of tauir(j) is needed so that
-          !tauir(j) has a realistic value should the next if block be
-          !bypassed
-        tauir(j) = tau(j, ibox)*rec2p13
-        taumin(j) = -1.*log(max(min(transmax(j),0.9999999),0.001))
-
-      END DO
-
-      IF (top_height==1) THEN
-        DO j = 1, npoints
-          IF (transmax(j)>0.001 .AND. transmax(j)<=0.9999999) THEN
-            fluxtopinit(j) = fluxtop(j, ibox)
-            tauir(j) = tau(j, ibox)*rec2p13
-          END IF
-        END DO
-        DO icycle = 1, 2
-          DO j = 1, npoints
-            IF (tau(j,ibox)>(tauchk)) THEN
-              IF (transmax(j)>0.001 .AND. transmax(j)<=0.9999999) THEN
-                emcld(j, ibox) = 1. - exp(-1.*tauir(j))
-                fluxtop(j, ibox) = fluxtopinit(j) - ((1.-emcld(j, &
-                  ibox))*fluxtop_clrsky(j))
-                fluxtop(j, ibox) = max(1.E-06, (fluxtop(j,ibox)/emcld(j, &
-                  ibox)))
-                tb(j, ibox) = 1307.27/(log(1.+(1./fluxtop(j,ibox))))
-                IF (tb(j,ibox)>260.) THEN
-                  tauir(j) = tau(j, ibox)/2.56
-                END IF
-              END IF
-            END IF
-          END DO
-        END DO
-
-      END IF
-
-      DO j = 1, npoints
-        IF (tau(j,ibox)>(tauchk)) THEN
-            !cloudy box
-          tb(j, ibox) = 1307.27/(log(1.+(1./fluxtop(j,ibox))))
-          IF (top_height==1 .AND. tauir(j)<taumin(j)) THEN
-            tb(j, ibox) = attrop(j) - 5.
-            tau(j, ibox) = 2.13*taumin(j)
-          END IF
-        ELSE
-            !clear sky brightness temperature
-          tb(j, ibox) = 1307.27/(log(1.+(1./fluxtop_clrsky(j))))
-        END IF
-      END DO ! j
-    END DO ! ibox
-
-    ! IM
-    ! if (ncolprint.ne.0) then
-
-    ! do j=1,npoints,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
-
-    ! write (6,'(a)') 'attrop:'
-    ! write (6,'(8f7.2)') (attrop(j))
-
-    ! write (6,'(a)') 'btcmin:'
-    ! write (6,'(8f7.2)') (btcmin(j))
-
-    ! write (6,'(a)') 'fluxtop_clrsky*100:'
-    ! write (6,'(8f7.2)')
-    ! &      (100.*fluxtop_clrsky(j))
-
-    ! write (6,'(a)') '100.*f_adj:'
-    ! write (6,'(8f7.2)') (100.*fluxtop(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'transmax:'
-    ! write (6,'(8f7.2)') (transmax(ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'tau:'
-    ! write (6,'(8f7.2)') (tau(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'emcld:'
-    ! write (6,'(8f7.2)') (emcld(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'total_trans:'
-    ! write (6,'(8f7.2)')
-    ! &          (trans_layers_above(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'total_emiss:'
-    ! write (6,'(8f7.2)')
-    ! &          (1.0-trans_layers_above(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'total_trans:'
-    ! write (6,'(8f7.2)')
-    ! &          (trans_layers_above(j,ibox),ibox=1,ncolprint)
-
-    ! write (6,'(a)') 'ppout:'
-    ! write (6,'(8f7.2)') (tb(j,ibox),ibox=1,ncolprint)
-    ! enddo ! j
-    ! endif
-
-  END IF
-
-  ! ---------------------------------------------------!
-
-
-  ! ---------------------------------------------------!
-  ! DETERMINE CLOUD TOP PRESSURE
-
-  ! again the 2 methods differ according to whether
-  ! or not you use the physical cloud top pressure (top_height = 2)
-  ! or the radiatively determined cloud top pressure (top_height = 1 or 3)
-
-
-    !compute cloud top pressure
-  DO ibox = 1, ncol
-      !segregate according to optical thickness
-    IF (top_height==1 .OR. top_height==3) THEN
-        !find level whose temperature
-        !most closely matches brightness temperature
-      DO j = 1, npoints
-        nmatch(j) = 0
-      END DO
-      DO ilev = 1, nlev - 1
-        ! cdir nodep
-        DO j = 1, npoints
-          IF ((at(j,ilev)>=tb(j,ibox) .AND. at(j,ilev+1)<tb(j, &
-              ibox)) .OR. (at(j,ilev)<=tb(j,ibox) .AND. at(j,ilev+1)>tb(j, &
-              ibox))) THEN
-
-            nmatch(j) = nmatch(j) + 1
-            IF (abs(at(j,ilev)-tb(j,ibox))<abs(at(j,ilev+1)-tb(j,ibox))) THEN
-              match(j, nmatch(j)) = ilev
-            ELSE
-              match(j, nmatch(j)) = ilev + 1
-            END IF
-          END IF
-        END DO
-      END DO
-
-      DO j = 1, npoints
-        IF (nmatch(j)>=1) THEN
-          ptop(j, ibox) = pfull(j, match(j,nmatch(j)))
-          levmatch(j, ibox) = match(j, nmatch(j))
-        ELSE
-          IF (tb(j,ibox)<atmin(j)) THEN
-            ptop(j, ibox) = ptrop(j)
-            levmatch(j, ibox) = itrop(j)
-          END IF
-          IF (tb(j,ibox)>atmax(j)) THEN
-            ptop(j, ibox) = pfull(j, nlev)
-            levmatch(j, ibox) = nlev
-          END IF
-        END IF
-      END DO ! j
-
-    ELSE ! if (top_height .eq. 1 .or. top_height .eq. 3)
-
-      DO j = 1, npoints
-        ptop(j, ibox) = 0.
-      END DO
-      DO ilev = 1, nlev
-        DO j = 1, npoints
-          IF ((ptop(j,ibox)==0.) & ! IM  &
-                                   ! .and.(frac_out(j,ibox,ilev) .ne. 0))
-                                   ! then
-              .AND. (frac_out(j,ibox,ilev)/=0.0)) THEN
-            ptop(j, ibox) = pfull(j, ilev)
-            levmatch(j, ibox) = ilev
-          END IF
-        END DO
-      END DO
-    END IF
-
-    DO j = 1, npoints
-      IF (tau(j,ibox)<=(tauchk)) THEN
-        ptop(j, ibox) = 0.
-        levmatch(j, ibox) = 0
-      END IF
-    END DO
-
-  END DO
-
-
-
-  ! ---------------------------------------------------!
-
-
-
-  ! ---------------------------------------------------!
-  ! DETERMINE ISCCP CLOUD TYPE FREQUENCIES
-
-  ! Now that ptop and tau have been determined,
-  ! determine amount of each of the 49 ISCCP cloud
-  ! types
-
-  ! Also compute grid box mean cloud top pressure and
-  ! optical thickness.  The mean cloud top pressure and
-  ! optical thickness are averages over the cloudy
-  ! area only. The mean cloud top pressure is a linear
-  ! average of the cloud top pressures.  The mean cloud
-  ! optical thickness is computed by converting optical
-  ! thickness to an albedo, averaging in albedo units,
-  ! then converting the average albedo back to a mean
-  ! optical thickness.
-
-
-    !compute isccp frequencies
-
-    !reset frequencies
-  DO ilev = 1, 7
-    DO ilev2 = 1, 7
-      DO j = 1, npoints !
-        fq_isccp(j, ilev, ilev2) = 0.
-      END DO
-    END DO
-  END DO
-
-    !reset variables need for averaging cloud properties
-  DO j = 1, npoints
-    totalcldarea(j) = 0.
-    meanalbedocld(j) = 0.
-    meanptop(j) = 0.
-    meantaucld(j) = 0.
-  END DO ! j
-
-  boxarea = 1./real(ncol)
-
-    !determine optical depth category
-  ! IM       do 39 j=1,npoints
-  ! IM       do ibox=1,ncol
-  DO ibox = 1, ncol
-    DO j = 1, npoints
-
-      ! IM
-      ! CALL CPU_time(t1)
-      ! IM
-
-      IF (tau(j,ibox)>(tauchk) .AND. ptop(j,ibox)>0.) THEN
-        box_cloudy(j, ibox) = .TRUE.
-      END IF
-
-      ! IM
-      ! CALL CPU_time(t2)
-      ! print*,'IF tau t2 - t1',t2 - t1
-
-      ! CALL CPU_time(t1)
-      ! IM
-
-      IF (box_cloudy(j,ibox)) THEN
-
-          ! totalcldarea always diagnosed day or night
-        totalcldarea(j) = totalcldarea(j) + boxarea
-
-        IF (sunlit(j)==1) THEN
-
-            ! tau diagnostics only with sunlight
-
-          boxtau(j, ibox) = tau(j, ibox)
-
-            !convert optical thickness to albedo
-          albedocld(j, ibox) = real(invtau(min(nint(100.*tau(j,ibox)), &
-            45000)))
-
-            !contribute to averaging
-          meanalbedocld(j) = meanalbedocld(j) + albedocld(j, ibox)*boxarea
-
-        END IF
-
-      END IF
-
-      ! IM
-      ! CALL CPU_time(t2)
-      ! print*,'IF box_cloudy t2 - t1',t2 - t1
-
-      ! CALL CPU_time(t1)
-      ! IM BEG
-      ! IM           !convert ptop to millibars
-      ptop(j, ibox) = ptop(j, ibox)/100.
-
-      ! IM           !save for output cloud top pressure and optical
-      ! thickness
-      boxptop(j, ibox) = ptop(j, ibox)
-      ! IM END
-
-      ! IM BEG
-        !reset itau(j), ipres(j)
-      itau(j) = 0
-      ipres(j) = 0
-
-      IF (tau(j,ibox)<isccp_taumin) THEN
-        itau(j) = 1
-      ELSE IF (tau(j,ibox)>=isccp_taumin .AND. tau(j,ibox)<1.3) THEN
-        itau(j) = 2
-      ELSE IF (tau(j,ibox)>=1.3 .AND. tau(j,ibox)<3.6) THEN
-        itau(j) = 3
-      ELSE IF (tau(j,ibox)>=3.6 .AND. tau(j,ibox)<9.4) THEN
-        itau(j) = 4
-      ELSE IF (tau(j,ibox)>=9.4 .AND. tau(j,ibox)<23.) THEN
-        itau(j) = 5
-      ELSE IF (tau(j,ibox)>=23. .AND. tau(j,ibox)<60.) THEN
-        itau(j) = 6
-      ELSE IF (tau(j,ibox)>=60.) THEN
-        itau(j) = 7
-      END IF
-
-        !determine cloud top pressure category
-      IF (ptop(j,ibox)>0. .AND. ptop(j,ibox)<180.) THEN
-        ipres(j) = 1
-      ELSE IF (ptop(j,ibox)>=180. .AND. ptop(j,ibox)<310.) THEN
-        ipres(j) = 2
-      ELSE IF (ptop(j,ibox)>=310. .AND. ptop(j,ibox)<440.) THEN
-        ipres(j) = 3
-      ELSE IF (ptop(j,ibox)>=440. .AND. ptop(j,ibox)<560.) THEN
-        ipres(j) = 4
-      ELSE IF (ptop(j,ibox)>=560. .AND. ptop(j,ibox)<680.) THEN
-        ipres(j) = 5
-      ELSE IF (ptop(j,ibox)>=680. .AND. ptop(j,ibox)<800.) THEN
-        ipres(j) = 6
-      ELSE IF (ptop(j,ibox)>=800.) THEN
-        ipres(j) = 7
-      END IF
-      ! IM END
-
-      IF (sunlit(j)==1 .OR. top_height==3) THEN
-
-        ! IM         !convert ptop to millibars
-        ! IM           ptop(j,ibox)=ptop(j,ibox) / 100.
-
-        ! IM         !save for output cloud top pressure and optical
-        ! thickness
-        ! IM             boxptop(j,ibox) = ptop(j,ibox)
-
-        IF (box_cloudy(j,ibox)) THEN
-
-          meanptop(j) = meanptop(j) + ptop(j, ibox)*boxarea
-
-          ! IM             !reset itau(j), ipres(j)
-          ! IM           itau(j) = 0
-          ! IM           ipres(j) = 0
-
-          ! if (tau(j,ibox) .lt. isccp_taumin) then
-          ! itau(j)=1
-          ! else if (tau(j,ibox) .ge. isccp_taumin
-          ! &
-          ! &          .and. tau(j,ibox) .lt. 1.3) then
-          ! itau(j)=2
-          ! else if (tau(j,ibox) .ge. 1.3
-          ! &          .and. tau(j,ibox) .lt. 3.6) then
-          ! itau(j)=3
-          ! else if (tau(j,ibox) .ge. 3.6
-          ! &          .and. tau(j,ibox) .lt. 9.4) then
-          ! itau(j)=4
-          ! else if (tau(j,ibox) .ge. 9.4
-          ! &          .and. tau(j,ibox) .lt. 23.) then
-          ! itau(j)=5
-          ! else if (tau(j,ibox) .ge. 23.
-          ! &          .and. tau(j,ibox) .lt. 60.) then
-          ! itau(j)=6
-          ! else if (tau(j,ibox) .ge. 60.) then
-          ! itau(j)=7
-          ! end if
-
-          ! !determine cloud top pressure category
-          ! if (    ptop(j,ibox) .gt. 0.
-          ! &          .and.ptop(j,ibox) .lt. 180.) then
-          ! ipres(j)=1
-          ! else if(ptop(j,ibox) .ge. 180.
-          ! &          .and.ptop(j,ibox) .lt. 310.) then
-          ! ipres(j)=2
-          ! else if(ptop(j,ibox) .ge. 310.
-          ! &          .and.ptop(j,ibox) .lt. 440.) then
-          ! ipres(j)=3
-          ! else if(ptop(j,ibox) .ge. 440.
-          ! &          .and.ptop(j,ibox) .lt. 560.) then
-          ! ipres(j)=4
-          ! else if(ptop(j,ibox) .ge. 560.
-          ! &          .and.ptop(j,ibox) .lt. 680.) then
-          ! ipres(j)=5
-          ! else if(ptop(j,ibox) .ge. 680.
-          ! &          .and.ptop(j,ibox) .lt. 800.) then
-          ! ipres(j)=6
-          ! else if(ptop(j,ibox) .ge. 800.) then
-          ! ipres(j)=7
-          ! end if
-
-            !update frequencies
-          IF (ipres(j)>0 .AND. itau(j)>0) THEN
-            fq_isccp(j, itau(j), ipres(j)) = fq_isccp(j, itau(j), ipres(j)) + &
-              boxarea
-          END IF
-
-          ! IM calcul stats regime dynamique BEG
-          ! iw(j) = int((w(j)-wmin)/pas_w) +1
-          ! pctj(itau(j),ipres(j),iw(j))=.FALSE.
-          ! !update frequencies W500
-          ! if (pct_ocean(j)) then
-          ! if (ipres(j) .gt. 0.and.itau(j) .gt. 0) then
-          ! if (iw(j) .gt. int(wmin).and.iw(j) .le. iwmx) then
-          ! print*,' ISCCP iw=',iw(j),j
-          ! fq_dynreg(itau(j),ipres(j),iw(j))=
-          ! &          fq_dynreg(itau(j),ipres(j),iw(j))+
-          ! &          boxarea
-          ! &          fq_isccp(j,itau(j),ipres(j))
-          ! pctj(itau(j),ipres(j),iw(j))=.TRUE.
-          ! nfq_dynreg(itau(j),ipres(j),iw(j))=
-          ! &          nfq_dynreg(itau(j),ipres(j),iw(j))+1.
-          ! end if
-          ! end if
-          ! end if
-          ! IM calcul stats regime dynamique END
-        END IF !IM boxcloudy
-
-      END IF !IM sunlit
-
-      ! IM
-      ! CALL CPU_time(t2)
-      ! print*,'IF sunlit boxcloudy t2 - t1',t2 - t1
-      ! IM
-    END DO !IM ibox/j
-
-
-    ! IM ajout stats s/ W500 BEG
-    ! IM ajout stats s/ W500 END
-
-    ! if(j.EQ.6722) then
-    ! print*,' ISCCP',w(j),iw(j),ipres(j),itau(j)
-    ! endif
-
-    ! if (pct_ocean(j)) then
-    ! if (ipres(j) .gt. 0.and.itau(j) .gt. 0) then
-    ! if (iw(j) .gt. int(wmin).and.iw(j) .le. iwmx) then
-    ! if(pctj(itau(j),ipres(j),iw(j))) THEN
-    ! nfq_dynreg(itau(j),ipres(j),iw(j))=
-    ! &    nfq_dynreg(itau(j),ipres(j),iw(j))+1.
-    ! if(itau(j).EQ.4.AND.ipres(j).EQ.2.AND.
-    ! &    iw(j).EQ.10) then
-    ! PRINT*,' isccp AVANT',
-    ! &    nfq_dynreg(itau(j),ipres(j),iw(j)),
-    ! &    fq_dynreg(itau(j),ipres(j),iw(j))
-    ! endif
-    ! endif
-    ! endif
-    ! endif
-    ! endif
-
-  END DO
-    !compute mean cloud properties
-  ! IM j/ibox
-  DO j = 1, npoints
-    IF (totalcldarea(j)>0.) THEN
-      meanptop(j) = meanptop(j)/totalcldarea(j)
-      IF (sunlit(j)==1) THEN
-        meanalbedocld(j) = meanalbedocld(j)/totalcldarea(j)
-        meantaucld(j) = tautab(min(255,max(1,nint(meanalbedocld(j)))))
-      END IF
-    END IF
-  END DO ! j
-
-  ! IM ajout stats s/ W500 BEG
-  ! do nw = 1, iwmx
-  ! do l = 1, 7
-  ! do k = 1, 7
-  ! if (nfq_dynreg(k,l,nw).GT.0.) then
-  ! fq_dynreg(k,l,nw) = fq_dynreg(k,l,nw)/nfq_dynreg(k,l,nw)
-  ! if(k.EQ.4.AND.l.EQ.2.AND.nw.EQ.10) then
-  ! print*,' isccp APRES',nfq_dynreg(k,l,nw),
-  ! &   fq_dynreg(k,l,nw)
-  ! endif
-  ! else
-  ! if(fq_dynreg(k,l,nw).NE.0.) then
-  ! print*,'nfq_dynreg = 0 tau,pc,nw',k,l,nw,fq_dynreg(k,l,nw)
-  ! endif
-  ! fq_dynreg(k,l,nw) = -1.E+20
-  ! nfq_dynreg(k,l,nw) = 1.E+20
-  ! end if
-  ! enddo !k
-  ! enddo !l
-  ! enddo !nw
-  ! IM ajout stats s/ W500 END
-  ! ---------------------------------------------------!
-
-  ! ---------------------------------------------------!
-  ! OPTIONAL PRINTOUT OF DATA TO CHECK PROGRAM
-
-  ! cIM
-  ! if (debugcol.ne.0) then
-
-  ! do j=1,npoints,debugcol
-
-  ! !produce character output
-  ! do ilev=1,nlev
-  ! do ibox=1,ncol
-  ! acc(ilev,ibox)=0
-  ! enddo
-  ! enddo
-
-  ! do ilev=1,nlev
-  ! do ibox=1,ncol
-  ! acc(ilev,ibox)=frac_out(j,ibox,ilev)*2
-  ! if (levmatch(j,ibox) .eq. ilev)
-  ! &                 acc(ilev,ibox)=acc(ilev,ibox)+1
-  ! enddo
-  ! enddo
-
-    !print test
-
-  ! write(ftn09,11) j
-  ! 11        format('ftn09.',i4.4)
-  ! open(9, FILE=ftn09, FORM='FORMATTED')
-
-  ! write(9,'(a1)') ' '
-  ! write(9,'(10i5)')
-  ! &                  (ilev,ilev=5,nlev,5)
-  ! write(9,'(a1)') ' '
-
-  ! do ibox=1,ncol
-  ! write(9,'(40(a1),1x,40(a1))')
-  ! &           (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev)
-  ! &           ,(cchar(acc(ilev,ibox)+1),ilev=1,nlev)
-  ! end do
-  ! close(9)
-
-  ! IM
-  ! if (ncolprint.ne.0) then
-  ! write(6,'(a1)') ' '
-  ! write(6,'(a2,1X,5(a7,1X),a50)')
-  ! &                  'ilev',
-  ! &                  'pfull','at',
-  ! &                  'cc*100','dem_s','dtau_s',
-  ! &                  'cchar'
-
-  ! do 4012 ilev=1,nlev
-  ! write(6,'(60i2)') (box(i,ilev),i=1,ncolprint)
-  ! write(6,'(i2,1X,5(f7.2,1X),50(a1))')
-  ! &                  ilev,
-  ! &                  pfull(j,ilev)/100.,at(j,ilev),
-  ! &                  cc(j,ilev)*100.0,dem_s(j,ilev),dtau_s(j,ilev)
-  ! &                  ,(cchar(acc(ilev,ibox)+1),ibox=1,ncolprint)
-  ! 4012           continue
-  ! write (6,'(a)') 'skt(j):'
-  ! write (6,'(8f7.2)') skt(j)
-
-  ! write (6,'(8I7)') (ibox,ibox=1,ncolprint)
-
-  ! write (6,'(a)') 'tau:'
-  ! write (6,'(8f7.2)') (tau(j,ibox),ibox=1,ncolprint)
-
-  ! write (6,'(a)') 'tb:'
-  ! write (6,'(8f7.2)') (tb(j,ibox),ibox=1,ncolprint)
-
-  ! write (6,'(a)') 'ptop:'
-  ! write (6,'(8f7.2)') (ptop(j,ibox),ibox=1,ncolprint)
-  ! endif
-
-  ! enddo
-
-  ! end if
-
-  RETURN
-END SUBROUTINE isccp_cloud_types
+link ../phylmd/isccp_cloud_types.F90
Index: LMDZ6/trunk/libf/phylmdiso/limit_slab.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/limit_slab.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/limit_slab.F90	(revision 3940)
@@ -1,195 +1,1 @@
-! $Header$
-
-SUBROUTINE limit_slab(itime, dtime, jour, lmt_bils, diff_sst, diff_siv)
-
-  USE dimphy
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-  USE mod_phys_lmdz_para
-  USE netcdf 
-  USE indice_sol_mod
-  USE ocean_slab_mod, ONLY: nslay
-
-  IMPLICIT NONE
-
-  INCLUDE "clesphys.h"
-
-! In- and ouput arguments
-!****************************************************************************************
-  INTEGER, INTENT(IN) :: itime   ! numero du pas de temps courant
-  INTEGER, INTENT(IN) :: jour    ! jour a lire dans l'annee
-  REAL   , INTENT(IN) :: dtime   ! pas de temps de la physique (en s)
-  REAL, DIMENSION(klon), INTENT(OUT) ::  diff_sst, diff_siv
-  REAL, DIMENSION(klon,nslay), INTENT(OUT) :: lmt_bils
-
-! Locals variables with attribute SAVE
-!****************************************************************************************
-  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_siv_save, diff_sst_save
-  REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: bils_save
-!$OMP THREADPRIVATE(bils_save, diff_sst_save, diff_siv_save)
-
-! Locals variables
-!****************************************************************************************
-  INTEGER                  :: lmt_pas   
-  INTEGER                  :: nvarid, nid, ierr, i
-  INTEGER, DIMENSION(2)    :: start, epais 
-  REAL, DIMENSION(klon_glo):: sst_l_glo, sst_lp1_glo, diff_sst_glo
-  REAL, DIMENSION(klon_glo):: siv_l_glo, siv_lp1_glo, diff_siv_glo
-  REAL, DIMENSION(klon_glo,nslay):: bils_glo
-  CHARACTER (len = 20)     :: modname = 'limit_slab'
-  CHARACTER*2 str2
-  LOGICAL                  :: read_bils,read_sst,read_siv
-
-! End declaration
-!****************************************************************************************
-
-  ! calculate number of time steps for one day
-  lmt_pas = NINT(86400./dtime)
-  
-! Initialize saved variables
-     IF (.NOT. ALLOCATED(bils_save)) THEN
-        ALLOCATE(bils_save(klon,nslay), diff_sst_save(klon), diff_siv_save(klon), stat=ierr)
-        IF (ierr /= 0) CALL abort_physic('limit_slab', 'pb in allocation',1)
-     END IF
-
-  ! F. Codron 5/14: add defaults for bils, diff_sst (0)
-  IF (MOD(itime-1, lmt_pas) == 0) THEN   ! time to read
-!$OMP MASTER  ! Only master thread
-     IF (is_mpi_root) THEN ! Only master processus
-        print*,'in limit_slab time to read, itime=',itime
-        read_bils=.TRUE.
-        read_sst=.TRUE.
-        read_siv=.TRUE.
-        
-        ierr = NF90_OPEN ('limit_slab.nc', NF90_NOWRITE, nid)
-        IF (ierr /= NF90_NOERR) THEN
-            PRINT *,'LIMIT_SLAB file not found'
-            read_bils=.FALSE.
-            read_sst=.FALSE.
-            read_siv=.FALSE.
-        ELSE ! read file
-        
-        ! La tranche de donnees a lire:
-        start(1) = 1
-        start(2) = jour
-        epais(1) = klon_glo
-        epais(2) = 1
-
-!****************************************************************************************
-! 2) Read bils and SST/ ice volume tendency
-!
-!****************************************************************************************
-!
-! Read bils_glo
-        bils_glo(:,:)=0.
-        ! First read first layer
-        ! try first "BILS_OCE01"
-        ierr = NF90_INQ_VARID(nid, 'BILS_OCE01', nvarid)
-        IF (ierr /= NF90_NOERR) THEN
-            ! Else BILS_OCE
-            ierr = NF90_INQ_VARID(nid, 'BILS_OCE', nvarid)
-            IF (ierr /= NF90_NOERR) THEN
-              read_bils=.FALSE.
-            ELSE
-              ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,1),start,epais)
-              IF (ierr /= NF90_NOERR) read_bils=.FALSE.
-            ENDIF
-        ELSE
-            ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,1),start,epais)
-            IF (ierr /= NF90_NOERR) read_bils=.FALSE.
-        END IF
-        ! Try next layers if more than 1
-        IF ((nslay.GT.1).AND.read_bils) THEN
-          DO i=2,nslay
-            WRITE(str2,'(i2.2)') i
-            ierr = NF90_INQ_VARID(nid,'BILS_OCE'//str2, nvarid)
-            IF (ierr.EQ.NF90_NOERR) THEN
-              ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,i),start,epais)
-            ENDIF
-            IF (ierr /= NF90_NOERR) THEN
-              print *,'WARNING : BILS_OCE not found for layer 2'
-            ENDIF
-          ENDDO
-        ENDIF
-
-! Read sst_glo for this day
-        ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
-        IF (ierr /= NF90_NOERR)  THEN
-            read_sst=.FALSE.
-        ELSE
-            ierr = NF90_GET_VAR(nid,nvarid,sst_l_glo,start,epais)
-            IF (ierr /= NF90_NOERR) read_sst=.FALSE.
-! Read sst_glo for one day ahead
-            start(2) = jour + 1
-            IF (start(2) > 360) start(2)=1
-            ierr = NF90_GET_VAR(nid,nvarid,sst_lp1_glo,start,epais)
-            IF (ierr /= NF90_NOERR) read_sst=.FALSE.
-        END IF
-
-! Read siv_glo for this day
-        ierr = NF90_INQ_VARID(nid, 'SICV', nvarid)
-        IF (ierr /= NF90_NOERR)  THEN
-            read_siv=.FALSE.
-        ELSE
-            start(2) = jour
-            ierr = NF90_GET_VAR(nid,nvarid,siv_l_glo,start,epais)
-            IF (ierr /= NF90_NOERR) read_siv=.FALSE.
-! Read siv_glo for one day ahead
-            start(2) = jour + 1
-            IF (start(2) > 360) start(2)=1
-            ierr = NF90_GET_VAR(nid,nvarid,siv_lp1_glo,start,epais)
-            IF (ierr /= NF90_NOERR) read_siv=.FALSE.
-        END IF
-
-!****************************************************************************************
-! 5) Close file and distribute variables to all processus
-!
-!****************************************************************************************
-        ierr = NF90_CLOSE(nid)
-        IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
-        END IF ! Read File 
-        IF (read_sst) THEN
-! Calculate difference in temperature between this day and one ahead
-            DO i=1, klon_glo
-               diff_sst_glo(i) = sst_lp1_glo(i) - sst_l_glo(i)
-            END DO
-        END IF !read_sst
-        IF (read_siv) THEN
-! Calculate difference in temperature between this day and one ahead
-            DO i=1, klon_glo
-               diff_siv_glo(i) = siv_lp1_glo(i) - siv_l_glo(i)
-            END DO
-        END IF !read_siv
-     ENDIF ! is_mpi_root
-
-!$OMP END MASTER
-!$OMP BARRIER
-       
-! Send fields to all processes
-! Give default values if needed
-     CALL bcast(read_bils)
-     CALL bcast(read_sst)
-     CALL bcast(read_siv)
-     PRINT *,'limit_slab sst',read_sst,'siv',read_siv,'qflux',read_bils
-     IF (read_bils) THEN
-         CALL Scatter(bils_glo, bils_save)
-     ELSE
-         bils_save(:,:)=0.
-     END IF
-     IF (read_sst) THEN
-         CALL Scatter(diff_sst_glo, diff_sst_save)
-     ELSE
-         diff_sst_save(:)=0.
-     END IF
-     IF (read_siv) THEN
-         CALL Scatter(diff_siv_glo, diff_siv_save)
-     ELSE
-         diff_siv_save(:)=0.
-     END IF
-     
-  ENDIF ! time to read
-
-  lmt_bils(:,:) = bils_save(:,:)
-  diff_sst(:) = diff_sst_save(:)
-  diff_siv(:) = diff_siv_save(:)
-
-END SUBROUTINE limit_slab
+link ../phylmd/limit_slab.F90
Index: LMDZ6/trunk/libf/phylmdiso/lsc_scav.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/lsc_scav.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/lsc_scav.F90	(revision 3940)
@@ -1,300 +1,1 @@
-!$Id $
-
-SUBROUTINE lsc_scav(pdtime,it,iflag_lscav,  &
-!jyg<
-                    aerosol,  &
-!>jyg
-                    oliq,flxr,flxs,rneb,beta_fisrt,  &
-                    beta_v1,pplay,paprs,t,tr_seri,d_tr_insc,          &
-                    d_tr_bcscav,d_tr_evap,qPrls) 
-  USE ioipsl
-  USE dimphy
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-  USE traclmdz_mod
-  USE infotrac_phy,ONLY : nbtr
-  USE iophy
-  IMPLICIT NONE 
-!=====================================================================
-! Objet : depot humide (lessivage et evaporation) de traceurs
-! Inspired by routines of Olivier Boucher (mars 1998)
-! author R. Pilon 10 octobre 2012
-! last modification 16/01/2013 (reformulation partie evaporation)
-!=====================================================================
-
-  include "chem.h"
-  include "YOMCST.h"
-  include "YOECUMF.h" 
-
-  REAL,INTENT(IN)                        :: pdtime ! time step (s)
-  INTEGER,INTENT(IN)                     :: it     ! tracer number
-  INTEGER,INTENT(IN)                     :: iflag_lscav ! LS scavenging param:
-!                                             3=Reddy_Boucher2004, 4=3+RPilon.
-  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxr     ! flux precipitant de pluie
-  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxs     ! flux precipitant de neige
-  REAL,INTENT(IN)                        :: oliq ! contenu en eau liquide dans le nuage (kg/kg)
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: rneb
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay    ! pression
-  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs    ! pression
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: t        ! temperature
-! tracers
-  LOGICAL,DIMENSION(nbtr), INTENT(IN)         :: aerosol
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)   :: tr_seri        ! q de traceur  
-  REAL,DIMENSION(klon,klev),INTENT(IN)        :: beta_fisrt     ! taux de conversion de l'eau cond
-  REAL,DIMENSION(klon,klev),INTENT(OUT)       :: beta_v1        ! -- (originale version)
-  REAL,DIMENSION(klon)                        :: his_dh         ! tendance de traceur integre verticalement
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)  :: d_tr_insc      ! tendance du traceur 
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)  :: d_tr_bcscav  ! tendance de traceur
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)  :: d_tr_evap
-  REAL,DIMENSION(klon,nbtr),INTENT(OUT)       :: qPrls      !jyg: concentration tra dans pluie LS a la surf.
-  REAL :: dxin,dxev                              ! tendance temporaire de traceur incloud
-  REAL,DIMENSION(klon,klev) :: dxbc       ! tendance temporaire de traceur bc
-
-
-!  variables locales      
- LOGICAL,SAVE :: debut=.true.
-!$OMP THREADPRIVATE(debut)
-!
-  REAL,PARAMETER :: henry=1.4  ! constante de Henry en mol/l/atm ~1.4 for gases
-  REAL           :: henry_t    !  constante de Henry a T t  (mol/l/atm)
-  REAL,PARAMETER :: kk=2900.   ! coefficient de dependence en T (K)
-  REAL :: f_a     !  rapport de la phase aqueuse a la phase gazeuse
-  REAL :: beta    !  taux de conversion de l'eau en pluie
-
-  INTEGER :: i, k
-  REAL,DIMENSION(klon,klev)    :: scav  !  water liquid content / fraction aqueuse du constituant
-  REAL,DIMENSION(klon,klev)    :: zrho
-  REAL,DIMENSION(klon,klev)    :: zdz
-  REAL,DIMENSION(klon,klev)    :: zmass ! layer mass
-
-  REAL           :: frac_ev       ! cste pour la reevaporation : dropplet shrinking
-!  frac_ev = frac_gas ou frac_aer
-  REAL,PARAMETER :: frac_gas=1.0  ! cste pour la reevaporation pour les gaz
-  REAL           :: frac_aer      ! cste pour la reevaporation pour les particules
-  REAL,DIMENSION(klon,klev) :: deltaP     ! P(i+1)-P(i)
-  REAL,DIMENSION(klon,klev) :: beta_ev    !  dP/P(i+1)
-
-!  101.325  m3/l x Pa/atm
-!  R        Pa.m3/mol/K
-!   cste de dissolution pour le depot humide
-  REAL,SAVE :: frac_fine_scav
-  REAL,SAVE :: frac_coar_scav
-!$OMP THREADPRIVATE(frac_fine_scav, frac_coar_scav)
-
-! below-cloud scav variables
-! aerosol : alpha_r=0.001, gas 0.001  (Pruppacher & Klett 1967)
-  REAL,SAVE :: alpha_r  !  coefficient d'impaction pour la pluie
-  REAL,SAVE :: alpha_s  !  coefficient d'impaction pour la neige  
-  REAL,SAVE :: R_r      !  mean raindrop radius (m) 
-  REAL,SAVE :: R_s      !  mean snow crystal radius (m)
-!$OMP THREADPRIVATE(alpha_r, alpha_s, R_r, R_s)
-  REAL           :: pr, ps, ice, water
-  real :: conserv
-!
-!!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!!
-!!  logical,save  :: inscav_fisrt
-!!! $OMP THREADPRIVATE(inscav_first)
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  IF (debut) THEN
-!
-!  inscav_fisrt=.true.
-!  call getin('inscav_fisrt',inscav_fisrt)
-!  if(inscav_fisrt) then 
-!   print*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
-!  else
-!   print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
-!  endif
-!
-      alpha_r=0.001        !  coefficient d'impaction pour la pluie
-      alpha_s=0.01         !  coefficient d'impaction pour la neige  
-      R_r=0.001            !  mean raindrop radius (m) 
-      R_s=0.001            !  mean snow crystal radius (m)
-      frac_fine_scav=0.7
-      frac_coar_scav=0.7
-!     frac_aer=0.5 ~ droplet size shrinks by evap
-      frac_aer=0.5
-!
-      OPEN(99,file='lsc_scav_param.data',status='old', &
-                form='formatted',err=9999)
-      READ(99,*,end=9998)  alpha_r
-      READ(99,*,end=9998)  alpha_s
-      READ(99,*,end=9998)  R_r
-      READ(99,*,end=9998)  R_s
-      READ(99,*,end=9998)  frac_fine_scav
-      READ(99,*,end=9998)  frac_coar_scav
-      READ(99,*,end=9998)  frac_aer
-9998  Continue
-      CLOSE(99)
-9999  Continue
-
-   print*,'alpha_r',alpha_r
-   print*,'alpha_s',alpha_s
-   print*,'R_r',R_r
-   print*,'R_s',R_s
-   print*,'frac_fine_scav',frac_fine_scav
-   print*,'frac_coar_scav',frac_coar_scav
-   print*,'frac_aer ev',frac_aer
-
-!
-  ENDIF !(debut)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-! initialization
-  dxin=0.
-  dxev=0.
-  beta_ev=0.
-
-  DO i=1,klon
-   his_dh(i)=0.
-  ENDDO
-
-  DO k=1,klev
-   DO i=1, klon 
-    dxbc(i,k)=0.
-    beta_v1(i,k)=0.
-    deltaP(i,k)=0.
-   ENDDO
-  ENDDO
-
-  DO k=1,klev
-    DO i=1, klon
-     d_tr_insc(i,k,it)=0.
-     d_tr_bcscav(i,k,it)=0.
-     d_tr_evap(i,k,it)=0.
-    ENDDO
-  ENDDO
-
-!  pressure and size of the layer
-  DO k=klev-1, 1, -1
-   DO i=1, klon 
-     zrho(i,k)=pplay(i,k)/t(i,k)/RD   
-     zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
-     zmass(i,k)=(paprs(i,k)-paprs(i,k+1))/RG
-   ENDDO
-  ENDDO
-
-!jyg<
-!!    IF (it.gt.1) THEN                               !  aerosol   
-!! Temporary correction: all non-aerosol tracers are dealt with in the same way.
-!! Should be updated once it has been decided how gases should be dealt with.
-    IF (aerosol(it)) THEN
-!>jyg
-      frac_ev=frac_aer
-    ELSE                                                !  gas
-      frac_ev=frac_gas
-    ENDIF
-
-!jyg<
-!!    IF (it.gt.1) THEN                               !  aerosol   
-    IF (aerosol(it)) THEN
-!>jyg
-     DO k=1, klev
-      DO i=1, klon 
-       scav(i,k)=frac_fine_scav
-      ENDDO 
-     ENDDO
-    ELSE                  ! gas
-     DO k=1, klev
-      DO i=1, klon 
-       henry_t=henry*exp(-kk*(1./298.-1./t(i,k)))    !  mol/l/atm
-       f_a=henry_t/101.325*R*t(i,k)*oliq*zrho(i,k)/rho_water
-       scav(i,k)=f_a/(1.+f_a)
-      ENDDO 
-     ENDDO
-    ENDIF
-
-   DO k=klev-1, 1, -1
-    DO i=1, klon 
-!  incloud scavenging
-!   if(inscav_fisrt) then 
-   if (iflag_lscav .eq. 4) then
-      beta=beta_fisrt(i,k)*rneb(i,k)
-   else
-      beta=flxr(i,k)-flxr(i,k+1)+flxs(i,k)-flxs(i,k+1)
-!      beta=beta/zdz(i,k)/oliq/zrho(i,k)
-      beta=beta/zmass(i,k)/oliq
-      beta=MAX(0.,beta)
-   endif ! (iflag_lscav .eq. 4)
-   beta_v1(i,k)=beta    !! for output
-!
-      dxin=tr_seri(i,k,it)*(exp(-scav(i,k)*beta*pdtime)-1.)
-!      his_dh(i)=his_dh(i)-dxin*zrho(i,k)*zdz(i,k)/pdtime !  kg/m2/s
-      his_dh(i)=his_dh(i)-dxin*zmass(i,k)/pdtime !  kg/m2/s
-      d_tr_insc(i,k,it)=dxin
-
-!  below-cloud impaction
-!jyg<
-!!    IF (it.eq.1) THEN
-    IF (.NOT.aerosol(it)) THEN
-!>jyg
-      d_tr_bcscav(i,k,it)=0.
-    ELSE
-     pr=0.5*(flxr(i,k)+flxr(i,k+1))
-     ps=0.5*(flxs(i,k)+flxs(i,k+1))
-     water=pr*alpha_r/R_r/rho_water
-     ice=ps*alpha_s/R_s/rho_ice
-     dxbc(i,k)=-3./4.*tr_seri(i,k,it)*pdtime*(water+ice)
-!   add tracers from below cloud scav in his_dh
-     his_dh(i)=his_dh(i)-dxbc(i,k)*zmass(i,k)/pdtime !  kg/m2/s
-     d_tr_bcscav(i,k,it)=dxbc(i,k)
-    ENDIF
-
-!  reevaporation
-      deltaP(i,k)=flxr(i,k+1)+flxs(i,k+1)-flxr(i,k)-flxs(i,k)
-      deltaP(i,k)=max(deltaP(i,k),0.)
-
-      if(flxr(i,k+1)+flxs(i,k+1).gt.1.e-16) then
-       beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1))
-      else
-       beta_ev(i,k)=0.
-      endif
-
-      beta_ev(i,k)=max(min(1.,beta_ev(i,k)),0.)
-
-!jyg
-      
-      if(abs(1-(1-frac_ev)*beta_ev(i,k)).gt.1.e-16) then
-! remove tracers from precipitation owing to release by evaporation in his_dh
-!      dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) &
-      dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zmass(i,k)) &
-                                      /(1 -(1-frac_ev)*beta_ev(i,k))
-       his_dh(i)=his_dh(i)*(1 - frac_ev*beta_ev(i,k) / (1 -(1-frac_ev)*beta_ev(i,k)))
-      else
-!       dxev=his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k))
-       dxev=his_dh(i) *pdtime/(zmass(i,k))
-       his_dh(i)=0.
-      endif
-!      print*,  k, 'beta_ev',beta_ev
-! remove tracers from precipitation owing to release by evaporation in his_dh
-!!      dxev=frac_ev*deltaP(i,k)*pdtime * his_dh(i) /(zrho(i,k)*zdz(i,k))
-!rplmd
-!!      dxev=frac_ev*deltaP(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) &
-!!                                      /max(flxr(i,k)+flxs(i,k),1.e-16)
-
-
-      d_tr_evap(i,k,it)=dxev
-!!     tendency is further added in phytrac x = x + dx
-    ENDDO !!  do i
-   ENDDO  !! do k
-
-!jyg (20130114)
-   DO i = 1,klon
-     qPrls(i,it) = his_dh(i)/max(flxr(i,1)+flxs(i,1),1.e-16)
-   ENDDO
-!jyg end
-
-
-! test de conservation
-      conserv=0.
-!      DO k= klev,1,-1
-!        DO i=1, klon
-!         conserv=conserv+d_tr_insc(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG &
-!                +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG  &
-!                +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG
-!      if(it.eq.3) write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
-!      k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it)
-!       ENDDO
-!     ENDDO
-
-END SUBROUTINE lsc_scav
+link ../phylmd/lsc_scav.F90
Index: LMDZ6/trunk/libf/phylmdiso/macv2sp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/macv2sp.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/macv2sp.F90	(revision 3940)
@@ -1,176 +1,1 @@
-SUBROUTINE MACv2SP(pphis,pplay,paprs,xlon,xlat,tau_allaer,piz_allaer,cg_allaer)
-  !
-  !--routine to read the MACv2SP plume and compute optical properties
-  !--requires flag_aerosol = 7
-  !--feeds into aerosol optical properties and newmicro cloud droplet size if ok_cdnc activated
-  !--for this one needs to feed natural (pre-industrial) aerosols twice for nat and 1980 files
-  !--pre-ind aerosols (index=1) are not changed, present-day aerosols (index=2) are incremented
-  !--uses model year so year_cur needs to be correct in the model simulation
-  !
-  !--aod_prof = AOD per layer 
-  !--ssa_prof = SSA 
-  !--asy_prof = asymetry parameter
-  !--dNovrN   = enhancement factor for CDNC
-  !
-  USE mo_simple_plumes, ONLY: sp_aop_profile
-  USE phys_cal_mod, ONLY : year_cur, day_cur, year_len
-  USE dimphy
-  USE aero_mod
-  USE phys_local_var_mod, ONLY: t_seri, od443aer, od550aer, od865aer, ec550aer, dryod550aer, od550lt1aer, dNovrN
-  !!USE YOMCST, ONLY : RD, RG
-  !
-  IMPLICIT NONE
-  !
-  include "YOMCST.h"
-  ! 
-  REAL,DIMENSION(klon),INTENT(IN)        :: pphis   ! Geopotentiel de surface
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour les interfaces de chaque couche (en Pa)
-  REAL,DIMENSION(klon),INTENT(IN)        :: xlat    ! latitudes pour chaque point
-  REAL,DIMENSION(klon),INTENT(IN)        :: xlon    ! longitudes pour chaque point
-  !
-  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: tau_allaer !  epaisseur optique aerosol
-  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: piz_allaer !  single scattering albedo aerosol
-  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: cg_allaer  !  asymmetry parameter aerosol
-  !
-  REAL,DIMENSION(klon,klev) :: aod_prof, ssa_prof, asy_prof
-  REAL,DIMENSION(klon,klev) :: z, dz
-  REAL,DIMENSION(klon)      :: oro, zrho, zt
-  !
-  INTEGER, PARAMETER :: nmon = 12
-  !
-  REAL, PARAMETER    :: l443 = 443.0, l550 = 550.0, l865 = 865.0 !--wavelengths in nm
-  !
-  INTEGER, PARAMETER :: Nwvmax=25
-  REAL, DIMENSION(0:Nwvmax), PARAMETER :: lambda=(/ 240.0, &  !--this one is for band 1
-                  280.0,  300.0,  330.0,  360.0,  400.0,   &  !--these are bounds of Streamer bands
-                  440.0,  480.0,  520.0,  570.0,  640.0,   &
-                  690.0,  750.0,  780.0,  870.0, 1000.0,   &
-                 1100.0, 1190.0, 1280.0, 1530.0, 1640.0,   &
-                 2130.0, 2380.0, 2910.0, 3420.0, 4000.0   /)
-  !
-  REAL, DIMENSION(1:Nwvmax-1), PARAMETER :: weight =(/    &   !--and the weights to be given to the bands
-                 0.01,  4.05,  9.51, 15.99, 26.07, 33.10, &   !--corresponding to a typical solar spectrum 
-                33.07, 39.91, 52.67, 27.89, 43.60, 13.67, &
-                42.22, 40.12, 32.70, 14.44, 19.48, 14.23, &
-                13.43, 16.42,  8.33,  0.95,  0.65,  2.76  /)
-  !
-  REAL :: zlambda, zweight
-  REAL :: year_fr
-  !
-  INTEGER band, i, k, Nwv
-  !
-  ! define the height and dheight arrays
-  !
-  oro(:)  = pphis(:)/RG                             ! surface height in m
-  !
-  DO k = 1, klev
-    zrho(:) = pplay(:,k)/t_seri(:,k)/RD                         ! air density in kg/m3
-    dz(:,k) = (paprs(:,k)-paprs(:,k+1))/zrho(:)/RG              ! layer thickness in m
-    IF (k==1) THEN
-       z(:,1) = oro(:) + (paprs(:,1)-pplay(:,1))/zrho(:)/RG     ! altitude middle of first layer in m
-       zt(:)  = oro(:) + dz(:,1)                                ! altitude top of first layer in m
-    ELSE
-      z(:,k) = zt(:) + (paprs(:,k)-pplay(:,k))/zrho(:)/RG       ! altitude middle of layer k in m
-      zt(:)  = zt(:) + dz(:,k)                                  ! altitude top of layer k in m
-    ENDIF
-  ENDDO
-  !
-  !--fractional year
-  !
-  year_fr = FLOAT(year_cur) + (FLOAT(day_cur)-0.5) / FLOAT(year_len)
-  IF (year_fr.LT.1850.0.OR.year_fr.GE.2017.0) THEN
-     CALL abort_physic ('macv2sp','year not supported by plume model',1)
-  ENDIF
-  !
-  !--call to sp routine -- 443 nm
-  !
-  CALL sp_aop_profile                                    ( &
-       klev     ,klon ,l443 ,oro    ,xlon     ,xlat      , &
-       year_fr  ,z    ,dz   ,dNovrN ,aod_prof ,ssa_prof  , &
-       asy_prof )
-  !
-  !--AOD calculations for diagnostics
-  od443aer(:)= od443aer(:)+SUM(aod_prof(:,:),dim=2)
-  !
-  !--call to sp routine -- 550 nm
-  !
-  CALL sp_aop_profile                                    ( &
-       klev     ,klon ,l550 ,oro    ,xlon     ,xlat      , &
-       year_fr  ,z    ,dz   ,dNovrN ,aod_prof ,ssa_prof  , &
-       asy_prof )
-  !
-  !--AOD calculations for diagnostics
-  od550aer(:)=od550aer(:)+SUM(aod_prof(:,:),dim=2)
-  !
-  !--dry AOD calculation for diagnostics
-  dryod550aer(:)=dryod550aer(:)+od550aer(:)
-  !
-  !--fine-mode AOD calculation for diagnostics
-  od550lt1aer(:)=od550lt1aer(:)+od550aer(:)
-  !
-  !--extinction coefficient for diagnostic
-  ec550aer(:,:)=ec550aer(:,:)+aod_prof(:,:)/dz(:,:)
-  !
-  !--call to sp routine -- 865 nm
-  !
-  CALL sp_aop_profile                                    ( &
-       klev     ,klon ,l865 ,oro    ,xlon     ,xlat      , &
-       year_fr  ,z    ,dz   ,dNovrN ,aod_prof ,ssa_prof  , &
-       asy_prof )
-  !
-  !--AOD calculations for diagnostics
-  od865aer(:)=od865aer(:)+SUM(aod_prof(:,:),dim=2)
-  !
-  !--re-weighting of piz and cg arrays before adding the anthropogenic aerosols
-  !--index 2 = all natural + anthropogenic aerosols
-  piz_allaer(:,:,2,:)=piz_allaer(:,:,2,:)*tau_allaer(:,:,2,:)
-  cg_allaer(:,:,2,:) =cg_allaer(:,:,2,:)*piz_allaer(:,:,2,:)
-  !
-  !--now computing the same at many wavelengths to fill the model bands
-  !
-  DO Nwv=0,Nwvmax-1
-
-    IF (Nwv.EQ.0) THEN          !--RRTM spectral band 1
-      zlambda=lambda(Nwv)
-      zweight=1.0
-      band=1
-    ELSEIF (Nwv.LE.5) THEN      !--RRTM spectral band 2
-      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
-      zweight=weight(Nwv)/SUM(weight(1:5))
-      band=2
-    ELSEIF (Nwv.LE.10) THEN     !--RRTM spectral band 3
-      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
-      zweight=weight(Nwv)/SUM(weight(6:10))
-      band=3
-    ELSEIF (Nwv.LE.16) THEN     !--RRTM spectral band 4
-      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
-      zweight=weight(Nwv)/SUM(weight(11:16))
-      band=4
-    ELSEIF (Nwv.LE.21) THEN     !--RRTM spectral band 5
-      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
-      zweight=weight(Nwv)/SUM(weight(17:21))
-      band=5
-    ELSE                        !--RRTM spectral band 6
-      zlambda=0.5*(lambda(Nwv)+lambda(Nwv+1))
-      zweight=weight(Nwv)/SUM(weight(22:Nwvmax-1))
-      band=6
-    ENDIF
-    !
-    CALL sp_aop_profile                                       ( &
-         klev     ,klon ,zlambda ,oro    ,xlon     ,xlat      , &
-         year_fr  ,z    ,dz      ,dNovrN ,aod_prof ,ssa_prof  , &
-         asy_prof )
-    !
-    !--adding up the quantities tau, piz*tau and cg*piz*tau
-    tau_allaer(:,:,2,band)=tau_allaer(:,:,2,band)+zweight*MAX(aod_prof(:,:),1.e-15)
-    piz_allaer(:,:,2,band)=piz_allaer(:,:,2,band)+zweight*MAX(aod_prof(:,:),1.e-15)*ssa_prof(:,:)
-    cg_allaer(:,:,2,band) =cg_allaer(:,:,2,band) +zweight*MAX(aod_prof(:,:),1.e-15)*ssa_prof(:,:)*asy_prof(:,:)
-    !
-  ENDDO
-  !
-  !--renpomalizing cg and piz now that MACv2SP increments have been added
-  cg_allaer(:,:,2,:) =cg_allaer(:,:,2,:) /piz_allaer(:,:,2,:)
-  piz_allaer(:,:,2,:)=piz_allaer(:,:,2,:)/tau_allaer(:,:,2,:)
-  !
-END SUBROUTINE MACv2SP
+link ../phylmd/macv2sp.F90
Index: LMDZ6/trunk/libf/phylmdiso/methox.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/methox.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/methox.F90	(revision 3940)
@@ -1,118 +1,1 @@
-SUBROUTINE METHOX(KIDIA,  KFDIA,  KLON,  KLEV,PQ,     PTENQ,  PAP )
-
-!**** *METHOX*   - Calculate humidity tendencies from methane
-!                  oxidation and photolysis
-
-!**   INTERFACE.
-!     ----------
-!        CALL *METHOX* FROM *CALLPAR*
-!              ------        -------
-
-!        EXPLICIT ARGUMENTS :
-!        --------------------
-!     PARAMETER     DESCRIPTION                                   UNITS
-!     ---------     -----------                                   -----
-!     INPUT PARAMETERS (INTEGER):
-
-!    *KIDIA*        START POINT
-!    *KFDIA*        END POINT
-!    *KLON*         NUMBER OF GRID POINTS PER PACKET
-!    *KLEV*         NUMBER OF LEVELS
-
-!     INPUT PARAMETERS (REAL):
-
-!    *PAP*          PRESSURE                                      PA
-!    *PQ*           SPECIFIC HUMIDITY                             KG/KG
-
-!     UPDATED PARAMETERS (REAL):
-
-!    *PTENQ*        TENDENCY OF SPECIFIC HUMIDITY                 KG/(KG*S)
-
-!        NONE
-
-!        IMPLICIT ARGUMENTS :
-!        --------------------
-!        MODULE YOEMETH
-!        MODULE YOMCST
-
-!     METHOD.
-!     -------
-!        SEE RD-MEMO R60.1/AJS/31
-
-!     EXTERNALS.
-!     ----------
-!        NONE
-
-!     REFERENCE.
-!     ----------
-!        SEE RD-MEMO R60.1/AJS/31
-
-!     AUTHOR.
-!     -------
-!        C.JAKOB   *ECMWF*
-
-!     MODIFICATIONS.
-!     --------------
-!        ORIGINAL : 98-04-07
-!        M.Hamrud      01-Oct-2003 CY28 Cleaning
-!        D. Cugnet     24-Feb-2012 Adapted for LMDZ
-!     ------------------------------------------------------------------
-
-USE YOEMETH   , ONLY : RALPHA1 ,RALPHA2  ,RQLIM   ,&
- & RPBOTOX,  RPBOTPH ,RPTOPOX  ,RPTOPPH ,&
- & RALPHA3,  RLOGPPH  
-
-IMPLICIT NONE
-
-#include "YOMCST.h"
-
-INTEGER,INTENT(IN)    :: KLON 
-INTEGER,INTENT(IN)    :: KLEV 
-INTEGER,INTENT(IN)    :: KIDIA 
-INTEGER,INTENT(IN)    :: KFDIA 
-REAL   ,INTENT(IN)    :: PQ(KLON,KLEV) 
-REAL   ,INTENT(INOUT) :: PTENQ(KLON,KLEV) 
-REAL   ,INTENT(IN)    :: PAP(KLON,KLEV) 
-LOGICAL :: LLOXID,         LLPHOTO
-
-INTEGER :: JK, JL
-
-REAL :: ZARG, ZPRATIO, ZTAU1, ZTAU2, ZTDAYS
-
-DO JK=1,KLEV
-  DO JL=KIDIA,KFDIA
-
-    LLOXID=PAP(JL,JK) < RPBOTOX.AND.PQ(JL,JK) < RQLIM
-    LLPHOTO=PAP(JL,JK) < RPBOTPH
-
-!     METHANE OXIDATION
-
-    IF(LLOXID) THEN
-      IF(PAP(JL,JK) <= RPTOPOX) THEN
-        ZTDAYS=100.
-      ELSE
-        ZPRATIO=(LOG(PAP(JL,JK)/RPTOPOX))**4./LOG(RPBOTOX/PAP(JL,JK))
-        ZTDAYS=100.*(1+RALPHA1*ZPRATIO)
-      ENDIF
-      ZTAU1=86400.*ZTDAYS
-      PTENQ(JL,JK)=PTENQ(JL,JK)+(RQLIM-PQ(JL,JK))/ZTAU1
-    ENDIF
-
-!     PHOTOLYSIS
-
-    IF(LLPHOTO) THEN
-      IF(PAP(JL,JK) <= RPTOPPH) THEN
-        ZTDAYS=3.
-      ELSE
-        ZARG=RALPHA2-RALPHA3*(1+COS((RPI*LOG(PAP(JL,JK)/RPBOTPH))/RLOGPPH))
-        ZTDAYS=1.0/(EXP(ZARG)-0.01)
-      ENDIF
-      ZTAU2=86400.*ZTDAYS
-      PTENQ(JL,JK)=PTENQ(JL,JK)-PQ(JL,JK)/ZTAU2
-    ENDIF
-  ENDDO
-ENDDO
-
-END SUBROUTINE METHOX
-
-
+link ../phylmd/methox.F90
Index: LMDZ6/trunk/libf/phylmdiso/minmaxqfi.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/minmaxqfi.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/minmaxqfi.F90	(revision 3940)
@@ -1,36 +1,1 @@
-!
-! $Id: minmaxqfi.F90 2311 2015-06-25 07:45:24Z emillour $
-!
-SUBROUTINE minmaxqfi(zq,qmin,qmax,comment)
-  USE dimphy
-  USE print_control_mod, ONLY: prt_level
-  IMPLICIT NONE
-
-! Entrees
-  REAL,DIMENSION(klon,klev), INTENT(IN)   :: zq
-  REAL,INTENT(IN)                         :: qmin,qmax
-  CHARACTER(LEN=*),INTENT(IN)             :: comment
-
-! Local  
-  INTEGER,DIMENSION(klon)     :: jadrs 
-  INTEGER                     :: i, jbad, k
-
-  DO k = 1, klev
-     jbad = 0
-     DO i = 1, klon
-        IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
-           jbad = jbad + 1
-           jadrs(jbad) = i
-        ENDIF
-     ENDDO
-     IF (jbad.GT.0) THEN
-        WRITE(*,*)comment, "k = ", k, "jbad > 0"
-        if (prt_level >= 1) then
-           DO i = 1, jbad
-              WRITE(*,*) "i,q=", jadrs(i), zq(jadrs(i),k)
-           ENDDO
-        end if
-     ENDIF
-  ENDDO
-  
-END SUBROUTINE minmaxqfi
+link ../phylmd/minmaxqfi.F90
Index: LMDZ6/trunk/libf/phylmdiso/mo_simple_plumes.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/mo_simple_plumes.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/mo_simple_plumes.F90	(revision 3940)
@@ -1,482 +1,1 @@
-!>
-!!
-!! @brief Module MO_SIMPLE_PLUMES: provides anthropogenic aerosol optical properties as a function of lat, lon
-!!   height, time, and wavelength
-!!
-!! @remarks
-!!
-!! @author Bjorn Stevens, Stephanie Fiedler and Karsten Peters MPI-Met, Hamburg (v1 release 2016-11-10)
-!!
-!! @change-log:
-!!          - 2016-12-05: beta release (BS, SF and KP, MPI-Met)
-!!          - 2016-09-28: revised representation of Twomey effect (SF, MPI-Met)
-!!          - 2015-09-28: bug fixes  (SF, MPI-Met)
-!!          - 2016-10-12: revised maximum longitudinal extent of European plume (KP, SF, MPI-Met)
-!! $ID: n/a$
-!!
-!! @par Origin
-!!   Based on code originally developed at the MPI-Met by Karsten Peters, Bjorn Stevens, Stephanie Fiedler
-!!   and Stefan Kinne with input from Thorsten Mauritsen and Robert Pincus
-!!
-!! @par Copyright
-!! 
-!
-MODULE MO_SIMPLE_PLUMES
-
-  USE netcdf
-
-  IMPLICIT NONE
-
-  INTEGER, PARAMETER ::                        &
-       nplumes   = 9                          ,& !< Number of plumes
-       nfeatures = 2                          ,& !< Number of features per plume
-       ntimes    = 52                         ,& !< Number of times resolved per year (52 => weekly resolution)
-       nyears    = 251                           !< Number of years of available forcing
-
-  LOGICAL, SAVE ::                             &
-       sp_initialized = .FALSE.                  !< parameter determining whether input needs to be read
-!$OMP THREADPRIVATE(sp_initialized)
-
-  REAL ::                                      &
-       plume_lat      (nplumes)               ,& !< latitude of plume center (AOD maximum)
-       plume_lon      (nplumes)               ,& !< longitude of plume center (AOD maximum)
-       beta_a         (nplumes)               ,& !< parameter a for beta function vertical profile
-       beta_b         (nplumes)               ,& !< parameter b for beta function vertical profile
-       aod_spmx       (nplumes)               ,& !< anthropogenic AOD maximum at 550 for plumes 
-       aod_fmbg       (nplumes)               ,& !< anthropogenic AOD at 550 for fine-mode natural background (idealized to mimic Twomey effect)
-       asy550         (nplumes)               ,& !< asymmetry parameter at 550nm for plume
-       ssa550         (nplumes)               ,& !< single scattering albedo at 550nm for plume
-       angstrom       (nplumes)               ,& !< Angstrom parameter for plume 
-       sig_lon_E      (nfeatures,nplumes)     ,& !< Eastward extent of plume feature
-       sig_lon_W      (nfeatures,nplumes)     ,& !< Westward extent of plume feature
-       sig_lat_E      (nfeatures,nplumes)     ,& !< Southward extent of plume feature
-       sig_lat_W      (nfeatures,nplumes)     ,& !< Northward extent of plume feature
-       theta          (nfeatures,nplumes)     ,& !< Rotation angle of plume feature
-       ftr_weight     (nfeatures,nplumes)     ,& !< Feature weights 
-       time_weight    (nfeatures,nplumes)     ,& !< Time weights 
-       time_weight_bg (nfeatures,nplumes)     ,& !< as time_weight but for natural background in Twomey effect 
-       year_weight    (nyears,nplumes)        ,& !< Yearly weight for plume
-       ann_cycle      (nfeatures,ntimes,nplumes) !< annual cycle for plume feature
-!$OMP THREADPRIVATE(plume_lat,plume_lon,beta_a,beta_b,aod_spmx,aod_fmbg,asy550,ssa550,angstrom)
-!$OMP THREADPRIVATE(sig_lon_E,sig_lon_W,sig_lat_E,sig_lat_W,theta,ftr_weight,year_weight,ann_cycle)
-
-  PUBLIC sp_aop_profile
-
-CONTAINS
-  !
-  ! ------------------------------------------------------------------------------------------------------------------------
-  ! SP_SETUP:  This subroutine should be called at initialization to read the netcdf data that describes the simple plume
-  ! climatology.  The information needs to be either read by each processor or distributed to processors.
-  !
-  SUBROUTINE sp_setup
-    !
-    USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
-    USE mod_phys_lmdz_omp_data, ONLY: is_omp_root
-    USE mod_phys_lmdz_transfert_para, ONLY: bcast
-    !
-    ! ---------- 
-    !
-    INTEGER :: iret, ncid, DimID, VarID, xdmy
-    CHARACTER (len = 50)     :: modname = 'mo_simple_plumes.sp_setup'
-    CHARACTER (len = 80)     :: abort_message
-
-    !
-    ! ---------- 
-    !--only one processor reads the input data
-    IF (is_mpi_root.AND.is_omp_root) THEN
-       !    
-       iret = nf90_open("MACv2.0-SP_v1.nc", NF90_NOWRITE, ncid)
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF File not opened'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       !
-       ! read dimensions and make sure file conforms to expected size
-       !
-       iret = nf90_inq_dimid(ncid, "plume_number"  , DimId)
-       iret = nf90_inquire_dimension(ncid, DimId, len = xdmy)
-       IF (xdmy /= nplumes) THEN
-          abort_message='NetCDF improperly dimensioned -- plume_number'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       !
-       iret = nf90_inq_dimid(ncid, "plume_feature", DimId)
-       iret = nf90_inquire_dimension(ncid, DimId, len = xdmy)
-       IF (xdmy /= nfeatures) THEN
-          abort_message='NetCDF improperly dimensioned -- plume_feature'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       !
-       iret = nf90_inq_dimid(ncid, "year_fr"   , DimId)
-       iret = nf90_inquire_dimension(ncid, DimID, len = xdmy)
-       IF (xdmy /= ntimes) THEN
-          abort_message='NetCDF improperly dimensioned -- year_fr'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       !
-       iret = nf90_inq_dimid(ncid, "years"   , DimId)
-       iret = nf90_inquire_dimension(ncid, DimID, len = xdmy)
-       IF (xdmy /= nyears) THEN
-          abort_message='NetCDF improperly dimensioned -- years'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       !
-       ! read variables that define the simple plume climatology
-       !
-       iret = nf90_inq_varid(ncid, "plume_lat", VarId)
-       iret = nf90_get_var(ncid, VarID, plume_lat(:), start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading plume_lat'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "plume_lon", VarId)
-       iret = nf90_get_var(ncid, VarID, plume_lon(:), start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading plume_lon'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "beta_a"   , VarId)
-       iret = nf90_get_var(ncid, VarID, beta_a(:)   , start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading beta_a'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "beta_b"   , VarId)
-       iret = nf90_get_var(ncid, VarID, beta_b(:)   , start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading beta_b'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "aod_spmx" , VarId)
-       iret = nf90_get_var(ncid, VarID, aod_spmx(:)  , start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading aod_spmx'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "aod_fmbg" , VarId)
-       iret = nf90_get_var(ncid, VarID, aod_fmbg(:)  , start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading aod_fmbg'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "ssa550"   , VarId)
-       iret = nf90_get_var(ncid, VarID, ssa550(:)  , start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading ssa550'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "asy550"   , VarId)
-       iret = nf90_get_var(ncid, VarID, asy550(:)  , start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading asy550'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "angstrom" , VarId)
-       iret = nf90_get_var(ncid, VarID, angstrom(:), start=(/1/),count=(/nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading angstrom'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       !
-       iret = nf90_inq_varid(ncid, "sig_lat_W"     , VarId)
-       iret = nf90_get_var(ncid, VarID, sig_lat_W(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading sig_lat_W'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "sig_lat_E"     , VarId)
-       iret = nf90_get_var(ncid, VarID, sig_lat_E(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading sig_lat_E'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "sig_lon_E"     , VarId)
-       iret = nf90_get_var(ncid, VarID, sig_lon_E(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading sig_lon_E'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "sig_lon_W"     , VarId)
-       iret = nf90_get_var(ncid, VarID, sig_lon_W(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading sig_lon_W'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "theta"         , VarId)
-       iret = nf90_get_var(ncid, VarID, theta(:,:)        , start=(/1,1/),count=(/nfeatures,nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading theta'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "ftr_weight"    , VarId)
-       iret = nf90_get_var(ncid, VarID, ftr_weight(:,:)   , start=(/1,1/),count=(/nfeatures,nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading plume_lat'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "year_weight"   , VarId)
-       iret = nf90_get_var(ncid, VarID, year_weight(:,:)  , start=(/1,1/),count=(/nyears,nplumes   /))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading year_weight'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       iret = nf90_inq_varid(ncid, "ann_cycle"     , VarId)
-       iret = nf90_get_var(ncid, VarID, ann_cycle(:,:,:)  , start=(/1,1,1/),count=(/nfeatures,ntimes,nplumes/))
-       IF (iret /= NF90_NOERR) THEN
-          abort_message='NetCDF Error reading ann_cycle'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       !
-       iret = nf90_close(ncid)
-       !
-    ENDIF !--root processor
-    !
-    CALL bcast(plume_lat)
-    CALL bcast(plume_lon)
-    CALL bcast(beta_a)
-    CALL bcast(beta_b)
-    CALL bcast(aod_spmx)
-    CALL bcast(aod_fmbg)
-    CALL bcast(asy550)
-    CALL bcast(ssa550)
-    CALL bcast(angstrom)
-    CALL bcast(sig_lon_E)
-    CALL bcast(sig_lon_W)
-    CALL bcast(sig_lat_E)
-    CALL bcast(sig_lat_W)
-    CALL bcast(theta)
-    CALL bcast(ftr_weight)
-    CALL bcast(year_weight)
-    CALL bcast(ann_cycle)
-    !
-    sp_initialized = .TRUE.
-    !
-    RETURN
-    !
-  END SUBROUTINE sp_setup
-  !
-  ! ------------------------------------------------------------------------------------------------------------------------
-  ! SET_TIME_WEIGHT:  The simple plume model assumes that meteorology constrains plume shape and that only source strength
-  ! influences the amplitude of a plume associated with a given source region.   This routine retrieves the temporal weights
-  ! for the plumes.  Each plume feature has its own temporal weights which varies yearly.  The annual cycle is indexed by
-  ! week in the year and superimposed on the yearly mean value of the weight. 
-  !
-  SUBROUTINE set_time_weight(year_fr)
-    !
-    ! ---------- 
-    !
-    REAL, INTENT(IN) ::  &
-         year_fr           !< Fractional Year (1850.0 - 2100.99)
-
-    INTEGER          ::  &
-         iyear          ,& !< Integer year values between 1 and 156 (1850-2100) 
-         iweek          ,& !< Integer index (between 1 and ntimes); for ntimes=52 this corresponds to weeks (roughly)
-         iplume            ! plume number
-    !
-    ! ---------- 
-    !
-    iyear = FLOOR(year_fr) - 1849
-    iweek = FLOOR((year_fr - FLOOR(year_fr)) * ntimes) + 1
-
-    IF ((iweek > ntimes) .OR. (iweek < 1) .OR. (iyear > nyears) .OR. (iyear < 1)) THEN 
-      CALL abort_physic('set_time_weight','Time out of bounds')
-    ENDIF
-
-    DO iplume=1,nplumes
-      time_weight(1,iplume) = year_weight(iyear,iplume) * ann_cycle(1,iweek,iplume)
-      time_weight(2,iplume) = year_weight(iyear,iplume) * ann_cycle(2,iweek,iplume)
-      time_weight_bg(1,iplume) = ann_cycle(1,iweek,iplume)
-      time_weight_bg(2,iplume) = ann_cycle(2,iweek,iplume) 
-    END DO
-    
-    RETURN
-  END SUBROUTINE set_time_weight
-  !
-  ! ------------------------------------------------------------------------------------------------------------------------
-  ! SP_AOP_PROFILE:  This subroutine calculates the simple plume aerosol and cloud active optical properties based on the
-  ! the simple plume fit to the MPI Aerosol Climatology (Version 2).  It sums over nplumes to provide a profile of aerosol
-  ! optical properties on a host models vertical grid. 
-  !
-  SUBROUTINE sp_aop_profile                                                                           ( &
-       nlevels        ,ncol           ,lambda         ,oro            ,lon            ,lat            , &
-       year_fr        ,z              ,dz             ,dNovrN         ,aod_prof       ,ssa_prof       , &
-       asy_prof       )
-    !
-    ! ---------- 
-    !
-    INTEGER, INTENT(IN)        :: &
-         nlevels,                 & !< number of levels
-         ncol                       !< number of columns
-
-    REAL, INTENT(IN)           :: &
-         lambda,                  & !< wavelength
-         year_fr,                 & !< Fractional Year (1903.0 is the 0Z on the first of January 1903, Gregorian)
-         oro(ncol),               & !< orographic height (m)
-         lon(ncol),               & !< longitude 
-         lat(ncol),               & !< latitude
-         z (ncol,nlevels),        & !< height above sea-level (m)
-         dz(ncol,nlevels)           !< level thickness (difference between half levels) (m)
-
-    REAL, INTENT(OUT)          :: &
-         dNovrN(ncol)           , & !< anthropogenic increase in cloud drop number concentration (factor)
-         aod_prof(ncol,nlevels) , & !< profile of aerosol optical depth
-         ssa_prof(ncol,nlevels) , & !< profile of single scattering albedo
-         asy_prof(ncol,nlevels)     !< profile of asymmetry parameter
-
-    INTEGER                    :: iplume, icol, k
-
-    REAL                       ::  &
-         eta(ncol,nlevels),        & !< normalized height (by 15 km)
-         z_beta(ncol,nlevels),     & !< profile for scaling column optical depth
-         prof(ncol,nlevels),       & !< scaled profile (by beta function)
-         beta_sum(ncol),           & !< vertical sum of beta function
-         ssa(ncol),                & !< single scattering albedo 
-         asy(ncol),                & !< asymmetry parameter
-         cw_an(ncol),              & !< column weight for simple plume (anthropogenic) AOD at 550 nm
-         cw_bg(ncol),              & !< column weight for fine-mode natural background AOD at 550 nm
-         caod_sp(ncol),            & !< column simple plume anthropogenic AOD at 550 nm
-         caod_bg(ncol),            & !< column fine-mode natural background AOD at 550 nm
-         a_plume1,                 & !< gaussian longitude factor for feature 1
-         a_plume2,                 & !< gaussian longitude factor for feature 2
-         b_plume1,                 & !< gaussian latitude factor for feature 1
-         b_plume2,                 & !< gaussian latitude factor for feature 2
-         delta_lat,                & !< latitude offset
-         delta_lon,                & !< longitude offset
-         delta_lon_t,              & !< threshold for maximum longitudinal plume extent used in transition from 360 to 0 degrees
-         lon1,                     & !< rotated longitude for feature 1
-         lat1,                     & !< rotated latitude for feature 2
-         lon2,                     & !< rotated longitude for feature 1
-         lat2,                     & !< rotated latitude for feature 2
-         f1,                       & !< contribution from feature 1
-         f2,                       & !< contribution from feature 2
-         f3,                       & !< contribution from feature 1 in natural background of Twomey effect
-         f4,                       & !< contribution from feature 2 in natural background of Twomey effect
-         aod_550,                  & !< aerosol optical depth at 550nm
-         aod_lmd,                  & !< aerosol optical depth at input wavelength
-         lfactor                     !< factor to compute wavelength dependence of optical properties
-    !
-    ! ---------- 
-    !
-    ! initialize input data (by calling setup at first instance) 
-    !
-    IF (.NOT.sp_initialized) CALL sp_setup
-    !
-    ! get time weights
-    !
-    CALL set_time_weight(year_fr)
-    !
-    ! initialize variables, including output
-    !
-    DO k=1,nlevels
-      DO icol=1,ncol
-        aod_prof(icol,k) = 0.0
-        ssa_prof(icol,k) = 0.0
-        asy_prof(icol,k) = 0.0
-        z_beta(icol,k)   = MERGE(1.0, 0.0, z(icol,k) >= oro(icol))
-        eta(icol,k)      = MAX(0.0,MIN(1.0,z(icol,k)/15000.))
-      END DO
-    END DO
-    DO icol=1,ncol
-      dNovrN(icol)   = 1.0
-      caod_sp(icol)  = 0.0
-      caod_bg(icol)  = 0.02
-    END DO
-    !
-    ! sum contribution from plumes to construct composite profiles of aerosol optical properties
-    !
-    DO iplume=1,nplumes
-      !
-      ! calculate vertical distribution function from parameters of beta distribution
-      !
-      DO icol=1,ncol
-        beta_sum(icol) = 0.
-      END DO
-      DO k=1,nlevels
-        DO icol=1,ncol
-          prof(icol,k)   = (eta(icol,k)**(beta_a(iplume)-1.) * (1.-eta(icol,k))**(beta_b(iplume)-1.)) * dz(icol,k)
-          beta_sum(icol) = beta_sum(icol) + prof(icol,k)
-        END DO
-      END DO
-      DO k=1,nlevels
-        DO icol=1,ncol
-          prof(icol,k)   = ( prof(icol,k) / beta_sum(icol) ) * z_beta(icol,k)
-        END DO
-      END DO
-      !
-      ! calculate plume weights
-      !
-      DO icol=1,ncol
-        !
-        ! get plume-center relative spatial parameters for specifying amplitude of plume at given lat and lon
-        !
-        delta_lat   = lat(icol) - plume_lat(iplume)
-        delta_lon   = lon(icol) - plume_lon(iplume)
-        delta_lon_t = MERGE (260., 180., iplume == 1)
-        delta_lon   = MERGE ( delta_lon-SIGN(360.,delta_lon) , delta_lon , ABS(delta_lon) > delta_lon_t)
-
-        a_plume1  = 0.5 / (MERGE(sig_lon_E(1,iplume), sig_lon_W(1,iplume), delta_lon > 0)**2)
-        b_plume1  = 0.5 / (MERGE(sig_lat_E(1,iplume), sig_lat_W(1,iplume), delta_lon > 0)**2)
-        a_plume2  = 0.5 / (MERGE(sig_lon_E(2,iplume), sig_lon_W(2,iplume), delta_lon > 0)**2)
-        b_plume2  = 0.5 / (MERGE(sig_lat_E(2,iplume), sig_lat_W(2,iplume), delta_lon > 0)**2)
-        !
-        ! adjust for a plume specific rotation which helps match plume state to climatology.
-        !
-        lon1 =   COS(theta(1,iplume))*(delta_lon) + SIN(theta(1,iplume))*(delta_lat)
-        lat1 = - SIN(theta(1,iplume))*(delta_lon) + COS(theta(1,iplume))*(delta_lat)
-        lon2 =   COS(theta(2,iplume))*(delta_lon) + SIN(theta(2,iplume))*(delta_lat)
-        lat2 = - SIN(theta(2,iplume))*(delta_lon) + COS(theta(2,iplume))*(delta_lat)
-        !
-        ! calculate contribution to plume from its different features, to get a column weight for the anthropogenic
-        ! (cw_an) and the fine-mode natural background aerosol (cw_bg)
-        !
-        f1 = time_weight(1,iplume) * ftr_weight(1,iplume) * EXP(-1.* (a_plume1 * ((lon1)**2) + (b_plume1 * ((lat1)**2)))) 
-        f2 = time_weight(2,iplume) * ftr_weight(2,iplume) * EXP(-1.* (a_plume2 * ((lon2)**2) + (b_plume2 * ((lat2)**2)))) 
-        f3 = time_weight_bg(1,iplume) * ftr_weight(1,iplume) * EXP(-1.* (a_plume1 * ((lon1)**2) + (b_plume1 * ((lat1)**2)))) 
-        f4 = time_weight_bg(2,iplume) * ftr_weight(2,iplume) * EXP(-1.* (a_plume2 * ((lon2)**2) + (b_plume2 * ((lat2)**2))))
-
-        cw_an(icol) = f1 * aod_spmx(iplume) + f2 * aod_spmx(iplume)  
-        cw_bg(icol) = f3 * aod_fmbg(iplume) + f4 * aod_fmbg(iplume) 
-        !
-        ! calculate wavelength-dependent scattering properties
-        !
-        lfactor   = MIN(1.0,700.0/lambda)
-        ssa(icol) = (ssa550(iplume) * lfactor**4) / ((ssa550(iplume) * lfactor**4) + ((1-ssa550(iplume)) * lfactor))
-        asy(icol) =  asy550(iplume) * SQRT(lfactor)
-      END DO
-      !
-      ! distribute plume optical properties across its vertical profile weighting by optical depth and scaling for
-      ! wavelength using the angstrom parameter. 
-      !      
-      lfactor = EXP(-angstrom(iplume) * LOG(lambda/550.0))
-      DO k=1,nlevels
-        DO icol = 1,ncol
-          aod_550          = prof(icol,k)     * cw_an(icol)
-          aod_lmd          = aod_550          * lfactor
-          caod_sp(icol)    = caod_sp(icol)    + aod_550
-          caod_bg(icol)    = caod_bg(icol)    + prof(icol,k) * cw_bg(icol)
-          asy_prof(icol,k) = asy_prof(icol,k) + aod_lmd * ssa(icol) * asy(icol)
-          ssa_prof(icol,k) = ssa_prof(icol,k) + aod_lmd * ssa(icol)
-          aod_prof(icol,k) = aod_prof(icol,k) + aod_lmd
-        END DO
-      END DO
-    END DO
-    !
-    ! complete optical depth weighting
-    !
-    DO k=1,nlevels
-      DO icol = 1,ncol
-        asy_prof(icol,k) = MERGE(asy_prof(icol,k)/ssa_prof(icol,k), 0.0, ssa_prof(icol,k) > TINY(1.))
-        ssa_prof(icol,k) = MERGE(ssa_prof(icol,k)/aod_prof(icol,k), 1.0, aod_prof(icol,k) > TINY(1.))
-      END DO
-    END DO
-    !
-    ! calculate effective radius normalization (divisor) factor
-    !
-    DO icol=1,ncol
-      dNovrN(icol) = LOG((1000.0 * (caod_sp(icol) + caod_bg(icol))) + 1.0)/LOG((1000.0 * caod_bg(icol)) + 1.0)
-    END DO
-
-    RETURN
-  END SUBROUTINE sp_aop_profile
-  
-END MODULE MO_SIMPLE_PLUMES
+link ../phylmd/mo_simple_plumes.F90
Index: LMDZ6/trunk/libf/phylmdiso/mod_surf_para.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/mod_surf_para.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/mod_surf_para.F90	(revision 3940)
@@ -1,351 +1,1 @@
-MODULE mod_surf_para
-  IMPLICIT NONE
-  
-  INTERFACE gather_surf
-    MODULE PROCEDURE gather_surf_i,gather_surf_r
-  END INTERFACE gather_surf
-  
-  INTERFACE gather_surf_omp
-    MODULE PROCEDURE gather_surf_omp_i,gather_surf_omp_r
-  END INTERFACE gather_surf_omp
-
-  INTERFACE gather_surf_mpi
-    MODULE PROCEDURE gather_surf_mpi_i,gather_surf_mpi_r
-  END INTERFACE gather_surf_mpi
-
-  INTERFACE scatter_surf
-    MODULE PROCEDURE scatter_surf_i,scatter_surf_r
-  END INTERFACE scatter_surf
-  
-  INTERFACE scatter_surf_omp
-    MODULE PROCEDURE scatter_surf_omp_i,scatter_surf_omp_r
-  END INTERFACE scatter_surf_omp
-
-  INTERFACE scatter_surf_mpi
-    MODULE PROCEDURE scatter_surf_mpi_i,scatter_surf_mpi_r
-  END INTERFACE scatter_surf_mpi
-  
-  
-  INTEGER,SAVE             :: knon_omp
-  INTEGER,SAVE             :: knon_omp_begin
-  INTEGER,SAVE             :: knon_omp_end
-!$OMP THREADPRIVATE(knon_omp,knon_omp_begin,knon_omp_end)
-  INTEGER,ALLOCATABLE,SAVE :: knon_omp_para(:)
-  INTEGER,ALLOCATABLE,SAVE :: knon_omp_begin_para(:)
-  INTEGER,ALLOCATABLE,SAVE :: knon_omp_end_para(:)
-  
-  INTEGER,SAVE             :: knon_mpi
-  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_para(:)
-  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_begin_para(:)
-  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_end_para(:)
-  
-  INTEGER,SAVE             :: knon_glo
-  INTEGER,SAVE,ALLOCATABLE :: knon_glo_para(:)  
-  INTEGER,ALLOCATABLE,SAVE :: knon_glo_begin_para(:)
-  INTEGER,ALLOCATABLE,SAVE :: knon_glo_end_para(:)
-  
-  
-CONTAINS
-
-  SUBROUTINE Init_surf_para(knon)
-  USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
-    INTEGER :: knon
-    INTEGER :: i,ierr
-    
-    knon_omp=knon
-    IF (is_omp_root) THEN
-      ALLOCATE(knon_omp_para(0:omp_size-1))
-      ALLOCATE(knon_omp_begin_para(0:omp_size-1))
-      ALLOCATE(knon_omp_end_para(0:omp_size-1))
-    ENDIF
-!$OMP BARRIER
-    knon_omp_para(omp_rank)=knon
-!$OMP BARRIER
-    IF (is_omp_root) THEN 
-      knon_omp_begin_para(0)=1
-      knon_omp_end_para(0)=knon_omp_para(0)
-      DO i=1,omp_size-1
-        knon_omp_begin_para(i)=knon_omp_end_para(i-1)+1
-        knon_omp_end_para(i)=knon_omp_begin_para(i)+knon_omp_para(i)-1
-      ENDDO
-    ENDIF 
-!$OMP BARRIER
-    knon_omp_begin=knon_omp_begin_para(omp_rank)
-    knon_omp_end=knon_omp_end_para(omp_rank)
-!$OMP BARRIER    
-    IF (is_omp_root) THEN
-      knon_mpi=sum(knon_omp_para)
-      ALLOCATE(knon_mpi_para(0:mpi_size-1))
-      ALLOCATE(knon_mpi_begin_para(0:mpi_size-1))
-      ALLOCATE(knon_mpi_end_para(0:mpi_size-1))
-      
-      ALLOCATE(knon_glo_para(0:mpi_size*omp_size-1))
-      ALLOCATE(knon_glo_begin_para(0:mpi_size*omp_size-1))
-      ALLOCATE(knon_glo_end_para(0:mpi_size*omp_size-1))
-      
-      IF (is_using_mpi) THEN
-#ifdef CPP_MPI
-        CALL MPI_ALLGather(knon_mpi,1,MPI_INTEGER,knon_mpi_para,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
-        CALL MPI_ALLGather(knon_omp_para,omp_size,MPI_INTEGER,knon_glo_para,omp_size,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
-#endif
-      ELSE
-        knon_mpi_para(:)=knon_mpi
-        knon_glo_para(:)=knon_omp_para(:)
-      ENDIF     
-      
-      knon_glo=sum(knon_mpi_para(:))
-      
-      knon_mpi_begin_para(0)=1
-      knon_mpi_end_para(0)=knon_mpi_para(0)
-      DO i=1,mpi_size-1
-        knon_mpi_begin_para(i)=knon_mpi_end_para(i-1)+1
-        knon_mpi_end_para(i)=knon_mpi_begin_para(i)+knon_mpi_para(i)-1
-      ENDDO
-      
-      knon_glo_begin_para(0)=1
-      knon_glo_end_para(0)=knon_glo_para(0)
-      DO i=1,mpi_size*omp_size-1
-        knon_glo_begin_para(i)=knon_glo_end_para(i-1)+1
-        knon_glo_end_para(i)= knon_glo_begin_para(i)+knon_glo_para(i)-1
-      ENDDO
-   ENDIF
-!$OMP BARRIER
-
-  END SUBROUTINE Init_surf_para
-
- 
-  SUBROUTINE Finalize_surf_para
-  USE mod_phys_lmdz_para
-
-!$OMP BARRIER   
-   IF (is_omp_root) THEN
-      DEALLOCATE(knon_omp_para)
-      DEALLOCATE(knon_omp_begin_para)
-      DEALLOCATE(knon_omp_end_para)
-      DEALLOCATE(knon_mpi_para)
-      DEALLOCATE(knon_mpi_begin_para)
-      DEALLOCATE(knon_mpi_end_para)
-      DEALLOCATE(knon_glo_para)  
-      DEALLOCATE(knon_glo_begin_para)
-      DEALLOCATE(knon_glo_end_para)
-    ENDIF
-    
-  END SUBROUTINE Finalize_surf_para
-  
-  
-  SUBROUTINE gather_surf_i(FieldIn, FieldOut)
-  USE mod_phys_lmdz_para
-    INTEGER :: FieldIn(:)
-    INTEGER :: FieldOut(:)
-    INTEGER :: FieldTmp(knon_mpi)
-    
-    CALL gather_surf_omp_i(FieldIn,FieldTmp)
-    IF (is_omp_root) CALL gather_surf_mpi_i(FieldTmp,FieldOut)
-    
-  END SUBROUTINE gather_surf_i
-
-
-  SUBROUTINE gather_surf_omp_i(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-    INTEGER :: FieldIn(:)
-    INTEGER :: FieldOut(:)
-  
-    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
-    
-    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
-!$OMP BARRIER
-    Field_tmp(knon_omp_begin:knon_omp_end)=FieldIn(:)
-!$OMP BARRIER        
-    IF (is_omp_root) FieldOut(:)=Field_tmp(:)
-!$OMP BARRIER
-    IF (is_omp_root) DEALLOCATE(Field_tmp)
-    
-  END SUBROUTINE  gather_surf_omp_i
-  
-     
-  SUBROUTINE gather_surf_mpi_i(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
-    INTEGER :: FieldIn(:)
-    INTEGER :: FieldOut(:)
-    INTEGER :: ierr
-    
-    IF (is_using_mpi) THEN
-#ifdef CPP_MPI
-      CALL MPI_Gatherv(FieldIn,knon_mpi,MPI_INTEGER,                                &
-                       FieldOut,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER, &
-                       mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
-    ELSE
-      FieldOut(:)=FieldIn(:)
-    ENDIF
-  
-  END SUBROUTINE gather_surf_mpi_i
-  
-
-
-
-
-  SUBROUTINE gather_surf_r(FieldIn, FieldOut)
-  USE mod_phys_lmdz_para
-    REAL :: FieldIn(:)
-    REAL :: FieldOut(:)
-    REAL :: FieldTmp(knon_mpi)
-    
-    CALL gather_surf_omp_r(FieldIn,FieldTmp)
-    IF (is_omp_root) CALL gather_surf_mpi_r(FieldTmp,FieldOut)
-    
-  END SUBROUTINE gather_surf_r
-
-
-  SUBROUTINE gather_surf_omp_r(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-    REAL :: FieldIn(:)
-    REAL :: FieldOut(:)
-  
-    REAL,SAVE,ALLOCATABLE :: Field_tmp(:)
-    
-    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
-!$OMP BARRIER
-    Field_tmp(knon_omp_begin:knon_omp_end)=FieldIn(:)
-!$OMP BARRIER        
-    IF (is_omp_root) FieldOut(:)=Field_tmp(:)
-!$OMP BARRIER
-    IF (is_omp_root) DEALLOCATE(Field_tmp)
-    
-  END SUBROUTINE  gather_surf_omp_r
-  
-     
-  SUBROUTINE gather_surf_mpi_r(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
-    REAL :: FieldIn(:)
-    REAL :: FieldOut(:)
-    REAL :: ierr
-    
-    IF (is_using_mpi) THEN
-#ifdef CPP_MPI
-      CALL MPI_Gatherv(FieldIn,knon_mpi,MPI_REAL_LMDZ,                                 &
-                       FieldOut,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_REAL_LMDZ,  &
-                       mpi_master,COMM_LMDZ_PHY,ierr)            
-#endif
-    ELSE
-      FieldOut(:)=FieldIn(:)
-    ENDIF
-  
-  END SUBROUTINE gather_surf_mpi_r
-
-
-
-
-  SUBROUTINE scatter_surf_i(FieldIn, FieldOut)
-  USE mod_phys_lmdz_para
-    INTEGER :: FieldIn(:)
-    INTEGER :: FieldOut(:)
-    INTEGER :: FieldTmp(knon_mpi)
-    
-    IF (is_omp_root) CALL scatter_surf_mpi_i(FieldIn,FieldTmp)
-    CALL scatter_surf_omp_i(FieldTmp,FieldOut)
-    
-  END SUBROUTINE scatter_surf_i
-
-
-  SUBROUTINE scatter_surf_omp_i(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-    INTEGER :: FieldIn(:)
-    INTEGER :: FieldOut(:)
-  
-    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
-    
-    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
-    IF (is_omp_root) Field_tmp(:)=FieldIn(:)
-!$OMP BARRIER        
-    FieldOut(:)=Field_tmp(knon_omp_begin:knon_omp_end)
-!$OMP BARRIER
-    IF (is_omp_root) DEALLOCATE(Field_tmp)
-    
-  END SUBROUTINE  scatter_surf_omp_i
-  
-     
-  SUBROUTINE scatter_surf_mpi_i(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
-    INTEGER :: FieldIn(:)
-    INTEGER :: FieldOut(:)
-    INTEGER :: ierr
-    
-    IF (is_using_mpi) THEN
-#ifdef CPP_MPI
-      CALL MPI_Scatterv(FieldIn,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER,   &
-                        FieldOut,knon_mpi,MPI_INTEGER,                                &
-                        mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
-    ELSE
-      FieldOut(:)=FieldIn(:)
-    ENDIF
-  
-  END SUBROUTINE scatter_surf_mpi_i
-
-
-
-  SUBROUTINE scatter_surf_r(FieldIn, FieldOut)
-  USE mod_phys_lmdz_para
-    REAL :: FieldIn(:)
-    REAL :: FieldOut(:)
-    REAL :: FieldTmp(knon_mpi)
-    
-    IF (is_omp_root) CALL scatter_surf_mpi_r(FieldIn,FieldTmp)
-    CALL scatter_surf_omp_r(FieldTmp,FieldOut)
-    
-  END SUBROUTINE scatter_surf_r
-
-
-  SUBROUTINE scatter_surf_omp_r(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-    REAL :: FieldIn(:)
-    REAL :: FieldOut(:)
-  
-    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
-    
-    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
-    IF (is_omp_root) Field_tmp(:)=FieldIn(:)
-!$OMP BARRIER        
-    FieldOut(:)=Field_tmp(knon_omp_begin:knon_omp_end)
-!$OMP BARRIER
-    IF (is_omp_root) DEALLOCATE(Field_tmp)
-    
-  END SUBROUTINE  scatter_surf_omp_r
-  
-     
-  SUBROUTINE scatter_surf_mpi_r(FieldIn,FieldOut)
-  USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
-    REAL :: FieldIn(:)
-    REAL :: FieldOut(:)
-    INTEGER :: ierr
-    
-    IF (is_using_mpi) THEN
-#ifdef CPP_MPI
-      CALL MPI_Scatterv(FieldIn,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER,   &
-                        FieldOut,knon_mpi,MPI_INTEGER,                                &
-                        mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
-    ELSE
-      FieldOut(:)=FieldIn(:)
-    ENDIF
-  
-  END SUBROUTINE scatter_surf_mpi_r
-
-END MODULE mod_surf_para
-
+link ../phylmd/mod_surf_para.F90
Index: LMDZ6/trunk/libf/phylmdiso/mod_synchro_omp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/mod_synchro_omp.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/mod_synchro_omp.F90	(revision 3940)
@@ -1,60 +1,1 @@
-!
-! $Id: mod_synchro_omp.F90 3531 2019-06-06 15:08:45Z fairhead $
-!
-MODULE mod_synchro_omp
-
-    INTEGER,SAVE :: exit_omp  
-
-CONTAINS
-
-  SUBROUTINE Init_synchro_omp
-  USE mod_phys_lmdz_para 
-  IMPLICIT NONE
-
-  CALL omp_barrier
-!$OMP MASTER
-  exit_omp=0
-!$OMP END MASTER    
-  CALL omp_barrier
-
-  END SUBROUTINE Init_Synchro_omp
-  
-  SUBROUTINE Synchro_omp  
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-  LOGICAL :: out
-  CHARACTER (LEN=20) :: modname='synchro_omp'
-  CHARACTER (LEN=80) :: abort_message
-  
-    out=.FALSE.
-!$OMP BARRIER
-!$OMP BARRIER
-!$OMP ATOMIC  
-    exit_omp=exit_omp+1
-!$OMP BARRIER
-!$OMP BARRIER
-    IF (exit_omp==omp_size) THEN
-      out=.TRUE.
-    ENDIF
-    
-    DO WHILE (.NOT. out)
-!$OMP BARRIER
-      IF (exit_omp==omp_size) out=.TRUE.
-!$OMP BARRIER
-    ENDDO
-
-!$OMP BARRIER
-!$OMP MASTER
-    exit_omp=0
-!$OMP END MASTER
-!$OMP BARRIER
-
-    IF (exit_omp/=0) THEN
-       abort_message='synchro_omp'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-  END SUBROUTINE Synchro_omp
-
-
-END MODULE mod_synchro_omp
+link ../phylmd/mod_synchro_omp.F90
Index: LMDZ6/trunk/libf/phylmdiso/moy_undefSTD.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/moy_undefSTD.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/moy_undefSTD.F90	(revision 3940)
@@ -1,147 +1,1 @@
-
-! $Id: moy_undefSTD.F90 3435 2019-01-22 15:21:59Z fairhead $
-
-SUBROUTINE moy_undefstd(itap, itapm1)
-  USE netcdf
-  USE dimphy
-#ifdef CPP_IOIPSL 
-  USE phys_state_var_mod
-#endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
- 
-  USE phys_cal_mod, ONLY: mth_len
-  IMPLICIT NONE
-  include "clesphys.h"
-#ifndef CPP_XIOS 
-  REAL :: missing_val
-#endif
-
-  ! ====================================================================
-
-  ! I. Musat : 09.2004
-
-  ! Moyenne - a des frequences differentes - des valeurs bien definies
-  ! (.NE.missing_val) des variables interpolees a un niveau de
-  ! pression.
-  ! 1) les variables de type "day" (nout=1) ou "mth" (nout=2) sont sommees
-  ! tous les pas de temps de la physique
-
-  ! 2) les variables de type "NMC" (nout=3) sont calculees a partir
-  ! des valeurs instantannees toutes les 6 heures
-
-
-  ! NB: mettre "inst(X)" dans le write_hist*NMC.h !
-  ! ====================================================================
-
-
-  ! variables Input
-  ! INTEGER nlevSTD, klevSTD, itap
-  ! PARAMETER(klevSTD=17)
-  INTEGER itap, itapm1
-
-  ! variables locales
-  ! INTEGER i, k, nout, n
-  ! PARAMETER(nout=3) !nout=1 day/nout=2 mth/nout=3 NMC
-  INTEGER i, k, n
-  ! REAL dtime, freq_outNMC(nout), freq_moyNMC(nout)
-  ! REAL freq_outNMC(nout), freq_calNMC(nout)
-  REAL freq_moynmc(nout)
-
-  ! variables Output
-  ! REAL tnondef(klon,klevSTD,nout)
-  ! REAL tsumSTD(klon,klevSTD,nout)
-
-  REAL un_jour
-  PARAMETER (un_jour=86400.)
-! REAL missing_val
-
-! missing_val = nf90_fill_real
-#ifndef CPP_XIOS
-      missing_val=missing_val_nf90
-#endif
-
-  DO n = 1, nout
-    IF (freq_outnmc(n)<0) THEN
-      freq_moynmc(n) = (mth_len*un_jour)/freq_calnmc(n)
-      ! print*,'moy_undefSTD n freq_out freq_moy =',
-      ! $n,freq_moyNMC(n)
-    ELSE
-      freq_moynmc(n) = freq_outnmc(n)/freq_calnmc(n)
-    END IF
-
-    ! calcul 1 fois pas mois, 1 fois par jour ou toutes les 6h
-
-    IF (n==1 .AND. itap==itapm1 .OR. n>1 .AND. mod(itap,nint(freq_outnmc(n)/ & 
-        phys_tstep))==0) THEN
-
-      ! print*,'moy_undefSTD n itap itapm1',n,itap,itapm1
-
-      DO k = 1, nlevstd
-        DO i = 1, klon
-          IF (tnondef(i,k,n)/=(freq_moynmc(n))) THEN
-            tsumstd(i, k, n) = tsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k,n &
-              ))
-            usumstd(i, k, n) = usumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k,n &
-              ))
-            vsumstd(i, k, n) = vsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k,n &
-              ))
-            wsumstd(i, k, n) = wsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k,n &
-              ))
-            phisumstd(i, k, n) = phisumstd(i, k, n)/ &
-              (freq_moynmc(n)-tnondef(i,k,n))
-            qsumstd(i, k, n) = qsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k,n &
-              ))
-            rhsumstd(i, k, n) = rhsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            uvsumstd(i, k, n) = uvsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            vqsumstd(i, k, n) = vqsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            vtsumstd(i, k, n) = vtsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            wqsumstd(i, k, n) = wqsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            vphisumstd(i, k, n) = vphisumstd(i, k, n)/ &
-              (freq_moynmc(n)-tnondef(i,k,n))
-            wtsumstd(i, k, n) = wtsumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            u2sumstd(i, k, n) = u2sumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            v2sumstd(i, k, n) = v2sumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            t2sumstd(i, k, n) = t2sumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            o3sumstd(i, k, n) = o3sumstd(i, k, n)/(freq_moynmc(n)-tnondef(i,k &
-              ,n))
-            o3daysumstd(i, k, n) = o3daysumstd(i, k, n)/ &
-              (freq_moynmc(n)-tnondef(i,k,n))
-          ELSE
-            tsumstd(i, k, n) = missing_val
-            usumstd(i, k, n) = missing_val
-            vsumstd(i, k, n) = missing_val
-            wsumstd(i, k, n) = missing_val
-            phisumstd(i, k, n) = missing_val
-            qsumstd(i, k, n) = missing_val
-            rhsumstd(i, k, n) = missing_val
-            uvsumstd(i, k, n) = missing_val
-            vqsumstd(i, k, n) = missing_val
-            vtsumstd(i, k, n) = missing_val
-            wqsumstd(i, k, n) = missing_val
-            vphisumstd(i, k, n) = missing_val
-            wtsumstd(i, k, n) = missing_val
-            u2sumstd(i, k, n) = missing_val
-            v2sumstd(i, k, n) = missing_val
-            t2sumstd(i, k, n) = missing_val
-            o3sumstd(i, k, n) = missing_val
-            o3daysumstd(i, k, n) = missing_val
-          END IF !tnondef(i,k,n).NE.(freq_moyNMC(n))
-        END DO !i
-      END DO !k
-    END IF !MOD(itap,NINT(freq_outNMC(n)/phys_tstep)).EQ.0
-
-  END DO !n
-
-  RETURN
-END SUBROUTINE moy_undefstd
+link ../phylmd/moy_undefSTD.F90
Index: LMDZ6/trunk/libf/phylmdiso/moyglo_aire.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/moyglo_aire.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/moyglo_aire.F90	(revision 3940)
@@ -1,149 +1,1 @@
-
-! $Header$
-
-SUBROUTINE moyglo_pondaire(nhori, champ, aire, ok_msk, msk, moyglo)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! ==================================================================
-  ! I. Musat, 07.2004
-
-  ! Calcul moyenne globale ponderee par l'aire totale, avec ou sans masque
-
-  ! moyenne = Somme_(champ* aire)/Somme_aire
-
-  ! ==================================================================
-
-  INTEGER i, nhori
-  REAL champ(klon), aire(klon), msk(klon)
-  LOGICAL ok_msk
-  REAL moyglo
-
-  ! var locale
-  REAL airetot
-
-  ! PRINT*,'moyglo_pondaire nhori',nhori
-
-  airetot = 0.
-  moyglo = 0.
-
-  IF (ok_msk) THEN
-    DO i = 1, nhori
-      ! IF(msk(i).EQ.1.) THEN
-      IF (msk(i)>0.) THEN
-
-        ! aire totale
-        airetot = airetot + aire(i)*msk(i)
-
-        ! ponderation par la masse
-        moyglo = moyglo + champ(i)*aire(i)*msk(i)
-      END IF
-    END DO
-
-  ELSE !ok_msk
-    DO i = 1, nhori
-
-      ! aire totale
-      airetot = airetot + aire(i)
-
-      ! ponderation par la masse
-      moyglo = moyglo + champ(i)*aire(i)
-    END DO
-
-  END IF
-
-  ! moyenne ponderee par l'aire
-  moyglo = moyglo/airetot
-
-  RETURN
-END SUBROUTINE moyglo_pondaire
-
-SUBROUTINE moyglo_pondaima(nhori, nvert, champ, aire, pbord, moyglo)
-  USE dimphy
-  IMPLICIT NONE
-  ! ==================================================================
-  ! I. Musat, 07.2004
-
-  ! Calcul moyenne globale ponderee par la masse d'air, divisee par l'aire
-  ! totale avec ou sans masque
-
-  ! moyenne = Somme_(champ* masse_dair)/Somme_aire
-
-  ! ==================================================================
-  include "YOMCST.h"
-  INTEGER i, k, nhori, nvert
-  REAL champ(klon, klev), aire(klon)
-  REAL pbord(klon, klev+1)
-  REAL moyglo
-
-  ! var locale
-  REAL airetot
-
-  ! PRINT*,'moyglo_pondaima RG, nhori, nvert',RG,nhori,nvert
-
-  ! ponderation par la masse
-  moyglo = 0.
-  DO k = 1, nvert
-    DO i = 1, nhori
-      moyglo = moyglo + champ(i, k)*(pbord(i,k)-pbord(i,k+1))/rg*aire(i)
-    END DO
-  END DO
-
-  ! aire totale
-  airetot = 0.
-  DO i = 1, nhori
-    airetot = airetot + aire(i)
-  END DO
-
-  ! moyenne par mettre carre avec ponderation par la masse
-  moyglo = moyglo/airetot
-
-  RETURN
-END SUBROUTINE moyglo_pondaima
-
-SUBROUTINE moyglo_pondmass(nhori, nvert, champ, aire, pbord, moyglo)
-  USE dimphy
-  IMPLICIT NONE
-  ! ==================================================================
-  ! I. Musat, 07.2004
-
-  ! Calcul moyenne globale ponderee par la masse d'air, divisee par la
-  ! masse totale d'air, avec ou sans masque
-
-  ! moyenne = Somme_(champ* masse_dair)/Somme_(masse_dair)
-
-  ! ==================================================================
-  include "YOMCST.h"
-  INTEGER i, k, nhori, nvert
-  REAL champ(klon, klev), aire(klon)
-  REAL pbord(klon, klev+1)
-  REAL moyglo
-
-  ! var locale
-  REAL massetot
-
-  ! PRINT*,'moyglo_pondmass RG, nhori, nvert',RG,nhori,nvert
-
-  ! ponderation par la masse
-  moyglo = 0.
-  DO k = 1, nvert
-    DO i = 1, nhori
-      moyglo = moyglo + champ(i, k)*(pbord(i,k)-pbord(i,k+1))/rg*aire(i)
-    END DO
-  END DO
-
-  ! masse totale
-  massetot = 0.
-  DO k = 1, nvert
-    DO i = 1, nhori
-      massetot = massetot + (pbord(i,k)-pbord(i,k+1))/rg*aire(i)
-    END DO
-  END DO
-
-  ! moyenne par mettre carre avec ponderation par la masse
-  moyglo = moyglo/massetot
-
-  RETURN
-END SUBROUTINE moyglo_pondmass
-
+link ../phylmd/moyglo_aire.F90
Index: LMDZ6/trunk/libf/phylmdiso/newmicro.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/newmicro.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/newmicro.F90	(revision 3940)
@@ -1,705 +1,1 @@
-! $Id: newmicro.F90 3281 2018-03-16 18:26:14Z musat $
-
-SUBROUTINE newmicro(flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, pclc, &
-    pcltau, pclemi, pch, pcl, pcm, pct, pctlwp, xflwp, xfiwp, xflwc, xfiwc, &
-    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, re, fl, reliq, reice, &
-    reliq_pi, reice_pi)
-
-  USE dimphy
-  USE phys_local_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
-      reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
-      zfice, dNovrN
-  USE phys_state_var_mod, ONLY: rnebcon, clwcon
-  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE print_control_mod, ONLY: lunout
-
-
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
-  ! O.   Boucher (LMD/CNRS) mise a jour en 201212
-  ! I. Musat (LMD/CNRS) : prise en compte de la meme hypothese de recouvrement
-  !                       pour les nuages que pour le rayonnement rrtm via
-  !                       le parametre novlp de radopt.h : 20160721
-  ! Objet: Calculer epaisseur optique et emmissivite des nuages
-  ! ======================================================================
-  ! Arguments:
-  ! ok_cdnc-input-L-flag pour calculer les rayons a partir des aerosols
-
-  ! t-------input-R-temperature
-  ! pqlwp---input-R-eau liquide nuageuse dans l'atmosphere dans la partie
-  ! nuageuse (kg/kg)
-  ! pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
-  ! mass_solu_aero-----input-R-total mass concentration for all soluble
-  ! aerosols[ug/m^3]
-  ! mass_solu_aero_pi--input-R-ditto, pre-industrial value
-
-  ! bl95_b0-input-R-a PARAMETER, may be varied for tests (s-sea, l-land)
-  ! bl95_b1-input-R-a PARAMETER, may be varied for tests (    -"-      )
-
-  ! re------output-R-Cloud droplet effective radius multiplied by fl [um]
-  ! fl------output-R-Denominator to re, introduced to avoid problems in
-  ! the averaging of the output. fl is the fraction of liquid
-  ! water clouds within a grid cell
-
-  ! pcltau--output-R-epaisseur optique des nuages
-  ! pclemi--output-R-emissivite des nuages (0 a 1)
-  ! pcldtaupi-output-R-pre-industrial value of cloud optical thickness,
-
-  ! pcl-output-R-2D low-level cloud cover
-  ! pcm-output-R-2D mid-level cloud cover
-  ! pch-output-R-2D high-level cloud cover
-  ! pct-output-R-2D total cloud cover
-  ! ======================================================================
-
-  include "YOMCST.h"
-  include "nuage.h"
-  include "radepsi.h"
-  include "radopt.h"
-
-  ! choix de l'hypothese de recouvrement nuageuse via radopt.h (IM, 19.07.2016)
-  ! !novlp=1: max-random
-  ! !novlp=2: maximum
-  ! !novlp=3: random
-! LOGICAL random, maximum_random, maximum
-! PARAMETER (random=.FALSE., maximum_random=.TRUE., maximum=.FALSE.)
-
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(FIRST)
-  INTEGER flag_max
-
-  ! threshold PARAMETERs
-  REAL thres_tau, thres_neb
-  PARAMETER (thres_tau=0.3, thres_neb=0.001)
-
-  REAL phase3d(klon, klev)
-  REAL tcc(klon), ftmp(klon), lcc_integrat(klon), height(klon)
-
-  REAL paprs(klon, klev+1)
-  REAL pplay(klon, klev)
-  REAL t(klon, klev)
-  REAL pclc(klon, klev)
-  REAL pqlwp(klon, klev)
-  REAL pcltau(klon, klev)
-  REAL pclemi(klon, klev)
-  REAL pcldtaupi(klon, klev)
-
-  REAL pct(klon)
-  REAL pcl(klon)
-  REAL pcm(klon)
-  REAL pch(klon)
-  REAL pctlwp(klon)
-
-  LOGICAL lo
-
-  ! !Abderr modif JL mail du 19.01.2011 18:31
-  ! REAL cetahb, cetamb
-  ! PARAMETER (cetahb = 0.45, cetamb = 0.80)
-  ! Remplacer
-  ! cetahb*paprs(i,1) par  prmhc
-  ! cetamb*paprs(i,1) par  prlmc
-  REAL prmhc ! Pressure between medium and high level cloud in Pa
-  REAL prlmc ! Pressure between low and medium level cloud in Pa
-  PARAMETER (prmhc=440.*100., prlmc=680.*100.)
-
-  INTEGER i, k
-  REAL xflwp(klon), xfiwp(klon)
-  REAL xflwc(klon, klev), xfiwc(klon, klev)
-
-  REAL radius
-
-  REAL coef_froi, coef_chau
-  PARAMETER (coef_chau=0.13, coef_froi=0.09)
-
-  REAL seuil_neb
-  PARAMETER (seuil_neb=0.001)
-
-! JBM (3/14) nexpo is replaced by exposant_glace
-! INTEGER nexpo ! exponentiel pour glace/eau
-! PARAMETER (nexpo=6)
-! PARAMETER (nexpo=1)
-! if iflag_t_glace=0, the old values are used:
-  REAL, PARAMETER :: t_glace_min_old = 258.
-  REAL, PARAMETER :: t_glace_max_old = 273.13
-
-  REAL rel, tc, rei
-  REAL k_ice0, k_ice, df
-  PARAMETER (k_ice0=0.005) ! units=m2/g
-  PARAMETER (df=1.66) ! diffusivity factor
-
-  ! jq for the aerosol indirect effect
-  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
-  ! jq
-  REAL mass_solu_aero(klon, klev) ! total mass concentration for all soluble aerosols [ug m-3]
-  REAL mass_solu_aero_pi(klon, klev) ! - " - (pre-industrial value)
-  REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3]
-  REAL re(klon, klev) ! cloud droplet effective radius [um]
-  REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value)
-  REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value)
-
-  REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds
-  ! within the grid cell)
-
-  INTEGER flag_aerosol
-  LOGICAL ok_cdnc
-  REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
-
-  ! jq-end
-  ! IM cf. CR:parametres supplementaires
-  REAL zclear(klon)
-  REAL zcloud(klon)
-  REAL zcloudh(klon)
-  REAL zcloudm(klon)
-  REAL zcloudl(klon)
-  REAL rhodz(klon, klev) !--rho*dz pour la couche
-  REAL zrho(klon, klev) !--rho pour la couche
-  REAL dh(klon, klev) !--dz pour la couche
-  REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds
-  REAL rad_chaud_pi(klon, klev) !--rayon pour les nuages chauds pre-industriels
-  REAL zflwp_var, zfiwp_var
-  REAL d_rei_dt
-
-  ! Abderrahmane oct 2009
-  REAL reliq(klon, klev), reice(klon, klev)
-  REAL reliq_pi(klon, klev), reice_pi(klon, klev)
-
-  REAL,SAVE :: cdnc_min=-1.
-  REAL,SAVE :: cdnc_min_m3
-  !$OMP THREADPRIVATE(cdnc_min,cdnc_min_m3)
-  REAL,SAVE :: cdnc_max=-1.
-  REAL,SAVE :: cdnc_max_m3
-  !$OMP THREADPRIVATE(cdnc_max,cdnc_max_m3)
-
-  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  ! FH : 2011/05/24
-
-  ! rei = ( rei_max - rei_min ) * T(°C) / 81.4 + rei_max
-  ! to be used for a temperature in celcius T(°C) < 0
-  ! rei=rei_min for T(°C) < -81.4
-
-  ! Calcul de la pente de la relation entre rayon effective des cristaux
-  ! et la température.
-  ! Pour retrouver les résultats numériques de la version d'origine,
-  ! on impose 0.71 quand on est proche de 0.71
-
-  if (first) THEN
-      call getin_p('cdnc_min',cdnc_min)
-      cdnc_min_m3=cdnc_min*1.E6
-      IF (cdnc_min_m3<0.) cdnc_min_m3=20.E6 ! astuce pour retrocompatibilite
-      write(lunout,*)'cdnc_min=', cdnc_min_m3/1.E6
-      call getin_p('cdnc_max',cdnc_max)
-      cdnc_max_m3=cdnc_max*1.E6
-      IF (cdnc_max_m3<0.) cdnc_max_m3=1000.E6 ! astuce pour retrocompatibilite
-      write(lunout,*)'cdnc_max=', cdnc_max_m3/1.E6
-  ENDIF
-
-  d_rei_dt = (rei_max-rei_min)/81.4
-  IF (abs(d_rei_dt-0.71)<1.E-4) d_rei_dt = 0.71
-  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  ! Calculer l'epaisseur optique et l'emmissivite des nuages
-  ! IM inversion des DO
-
-  xflwp = 0.D0
-  xfiwp = 0.D0
-  xflwc = 0.D0
-  xfiwc = 0.D0
-
-  reliq = 0.
-  reice = 0.
-  reliq_pi = 0.
-  reice_pi = 0.
-
-  IF (iflag_t_glace.EQ.0) THEN
-    DO k = 1, klev
-      DO i = 1, klon
-        ! -layer calculation
-        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
-        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
-        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
-        ! -Fraction of ice in cloud using a linear transition
-        zfice(i, k) = 1.0 - (t(i,k)-t_glace_min_old)/(t_glace_max_old-t_glace_min_old)
-        zfice(i, k) = min(max(zfice(i,k),0.0), 1.0)
-        ! -IM Total Liquid/Ice water content
-        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
-        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
-      ENDDO
-    ENDDO
-  ELSE ! of IF (iflag_t_glace.EQ.0)
-    DO k = 1, klev
-        CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k))
- 
-
-        ! JBM: icefrac_lsc is now contained icefrac_lsc_mod
-!       zfice(i, k) = icefrac_lsc(t(i,k), t_glace_min, &
-!                                 t_glace_max, exposant_glace)
-      DO i = 1, klon
-        ! -layer calculation
-        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
-        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
-        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
-        ! -IM Total Liquid/Ice water content
-        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
-        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
-      ENDDO
-    ENDDO
-  ENDIF
-
-  IF (ok_cdnc) THEN
-
-    ! --we compute cloud properties as a function of the aerosol load
-
-    DO k = 1, klev
-      DO i = 1, klon
-        ! Formula "D" of Boucher and Lohmann, Tellus, 1995
-        ! Cloud droplet number concentration (CDNC) is restricted
-        ! to be within [20, 1000 cm^3]
-
-        ! --pre-industrial case
-        cdnc_pi(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero_pi(i,k), &
-          1.E-4))/log(10.))*1.E6 !-m-3
-        cdnc_pi(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc_pi(i,k)))
-
-      ENDDO
-    ENDDO
-
-    !--flag_aerosol=7 => MACv2SP climatology 
-    !--in this case there is an enhancement factor
-    IF (flag_aerosol .EQ. 7) THEN 
-
-      !--present-day
-      DO k = 1, klev
-        DO i = 1, klon
-          cdnc(i, k) = cdnc_pi(i,k)*dNovrN(i)
-        ENDDO
-      ENDDO
-
-    !--standard case
-    ELSE
-
-      DO k = 1, klev
-        DO i = 1, klon
-
-          ! Formula "D" of Boucher and Lohmann, Tellus, 1995
-          ! Cloud droplet number concentration (CDNC) is restricted
-          ! to be within [20, 1000 cm^3]
-
-          ! --present-day case
-          cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
-            1.E-4))/log(10.))*1.E6 !-m-3
-          cdnc(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc(i,k)))
-
-        ENDDO
-      ENDDO
-
-    ENDIF !--flag_aerosol
-
-    !--computing cloud droplet size
-    DO k = 1, klev
-      DO i = 1, klon
-
-        ! --present-day case
-        rad_chaud(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
-          k)/(rd*t(i,k)))/(4./3*rpi*1000.*cdnc(i,k)))**(1./3.)
-        rad_chaud(i, k) = max(rad_chaud(i,k)*1.E6, 5.)
-
-        ! --pre-industrial case
-        rad_chaud_pi(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
-          k)/(rd*t(i,k)))/(4./3.*rpi*1000.*cdnc_pi(i,k)))**(1./3.)
-        rad_chaud_pi(i, k) = max(rad_chaud_pi(i,k)*1.E6, 5.)
-
-        ! --pre-industrial case
-        ! --liquid/ice cloud water paths:
-        IF (pclc(i,k)<=seuil_neb) THEN
-
-          pcldtaupi(i, k) = 0.0
-
-        ELSE
-
-          zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)* &
-            rhodz(i, k)
-          zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
-          tc = t(i, k) - 273.15
-          rei = d_rei_dt*tc + rei_max
-          IF (tc<=-81.4) rei = rei_min
-
-          ! -- cloud optical thickness :
-          ! [for liquid clouds, traditional formula,
-          ! for ice clouds, Ebert & Curry (1992)]
-
-          IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
-          pcldtaupi(i, k) = 3.0/2.0*zflwp_var/rad_chaud_pi(i, k) + &
-            zfiwp_var*(3.448E-03+2.431/rei)
-
-        ENDIF
-
-      ENDDO
-    ENDDO
-
-  ELSE !--not ok_cdnc
-
-    ! -prescribed cloud droplet radius
-
-    DO k = 1, min(3, klev)
-      DO i = 1, klon
-        rad_chaud(i, k) = rad_chau2
-        rad_chaud_pi(i, k) = rad_chau2
-      ENDDO
-    ENDDO
-    DO k = min(3, klev) + 1, klev
-      DO i = 1, klon
-        rad_chaud(i, k) = rad_chau1
-        rad_chaud_pi(i, k) = rad_chau1
-      ENDDO
-    ENDDO
-
-  ENDIF !--ok_cdnc
-
-  ! --computation of cloud optical depth and emissivity
-  ! --in the general case
-
-  DO k = 1, klev
-    DO i = 1, klon
-
-      IF (pclc(i,k)<=seuil_neb) THEN
-
-        ! effective cloud droplet radius (microns) for liquid water clouds:
-        ! For output diagnostics cloud droplet effective radius [um]
-        ! we multiply here with f * xl (fraction of liquid water
-        ! clouds in the grid cell) to avoid problems in the averaging of the
-        ! output.
-        ! In the output of IOIPSL, derive the REAL cloud droplet
-        ! effective radius as re/fl
-
-        fl(i, k) = seuil_neb*(1.-zfice(i,k))
-        re(i, k) = rad_chaud(i, k)*fl(i, k)
-        rel = 0.
-        rei = 0.
-        pclc(i, k) = 0.0
-        pcltau(i, k) = 0.0
-        pclemi(i, k) = 0.0
-
-      ELSE
-
-        ! -- liquid/ice cloud water paths:
-
-        zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
-        zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
-
-        ! effective cloud droplet radius (microns) for liquid water clouds:
-        ! For output diagnostics cloud droplet effective radius [um]
-        ! we multiply here with f * xl (fraction of liquid water
-        ! clouds in the grid cell) to avoid problems in the averaging of the
-        ! output.
-        ! In the output of IOIPSL, derive the REAL cloud droplet
-        ! effective radius as re/fl
-
-        fl(i, k) = pclc(i, k)*(1.-zfice(i,k))
-        re(i, k) = rad_chaud(i, k)*fl(i, k)
-
-        rel = rad_chaud(i, k)
-
-        ! for ice clouds: as a function of the ambiant temperature
-        ! [formula used by Iacobellis and Somerville (2000), with an
-        ! asymptotical value of 3.5 microns at T<-81.4 C added to be
-        ! consistent with observations of Heymsfield et al. 1986]:
-        ! 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as
-        ! rei_max=61.29
-
-        tc = t(i, k) - 273.15
-        rei = d_rei_dt*tc + rei_max
-        IF (tc<=-81.4) rei = rei_min
-
-        ! -- cloud optical thickness :
-        ! [for liquid clouds, traditional formula,
-        ! for ice clouds, Ebert & Curry (1992)]
-
-        IF (zflwp_var==0.) rel = 1.
-        IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
-        pcltau(i, k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/ &
-          rei)
-
-        ! -- cloud infrared emissivity:
-        ! [the broadband infrared absorption coefficient is PARAMETERized
-        ! as a function of the effective cld droplet radius]
-        ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
-
-        k_ice = k_ice0 + 1.0/rei
-
-        pclemi(i, k) = 1.0 - exp(-coef_chau*zflwp_var-df*k_ice*zfiwp_var)
-
-      ENDIF
-
-      reice(i, k) = rei
-
-      xflwp(i) = xflwp(i) + xflwc(i, k)*rhodz(i, k)
-      xfiwp(i) = xfiwp(i) + xfiwc(i, k)*rhodz(i, k)
-
-    ENDDO
-  ENDDO
-
-  ! --if cloud droplet radius is fixed, then pcldtaupi=pcltau
-
-  IF (.NOT. ok_cdnc) THEN
-    DO k = 1, klev
-      DO i = 1, klon
-        pcldtaupi(i, k) = pcltau(i, k)
-        reice_pi(i, k) = reice(i, k)
-      ENDDO
-    ENDDO
-  ENDIF
-
-  DO k = 1, klev
-    DO i = 1, klon
-      reliq(i, k) = rad_chaud(i, k)
-      reliq_pi(i, k) = rad_chaud_pi(i, k)
-      reice_pi(i, k) = reice(i, k)
-    ENDDO
-  ENDDO
-
-  ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
-  ! IM cf. CR:test: calcul prenant ou non en compte le recouvrement
-  ! initialisations
-
-  DO i = 1, klon
-    zclear(i) = 1.
-    zcloud(i) = 0.
-    zcloudh(i) = 0.
-    zcloudm(i) = 0.
-    zcloudl(i) = 0.
-    pch(i) = 1.0
-    pcm(i) = 1.0
-    pcl(i) = 1.0
-    pctlwp(i) = 0.0
-  ENDDO
-
-  ! --calculation of liquid water path
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      pctlwp(i) = pctlwp(i) + pqlwp(i, k)*rhodz(i, k)
-    ENDDO
-  ENDDO
-
-  ! --calculation of cloud properties with cloud overlap
-
-  IF (novlp==1) THEN
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        zclear(i) = zclear(i)*(1.-max(pclc(i,k),zcloud(i)))/(1.-min(real( &
-          zcloud(i),kind=8),1.-zepsec))
-        pct(i) = 1. - zclear(i)
-        IF (paprs(i,k)<prmhc) THEN
-          pch(i) = pch(i)*(1.-max(pclc(i,k),zcloudh(i)))/(1.-min(real(zcloudh &
-            (i),kind=8),1.-zepsec))
-          zcloudh(i) = pclc(i, k)
-        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
-          pcm(i) = pcm(i)*(1.-max(pclc(i,k),zcloudm(i)))/(1.-min(real(zcloudm &
-            (i),kind=8),1.-zepsec))
-          zcloudm(i) = pclc(i, k)
-        ELSE IF (paprs(i,k)>=prlmc) THEN
-          pcl(i) = pcl(i)*(1.-max(pclc(i,k),zcloudl(i)))/(1.-min(real(zcloudl &
-            (i),kind=8),1.-zepsec))
-          zcloudl(i) = pclc(i, k)
-        ENDIF
-        zcloud(i) = pclc(i, k)
-      ENDDO
-    ENDDO
-  ELSE IF (novlp==2) THEN
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        zcloud(i) = max(pclc(i,k), zcloud(i))
-        pct(i) = zcloud(i)
-        IF (paprs(i,k)<prmhc) THEN
-          pch(i) = min(pclc(i,k), pch(i))
-        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
-          pcm(i) = min(pclc(i,k), pcm(i))
-        ELSE IF (paprs(i,k)>=prlmc) THEN
-          pcl(i) = min(pclc(i,k), pcl(i))
-        ENDIF
-      ENDDO
-    ENDDO
-  ELSE IF (novlp==3) THEN
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        zclear(i) = zclear(i)*(1.-pclc(i,k))
-        pct(i) = 1 - zclear(i)
-        IF (paprs(i,k)<prmhc) THEN
-          pch(i) = pch(i)*(1.0-pclc(i,k))
-        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
-          pcm(i) = pcm(i)*(1.0-pclc(i,k))
-        ELSE IF (paprs(i,k)>=prlmc) THEN
-          pcl(i) = pcl(i)*(1.0-pclc(i,k))
-        ENDIF
-      ENDDO
-    ENDDO
-  ENDIF
-
-  DO i = 1, klon
-    pch(i) = 1. - pch(i)
-    pcm(i) = 1. - pcm(i)
-    pcl(i) = 1. - pcl(i)
-  ENDDO
-
-  ! ========================================================
-  ! DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL
-  ! ========================================================
-  ! change by Nicolas Yan (LSCE)
-  ! Cloud Droplet Number Concentration (CDNC) : 3D variable
-  ! Fractionnal cover by liquid water cloud (LCC3D) : 3D variable
-  ! Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable
-  ! Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable
-  ! Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable
-
-  IF (ok_cdnc) THEN
-
-    DO k = 1, klev
-      DO i = 1, klon
-        phase3d(i, k) = 1 - zfice(i, k)
-        IF (pclc(i,k)<=seuil_neb) THEN
-          lcc3d(i, k) = seuil_neb*phase3d(i, k)
-        ELSE
-          lcc3d(i, k) = pclc(i, k)*phase3d(i, k)
-        ENDIF
-        scdnc(i, k) = lcc3d(i, k)*cdnc(i, k) ! m-3
-      ENDDO
-    ENDDO
-
-    DO i = 1, klon
-      lcc(i) = 0.
-      reffclwtop(i) = 0.
-      cldncl(i) = 0.
-      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1.
-      IF (novlp.EQ.2) tcc(i) = 0.
-    ENDDO
-
-    DO i = 1, klon
-      DO k = klev - 1, 1, -1 !From TOA down
-
-          ! Test, if the cloud optical depth exceeds the necessary
-          ! threshold:
-
-        IF (pcltau(i,k)>thres_tau .AND. pclc(i,k)>thres_neb) THEN
-
-          IF (novlp.EQ.2) THEN
-            IF (first) THEN
-              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
-              first = .FALSE.
-            ENDIF
-            flag_max = -1.
-            ftmp(i) = max(tcc(i), pclc(i,k))
-          ENDIF
-
-          IF (novlp.EQ.3) THEN
-            IF (first) THEN
-              WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
-              first = .FALSE.
-            ENDIF
-            flag_max = 1.
-            ftmp(i) = tcc(i)*(1-pclc(i,k))
-          ENDIF
-
-          IF (novlp.EQ.1) THEN
-            IF (first) THEN
-              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM_ &
-                &                                             &
-                &                                          RANDOM'
-              first = .FALSE.
-            ENDIF
-            flag_max = 1.
-            ftmp(i) = tcc(i)*(1.-max(pclc(i,k),pclc(i,k+1)))/(1.-min(pclc(i, &
-              k+1),1.-thres_neb))
-          ENDIF
-          ! Effective radius of cloud droplet at top of cloud (m)
-          reffclwtop(i) = reffclwtop(i) + rad_chaud(i, k)*1.0E-06*phase3d(i, &
-            k)*(tcc(i)-ftmp(i))*flag_max
-          ! CDNC at top of cloud (m-3)
-          cldncl(i) = cldncl(i) + cdnc(i, k)*phase3d(i, k)*(tcc(i)-ftmp(i))* &
-            flag_max
-          ! Liquid Cloud Content at top of cloud
-          lcc(i) = lcc(i) + phase3d(i, k)*(tcc(i)-ftmp(i))*flag_max
-          ! Total Cloud Content at top of cloud
-          tcc(i) = ftmp(i)
-
-        ENDIF ! is there a visible, not-too-small cloud?
-      ENDDO ! loop over k
-
-      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1. - tcc(i)
-
-    ENDDO ! loop over i
-
-    ! ! Convective and Stratiform Cloud Droplet Effective Radius (REFFCLWC
-    ! REFFCLWS)
-    DO i = 1, klon
-      DO k = 1, klev
-        ! Weight to be used for outputs: eau_liquide*couverture nuageuse
-        lcc3dcon(i, k) = rnebcon(i, k)*phase3d(i, k)*clwcon(i, k) ! eau liquide convective
-        lcc3dstra(i, k) = pclc(i, k)*pqlwp(i, k)*phase3d(i, k)
-        lcc3dstra(i, k) = lcc3dstra(i, k) - lcc3dcon(i, k) ! eau liquide stratiforme
-        lcc3dstra(i, k) = max(lcc3dstra(i,k), 0.0)
-        !FC pour la glace (CAUSES)
-        icc3dcon(i, k) = rnebcon(i, k)*(1-phase3d(i, k))*clwcon(i, k) !  glace convective
-        icc3dstra(i, k)= pclc(i, k)*pqlwp(i, k)*(1-phase3d(i, k))
-        icc3dstra(i, k) = icc3dstra(i, k) - icc3dcon(i, k) ! glace stratiforme
-        icc3dstra(i, k) = max( icc3dstra(i, k), 0.0)
-        !FC (CAUSES)
-
-        ! Compute cloud droplet radius as above in meter
-        radius = 1.1*((pqlwp(i,k)*pplay(i,k)/(rd*t(i,k)))/(4./3*rpi*1000.* &
-          cdnc(i,k)))**(1./3.)
-        radius = max(radius, 5.E-6)
-        ! Convective Cloud Droplet Effective Radius (REFFCLWC) : variable 3D
-        reffclwc(i, k) = radius
-        reffclwc(i, k) = reffclwc(i, k)*lcc3dcon(i, k)
-        ! Stratiform Cloud Droplet Effective Radius (REFFCLWS) : variable 3D
-        reffclws(i, k) = radius
-        reffclws(i, k) = reffclws(i, k)*lcc3dstra(i, k)
-      ENDDO !klev
-    ENDDO !klon
-
-    ! Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D
-
-    DO i = 1, klon
-      cldnvi(i) = 0.
-      lcc_integrat(i) = 0.
-      height(i) = 0.
-      DO k = 1, klev
-        cldnvi(i) = cldnvi(i) + cdnc(i, k)*lcc3d(i, k)*dh(i, k)
-        lcc_integrat(i) = lcc_integrat(i) + lcc3d(i, k)*dh(i, k)
-        height(i) = height(i) + dh(i, k)
-      ENDDO ! klev
-      lcc_integrat(i) = lcc_integrat(i)/height(i)
-      IF (lcc_integrat(i)<=1.0E-03) THEN
-        cldnvi(i) = cldnvi(i)*lcc(i)/seuil_neb
-      ELSE
-        cldnvi(i) = cldnvi(i)*lcc(i)/lcc_integrat(i)
-      ENDIF
-    ENDDO ! klon
-
-    DO i = 1, klon
-      DO k = 1, klev
-        IF (scdnc(i,k)<=0.0) scdnc(i, k) = 0.0
-        IF (reffclws(i,k)<=0.0) reffclws(i, k) = 0.0
-        IF (reffclwc(i,k)<=0.0) reffclwc(i, k) = 0.0
-        IF (lcc3d(i,k)<=0.0) lcc3d(i, k) = 0.0
-        IF (lcc3dcon(i,k)<=0.0) lcc3dcon(i, k) = 0.0
-        IF (lcc3dstra(i,k)<=0.0) lcc3dstra(i, k) = 0.0
-!FC (CAUSES)
-        IF (icc3dcon(i,k)<=0.0) icc3dcon(i, k) = 0.0
-        IF (icc3dstra(i,k)<=0.0) icc3dstra(i, k) = 0.0
-!FC (CAUSES)
-      ENDDO
-      IF (reffclwtop(i)<=0.0) reffclwtop(i) = 0.0
-      IF (cldncl(i)<=0.0) cldncl(i) = 0.0
-      IF (cldnvi(i)<=0.0) cldnvi(i) = 0.0
-      IF (lcc(i)<=0.0) lcc(i) = 0.0
-    ENDDO
-
-  ENDIF !ok_cdnc
-
-  first=.false. !to be sure
-
-  RETURN
-
-END SUBROUTINE newmicro
+link ../phylmd/newmicro.F90
Index: LMDZ6/trunk/libf/phylmdiso/nflxtr.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/nflxtr.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/nflxtr.F90	(revision 3940)
@@ -1,159 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE nflxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d,pplay,paprs,x,dx) 
-  USE dimphy
-  IMPLICIT NONE 
-!=====================================================================
-! Objet : Melange convectif de traceurs a partir des flux de masse 
-! Date : 13/12/1996 -- 13/01/97
-! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
-!         Brinkop et Sausen (1996) et Boucher et al. (1996).
-! ATTENTION : meme si cette routine se veut la plus generale possible, 
-!             elle a herite de certaines notations et conventions du 
-!             schema de Tiedtke (1993).
-! 1. En particulier, les couches sont numerotees de haut en bas !!!
-!    Ceci est valable pour les flux
-!    mais pas pour les entrees x, pplay, paprs !!!!
-! 2. pmfu est positif, pmfd est negatif 
-! 3. Tous les flux d'entrainements et de detrainements sont positifs 
-!    contrairement au schema de Tiedtke d'ou les changements de signe!!!! 
-!=====================================================================
-!
-  include "YOMCST.h"
-  include "YOECUMF.h" 
-
-  REAL,INTENT(IN) :: pdtime  ! pdtphys
-!
-! les flux sont definis au 1/2 niveaux 
-! => pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
-!
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu  ! flux de masse dans le panache montant 
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd  ! flux de masse dans le panache descendant
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
-
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay ! pression aux couches (bas en haut)
-  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression aux 1/2 couches (bas en haut)
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: x     ! q de traceur (bas en haut) 
-  REAL,DIMENSION(klon,klev),INTENT(INOUT) :: dx   ! tendance de traceur  (bas en haut)
-
-! flux convectifs mais en variables locales
-  REAL,DIMENSION(klon,klev+1) :: zmfu  ! copie de pmfu avec klev+1 = 0
-  REAL,DIMENSION(klon,klev+1) :: zmfd  ! copie de pmfd avec klev+1 = 0
-  REAL,DIMENSION(klon,klev)   :: zen_u
-  REAL,DIMENSION(klon,klev)   :: zde_u
-  REAL,DIMENSION(klon,klev)   :: zen_d
-  REAL,DIMENSION(klon,klev)   :: zde_d
-  REAL                        :: zmfe
-
-! variables locales      
-! les flux de x sont definis aux 1/2 niveaux 
-! xu et xd sont definis aux niveaux complets
-  REAL,DIMENSION(klon,klev)   :: xu      ! q de traceurs dans le panache montant
-  REAL,DIMENSION(klon,klev)   :: xd      ! q de traceurs dans le panache descendant
-  REAL,DIMENSION(klon,klev+1) :: zmfux   ! flux de x dans le panache montant
-  REAL,DIMENSION(klon,klev+1) :: zmfdx   ! flux de x dans le panache descendant
-  REAL,DIMENSION(klon,klev+1) :: zmfex   ! flux de x dans l'environnement 
-  INTEGER                     :: i, k 
-  REAL,PARAMETER              :: zmfmin=1.E-10
-
-! ==============================================
-! Extension des flux UP et DN sur klev+1 niveaux
-! ==============================================
-  DO k=1,klev
-     DO i=1,klon
-        zmfu(i,k)=pmfu(i,k)
-        zmfd(i,k)=pmfd(i,k)
-     ENDDO
-  ENDDO
-  DO i=1,klon
-     zmfu(i,klev+1)=0.
-     zmfd(i,klev+1)=0.
-  ENDDO
-! ==========================================
-! modif pour diagnostiquer les detrainements
-! ==========================================
-!   on privilegie l'ajustement de l'entrainement dans l'ascendance.
-
-  DO k=1, klev
-     DO i=1, klon
-        zen_d(i,k)=pen_d(i,k)
-        zde_u(i,k)=pde_u(i,k)
-        zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)
-        zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)
-     ENDDO
-  ENDDO
-! =========================================
-! calcul des flux dans le panache montant
-! =========================================
-!
-! Dans la premiere couche, on prend q comme valeur de qu
-
-  DO i=1, klon
-     zmfux(i,1)=0.0 
-  ENDDO
-
-! Autres couches
-  DO k=1,klev
-     DO i=1, klon
-        IF ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN
-           xu(i,k)=x(i,k)
-        ELSE
-           xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k))/(zmfu(i,k+1)+zde_u(i,k))
-        ENDIF
-        zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)
-     ENDDO
-  ENDDO
-! ==========================================
-! calcul des flux dans le panache descendant
-! ==========================================
-   
-  DO i=1, klon
-     zmfdx(i,klev+1)=0.0 
-  ENDDO
-
-  DO k=klev,1,-1
-     DO i=1, klon
-        IF ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN
-           xd(i,k)=x(i,k)
-        ELSE
-           xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k))/(zmfd(i,k)-zde_d(i,k))
-        ENDIF
-        zmfdx(i,k)=zmfd(i,k)*xd(i,k)
-     ENDDO
-  ENDDO
-! ===================================================
-! introduction du flux de retour dans l'environnement
-! ===================================================
-
-  DO k=2, klev
-     DO i=1, klon
-        zmfe=-zmfu(i,k)-zmfd(i,k)
-        IF (zmfe.le.0.) then
-           zmfex(i,k)= zmfe*x(i,k)
-        ELSE
-           zmfex(i,k)= zmfe*x(i,k-1)
-        ENDIF
-     ENDDO
-  ENDDO
-
-  DO i=1, klon
-     zmfex(i,1)=0.
-     zmfex(i,klev+1)=0.
-  ENDDO
-! ==========================
-! calcul final des tendances
-! ==========================
-  DO k=1, klev
-     DO i=1, klon
-        dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime*  &
-             ( zmfux(i,k) - zmfux(i,k+1) +            &
-             zmfdx(i,k) - zmfdx(i,k+1) +              &
-             zmfex(i,k) - zmfex(i,k+1) )
-     ENDDO
-  ENDDO
-  
-END SUBROUTINE nflxtr
+link ../phylmd/nflxtr.F90
Index: LMDZ6/trunk/libf/phylmdiso/nonlocal.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/nonlocal.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/nonlocal.F90	(revision 3940)
@@ -1,407 +1,1 @@
-
-! $Header$
-
-! ======================================================================
-SUBROUTINE nonlocal(knon, paprs, pplay, tsol, beta, u, v, t, q, cd_h, cd_m, &
-    pcfh, pcfm, cgh, cgq)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Laurent Li (LMD/CNRS), le 30 septembre 1998
-  ! Couche limite non-locale. Adaptation du code du CCM3.
-  ! Code non teste, donc a ne pas utiliser.
-  ! ======================================================================
-  ! Nonlocal scheme that determines eddy diffusivities based on a
-  ! diagnosed boundary layer height and a turbulent velocity scale.
-  ! Also countergradient effects for heat and moisture are included.
-
-  ! For more information, see Holtslag, A.A.M., and B.A. Boville, 1993:
-  ! Local versus nonlocal boundary-layer diffusion in a global climate
-  ! model. J. of Climate, vol. 6, 1825-1842.
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! Arguments:
-
-  INTEGER knon ! nombre de points a calculer
-  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 pplay(klon, klev) ! pression au milieu de couche (Pa)
-  REAL u(klon, klev) ! vitesse U (m/s)
-  REAL v(klon, klev) ! vitesse V (m/s)
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! vapeur d'eau (kg/kg)
-  REAL cd_h(klon) ! coefficient de friction au sol pour chaleur
-  REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
-
-  INTEGER isommet
-  REAL vk
-  PARAMETER (vk=0.40)
-  REAL ricr
-  PARAMETER (ricr=0.4)
-  REAL fak
-  PARAMETER (fak=8.5)
-  REAL fakn
-  PARAMETER (fakn=7.2)
-  REAL onet
-  PARAMETER (onet=1.0/3.0)
-  REAL t_coup
-  PARAMETER (t_coup=273.15)
-  REAL zkmin
-  PARAMETER (zkmin=0.01)
-  REAL betam
-  PARAMETER (betam=15.0)
-  REAL betah
-  PARAMETER (betah=15.0)
-  REAL betas
-  PARAMETER (betas=5.0)
-  REAL sffrac
-  PARAMETER (sffrac=0.1)
-  REAL binm
-  PARAMETER (binm=betam*sffrac)
-  REAL binh
-  PARAMETER (binh=betah*sffrac)
-  REAL ccon
-  PARAMETER (ccon=fak*sffrac*vk)
-
-  REAL z(klon, klev)
-  REAL pcfm(klon, klev), pcfh(klon, klev)
-
-  INTEGER i, k
-  REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
-  REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
-  REAL khfs(klon) ! surface kinematic heat flux [mK/s]
-  REAL kqfs(klon) ! sfc kinematic constituent flux [m/s]
-  REAL heatv(klon) ! surface virtual heat flux
-  REAL ustar(klon)
-  REAL rino(klon, klev) ! bulk Richardon no. from level to ref lev
-  LOGICAL unstbl(klon) ! pts w/unstbl pbl (positive virtual ht flx)
-  LOGICAL stblev(klon) ! stable pbl with levels within pbl
-  LOGICAL unslev(klon) ! unstbl pbl with levels within pbl
-  LOGICAL unssrf(klon) ! unstb pbl w/lvls within srf pbl lyr
-  LOGICAL unsout(klon) ! unstb pbl w/lvls in outer pbl lyr
-  LOGICAL check(klon) ! True=>chk if Richardson no.>critcal
-  REAL pblh(klon)
-  REAL cgh(klon, 2:klev) ! counter-gradient term for heat [K/m]
-  REAL cgq(klon, 2:klev) ! counter-gradient term for constituents
-  REAL cgs(klon, 2:klev) ! counter-gradient star (cg/flux)
-  REAL obklen(klon)
-  REAL ztvd, ztvu, zdu2
-  REAL therm(klon) ! thermal virtual temperature excess
-  REAL phiminv(klon) ! inverse phi function for momentum
-  REAL phihinv(klon) ! inverse phi function for heat
-  REAL wm(klon) ! turbulent velocity scale for momentum
-  REAL fak1(klon) ! k*ustar*pblh
-  REAL fak2(klon) ! k*wm*pblh
-  REAL fak3(klon) ! fakn*wstr/wm
-  REAL pblk(klon) ! level eddy diffusivity for momentum
-  REAL pr(klon) ! Prandtl number for eddy diffusivities
-  REAL zl(klon) ! zmzp / Obukhov length
-  REAL zh(klon) ! zmzp / pblh
-  REAL zzh(klon) ! (1-(zmzp/pblh))**2
-  REAL wstr(klon) ! w*, convective velocity scale
-  REAL zm(klon) ! current level height
-  REAL zp(klon) ! current level height + one level up
-  REAL zcor, zdelta, zcvm5, zxqs
-  REAL fac, pblmin, zmzp, term
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! Initialisation
-
-  isommet = klev
-
-  DO i = 1, klon
-    pcfh(i, 1) = cd_h(i)
-    pcfm(i, 1) = cd_m(i)
-  END DO
-  DO k = 2, klev
-    DO i = 1, klon
-      pcfh(i, k) = zkmin
-      pcfm(i, k) = zkmin
-      cgs(i, k) = 0.0
-      cgh(i, k) = 0.0
-      cgq(i, k) = 0.0
-    END DO
-  END DO
-
-  ! 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
-  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
-    END DO
-  END DO
-
-  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)
-      zxqs = min(0.5, zxqs)
-      zcor = 1./(1.-retv*zxqs)
-      zxqs = zxqs*zcor
-    ELSE
-      IF (tsol(i)<t_coup) THEN
-        zxqs = qsats(tsol(i))/paprs(i, 1)
-      ELSE
-        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)
-    ustar(i) = max(sqrt(ustar(i)), 0.01)
-  END DO
-
-  DO i = 1, knon
-    rino(i, 1) = 0.0
-    check(i) = .TRUE.
-    pblh(i) = z(i, 1)
-    obklen(i) = -t(i, 1)*ustar(i)**3/(rg*vk*heatv(i))
-  END DO
-
-
-  ! PBL height calculation:
-  ! Search for level of pbl. Scan upward until the Richardson number between
-  ! the first level and the current level exceeds the "critical" value.
-
-  fac = 100.0
-  DO k = 1, isommet
-    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 = 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))
-          check(i) = .FALSE.
-        END IF
-      END IF
-    END DO
-  END DO
-
-
-  ! Set pbl height to maximum value where computation exceeds number of
-  ! layers allowed
-
-  DO i = 1, knon
-    IF (check(i)) pblh(i) = z(i, isommet)
-  END DO
-
-  ! Improve estimate of pbl height for the unstable points.
-  ! Find unstable points (sensible heat flux is upward):
-
-  DO i = 1, knon
-    IF (heatv(i)>0.) THEN
-      unstbl(i) = .TRUE.
-      check(i) = .TRUE.
-    ELSE
-      unstbl(i) = .FALSE.
-      check(i) = .FALSE.
-    END IF
-  END DO
-
-  ! For the unstable case, compute velocity scale and the
-  ! convective temperature excess:
-
-  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)
-      rino(i, 1) = 0.0
-    END IF
-  END DO
-
-  ! Improve pblh estimate for unstable conditions using the
-  ! convective temperature excess:
-
-  DO k = 1, isommet
-    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 = 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))
-          check(i) = .FALSE.
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! Set pbl height to maximum value where computation exceeds number of
-  ! layers allowed
-
-  DO i = 1, knon
-    IF (check(i)) pblh(i) = z(i, isommet)
-  END DO
-
-  ! Points for which pblh exceeds number of pbl layers allowed;
-  ! set to maximum
-
-  DO i = 1, knon
-    IF (check(i)) pblh(i) = z(i, isommet)
-  END DO
-
-  ! PBL height must be greater than some minimum mechanical mixing depth
-  ! Several investigators have proposed minimum mechanical mixing depth
-  ! relationships as a function of the local friction velocity, u*.  We
-  ! make use of a linear relationship of the form h = c u* where c=700.
-  ! The scaling arguments that give rise to this relationship most often
-  ! represent the coefficient c as some constant over the local coriolis
-  ! parameter.  Here we make use of the experimental results of Koracin
-  ! and Berkowicz (1988) [BLM, Vol 43] for wich they recommend 0.07/f
-  ! where f was evaluated at 39.5 N and 52 N.  Thus we use a typical mid
-  ! latitude value for f so that c = 0.07/f = 700.
-
-  DO i = 1, knon
-    pblmin = 700.0*ustar(i)
-    pblh(i) = max(pblh(i), pblmin)
-  END DO
-
-  ! pblh is now available; do preparation for diffusivity calculation:
-
-  DO i = 1, knon
-    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.
-
-    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)
-    END IF
-  END DO
-
-  ! Main level loop to compute the diffusivities and
-  ! counter-gradient terms:
-
-  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))
-        zh(i) = zmzp/pblh(i)
-        zl(i) = zmzp/obklen(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 IF
-    END DO
-
-    ! 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
-
-    ! 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 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 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
-
-    ! For all unstable layers, set diffusivities
-
-    DO i = 1, knon
-      IF (unslev(i)) THEN
-        pcfm(i, k) = pblk(i)
-        pcfh(i, k) = pblk(i)/pr(i)
-      END IF
-    END DO
-  END DO ! end of level loop
-
-  RETURN
-END SUBROUTINE nonlocal
+link ../phylmd/nonlocal.F90
Index: LMDZ6/trunk/libf/phylmdiso/nuage.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/nuage.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/nuage.F90	(revision 3940)
@@ -1,406 +1,1 @@
-! $Id: nuage.F90 2346 2015-08-21 15:13:46Z emillour $
-
-SUBROUTINE nuage(paprs, pplay, t, pqlwp, pclc, pcltau, pclemi, pch, pcl, pcm, &
-    pct, pctlwp, ok_aie, mass_solu_aero, mass_solu_aero_pi, bl95_b0, bl95_b1, &
-    cldtaupi, re, fl)
-  USE dimphy
-  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
-  ! Objet: Calculer epaisseur optique et emmissivite des nuages
-  ! ======================================================================
-  ! Arguments:
-  ! t-------input-R-temperature
-  ! pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)
-  ! pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
-  ! ok_aie--input-L-apply aerosol indirect effect or not
-  ! mass_solu_aero-----input-R-total mass concentration for all soluble
-  ! aerosols[ug/m^3]
-  ! mass_solu_aero_pi--input-R-dito, pre-industrial value
-  ! bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land)
-  ! bl95_b1-input-R-a parameter, may be varied for tests (    -"-      )
-
-  ! cldtaupi-output-R-pre-industrial value of cloud optical thickness,
-  ! needed for the diagnostics of the aerosol indirect
-  ! radiative forcing (see radlwsw)
-  ! re------output-R-Cloud droplet effective radius multiplied by fl [um]
-  ! fl------output-R-Denominator to re, introduced to avoid problems in
-  ! the averaging of the output. fl is the fraction of liquid
-  ! water clouds within a grid cell
-
-  ! pcltau--output-R-epaisseur optique des nuages
-  ! pclemi--output-R-emissivite des nuages (0 a 1)
-  ! ======================================================================
-
-  include "YOMCST.h"
-  include "nuage.h" ! JBM 3/14
-
-  REAL paprs(klon, klev+1), pplay(klon, klev)
-  REAL t(klon, klev)
-
-  REAL pclc(klon, klev)
-  REAL pqlwp(klon, klev)
-  REAL pcltau(klon, klev), pclemi(klon, klev)
-
-  REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
-
-  LOGICAL lo
-
-  REAL cetahb, cetamb
-  PARAMETER (cetahb=0.45, cetamb=0.80)
-
-  INTEGER i, k
-  REAL zflwp, zradef, zfice(klon), zmsac
-
-  REAL radius, rad_chaud
-! JBM (3/14) parameters already defined in nuage.h:
-! REAL rad_froid, rad_chau1, rad_chau2
-! PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
-  ! cc      PARAMETER (rad_chaud=15.0, rad_froid=35.0)
-  ! sintex initial      PARAMETER (rad_chaud=10.0, rad_froid=30.0)
-  REAL coef, coef_froi, coef_chau
-  PARAMETER (coef_chau=0.13, coef_froi=0.09)
-  REAL seuil_neb
-  PARAMETER (seuil_neb=0.001)
-! JBM (3/14) nexpo is replaced by exposant_glace
-! REAL nexpo ! exponentiel pour glace/eau
-! PARAMETER (nexpo=6.)
-  REAL, PARAMETER :: t_glace_min_old = 258.
-  INTEGER, PARAMETER :: exposant_glace_old = 6
-
-
-  ! jq for the aerosol indirect effect
-  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
-  ! jq
-  LOGICAL ok_aie ! Apply AIE or not?
-
-  REAL mass_solu_aero(klon, klev) ! total mass concentration for all soluble aerosols[ug m-3]
-  REAL mass_solu_aero_pi(klon, klev) ! - " - pre-industrial value
-  REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3]
-  REAL re(klon, klev) ! cloud droplet effective radius [um]
-  REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value)
-  REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value)
-
-  REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds
-  ! within the grid cell)
-
-  REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
-
-  REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag
-  ! jq-end
-
-  ! cc      PARAMETER (nexpo=1)
-
-  ! Calculer l'epaisseur optique et l'emmissivite des nuages
-
-  DO k = 1, klev
-     IF (iflag_t_glace.EQ.0) THEN
-       DO i = 1, klon
-        zfice(i) = 1.0 - (t(i,k)-t_glace_min_old)/(273.13-t_glace_min_old)
-        zfice(i) = min(max(zfice(i),0.0), 1.0)
-        zfice(i) = zfice(i)**exposant_glace_old
-       ENDDO
-     ELSE ! of IF (iflag_t_glace.EQ.0)
-! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
-!       zfice(i) = icefrac_lsc(t(i,k), t_glace_min, &
-!                           t_glace_max, exposant_glace)
-         CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:))
-     ENDIF
-
-    DO i = 1, klon
-      rad_chaud = rad_chau1
-      IF (k<=3) rad_chaud = rad_chau2
-
-      pclc(i, k) = max(pclc(i,k), seuil_neb)
-      zflwp = 1000.*pqlwp(i, k)/rg/pclc(i, k)*(paprs(i,k)-paprs(i,k+1))
-
-      IF (ok_aie) THEN
-          ! Formula "D" of Boucher and Lohmann, Tellus, 1995
-          !
-        cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
-          1.E-4))/log(10.))*1.E6 !-m-3
-          ! Cloud droplet number concentration (CDNC) is restricted
-          ! to be within [20, 1000 cm^3]
-          !
-        cdnc(i, k) = min(1000.E6, max(20.E6,cdnc(i,k)))
-        cdnc_pi(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero_pi(i,k), &
-          1.E-4))/log(10.))*1.E6 !-m-3
-        cdnc_pi(i, k) = min(1000.E6, max(20.E6,cdnc_pi(i,k)))
-          !
-          !
-          ! air density: pplay(i,k) / (RD * zT(i,k))
-          ! factor 1.1: derive effective radius from volume-mean radius
-          ! factor 1000 is the water density
-          ! _chaud means that this is the CDR for liquid water clouds
-          !
-        rad_chaud = 1.1*((pqlwp(i,k)*pplay(i,k)/(rd*t(i,k)))/(4./3.*rpi*1000. &
-          *cdnc(i,k)))**(1./3.)
-          !
-          ! Convert to um. CDR shall be at least 3 um.
-          !
-        rad_chaud = max(rad_chaud*1.E6, 3.)
-
-          ! For output diagnostics
-          !
-          ! Cloud droplet effective radius [um]
-          !
-          ! we multiply here with f * xl (fraction of liquid water
-          ! clouds in the grid cell) to avoid problems in the
-          ! averaging of the output.
-          ! In the output of IOIPSL, derive the real cloud droplet
-          ! effective radius as re/fl
-          !
-        fl(i, k) = pclc(i, k)*(1.-zfice(i))
-        re(i, k) = rad_chaud*fl(i, k)
-
-          ! Pre-industrial cloud opt thickness
-          !
-          ! "radius" is calculated as rad_chaud above (plus the
-          ! ice cloud contribution) but using cdnc_pi instead of
-          ! cdnc.
-        radius = max(1.1E6*((pqlwp(i,k)*pplay(i,k)/(rd*t(i,k)))/(4./3.*rpi* &
-          1000.*cdnc_pi(i,k)))**(1./3.), 3.)*(1.-zfice(i)) + rad_froid*zfice(i)
-        cldtaupi(i, k) = 3.0/2.0*zflwp/radius
-      END IF ! ok_aie
-
-      radius = rad_chaud*(1.-zfice(i)) + rad_froid*zfice(i)
-      coef = coef_chau*(1.-zfice(i)) + coef_froi*zfice(i)
-      pcltau(i, k) = 3.0/2.0*zflwp/radius
-      pclemi(i, k) = 1.0 - exp(-coef*zflwp)
-      lo = (pclc(i,k)<=seuil_neb)
-      IF (lo) pclc(i, k) = 0.0
-      IF (lo) pcltau(i, k) = 0.0
-      IF (lo) pclemi(i, k) = 0.0
-
-      IF (.NOT. ok_aie) cldtaupi(i, k) = pcltau(i, k)
-    END DO
-  END DO
-  ! cc      DO k = 1, klev
-  ! cc      DO i = 1, klon
-  ! cc         t(i,k) = t(i,k)
-  ! cc         pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
-  ! cc         lo = pclc(i,k) .GT. (2.*1.e-5)
-  ! cc         zflwp = pqlwp(i,k)*1000.*(paprs(i,k)-paprs(i,k+1))
-  ! cc     .          /(rg*pclc(i,k))
-  ! cc         zradef = 10.0 + (1.-sigs(k))*45.0
-  ! cc         pcltau(i,k) = 1.5 * zflwp / zradef
-  ! cc         zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
-  ! cc         zmsac = 0.13*(1.0-zfice) + 0.08*zfice
-  ! cc         pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
-  ! cc         if (.NOT.lo) pclc(i,k) = 0.0
-  ! cc         if (.NOT.lo) pcltau(i,k) = 0.0
-  ! cc         if (.NOT.lo) pclemi(i,k) = 0.0
-  ! cc      ENDDO
-  ! cc      ENDDO
-  ! ccccc      print*, 'pas de nuage dans le rayonnement'
-  ! ccccc      DO k = 1, klev
-  ! ccccc      DO i = 1, klon
-  ! ccccc         pclc(i,k) = 0.0
-  ! ccccc         pcltau(i,k) = 0.0
-  ! ccccc         pclemi(i,k) = 0.0
-  ! ccccc      ENDDO
-  ! ccccc      ENDDO
-
-  ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
-
-  DO i = 1, klon
-    pct(i) = 1.0
-    pch(i) = 1.0
-    pcm(i) = 1.0
-    pcl(i) = 1.0
-    pctlwp(i) = 0.0
-  END DO
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      pctlwp(i) = pctlwp(i) + pqlwp(i, k)*(paprs(i,k)-paprs(i,k+1))/rg
-      pct(i) = pct(i)*(1.0-pclc(i,k))
-      IF (pplay(i,k)<=cetahb*paprs(i,1)) pch(i) = pch(i)*(1.0-pclc(i,k))
-      IF (pplay(i,k)>cetahb*paprs(i,1) .AND. pplay(i,k)<=cetamb*paprs(i,1)) &
-        pcm(i) = pcm(i)*(1.0-pclc(i,k))
-      IF (pplay(i,k)>cetamb*paprs(i,1)) pcl(i) = pcl(i)*(1.0-pclc(i,k))
-    END DO
-  END DO
-
-  DO i = 1, klon
-    pct(i) = 1. - pct(i)
-    pch(i) = 1. - pch(i)
-    pcm(i) = 1. - pcm(i)
-    pcl(i) = 1. - pcl(i)
-  END DO
-
-  RETURN
-END SUBROUTINE nuage
-SUBROUTINE diagcld1(paprs, pplay, rain, snow, kbot, ktop, diafra, dialiq)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! Laurent Li (LMD/CNRS), le 12 octobre 1998
-  ! (adaptation du code ECMWF)
-
-  ! Dans certains cas, le schema pronostique des nuages n'est
-  ! pas suffisament performant. On a donc besoin de diagnostiquer
-  ! ces nuages. Je dois avouer que c'est une frustration.
-
-  include "YOMCST.h"
-
-  ! Arguments d'entree:
-  REAL paprs(klon, klev+1) ! pression (Pa) a inter-couche
-  REAL pplay(klon, klev) ! pression (Pa) au milieu de couche
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! humidite specifique (Kg/Kg)
-  REAL rain(klon) ! pluie convective (kg/m2/s)
-  REAL snow(klon) ! neige convective (kg/m2/s)
-  INTEGER ktop(klon) ! sommet de la convection
-  INTEGER kbot(klon) ! bas de la convection
-
-  ! Arguments de sortie:
-  REAL diafra(klon, klev) ! fraction nuageuse diagnostiquee
-  REAL dialiq(klon, klev) ! eau liquide nuageuse
-
-  ! Constantes ajustables:
-  REAL canva, canvb, canvh
-  PARAMETER (canva=2.0, canvb=0.3, canvh=0.4)
-  REAL cca, ccb, ccc
-  PARAMETER (cca=0.125, ccb=1.5, ccc=0.8)
-  REAL ccfct, ccscal
-  PARAMETER (ccfct=0.400)
-  PARAMETER (ccscal=1.0E+11)
-  REAL cetahb, cetamb
-  PARAMETER (cetahb=0.45, cetamb=0.80)
-  REAL cclwmr
-  PARAMETER (cclwmr=1.E-04)
-  REAL zepscr
-  PARAMETER (zepscr=1.0E-10)
-
-  ! Variables locales:
-  INTEGER i, k
-  REAL zcc(klon)
-
-  ! Initialisation:
-
-  DO k = 1, klev
-    DO i = 1, klon
-      diafra(i, k) = 0.0
-      dialiq(i, k) = 0.0
-    END DO
-  END DO
-
-  DO i = 1, klon ! Calculer la fraction nuageuse
-    zcc(i) = 0.0
-    IF ((rain(i)+snow(i))>0.) THEN
-      zcc(i) = cca*log(max(zepscr,(rain(i)+snow(i))*ccscal)) - ccb
-      zcc(i) = min(ccc, max(0.0,zcc(i)))
-    END IF
-  END DO
-
-  DO i = 1, klon ! pour traiter les enclumes
-    diafra(i, ktop(i)) = max(diafra(i,ktop(i)), zcc(i)*ccfct)
-    IF ((zcc(i)>=canvh) .AND. (pplay(i,ktop(i))<=cetahb*paprs(i, &
-      1))) diafra(i, ktop(i)) = max(diafra(i,ktop(i)), max(zcc( &
-      i)*ccfct,canva*(zcc(i)-canvb)))
-    dialiq(i, ktop(i)) = cclwmr*diafra(i, ktop(i))
-  END DO
-
-  DO k = 1, klev ! nuages convectifs (sauf enclumes)
-    DO i = 1, klon
-      IF (k<ktop(i) .AND. k>=kbot(i)) THEN
-        diafra(i, k) = max(diafra(i,k), zcc(i)*ccfct)
-        dialiq(i, k) = cclwmr*diafra(i, k)
-      END IF
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE diagcld1
-SUBROUTINE diagcld2(paprs, pplay, t, q, diafra, dialiq)
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-
-  ! Arguments d'entree:
-  REAL paprs(klon, klev+1) ! pression (Pa) a inter-couche
-  REAL pplay(klon, klev) ! pression (Pa) au milieu de couche
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! humidite specifique (Kg/Kg)
-
-  ! Arguments de sortie:
-  REAL diafra(klon, klev) ! fraction nuageuse diagnostiquee
-  REAL dialiq(klon, klev) ! eau liquide nuageuse
-
-  REAL cetamb
-  PARAMETER (cetamb=0.80)
-  REAL cloia, cloib, cloic, cloid
-  PARAMETER (cloia=1.0E+02, cloib=-10.00, cloic=-0.6, cloid=5.0)
-  ! cc      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.9, CLOID=5.0)
-  REAL rgammas
-  PARAMETER (rgammas=0.05)
-  REAL crhl
-  PARAMETER (crhl=0.15)
-  ! cc      PARAMETER (CRHL=0.70)
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-
-  ! Variables locales:
-  INTEGER i, k, kb, invb(klon)
-  REAL zqs, zrhb, zcll, zdthmin(klon), zdthdp
-  REAL zdelta, zcor
-
-  ! Fonctions thermodynamiques:
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! Initialisation:
-
-  DO k = 1, klev
-    DO i = 1, klon
-      diafra(i, k) = 0.0
-      dialiq(i, k) = 0.0
-    END DO
-  END DO
-
-  DO i = 1, klon
-    invb(i) = klev
-    zdthmin(i) = 0.0
-  END DO
-
-  DO k = 2, klev/2 - 1
-    DO i = 1, klon
-      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*cloia
-      IF (pplay(i,k)>cetamb*paprs(i,1) .AND. zdthdp<zdthmin(i)) THEN
-        zdthmin(i) = zdthdp
-        invb(i) = k
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    kb = invb(i)
-    IF (thermcep) THEN
-      zdelta = max(0., sign(1.,rtt-t(i,kb)))
-      zqs = r2es*foeew(t(i,kb), zdelta)/pplay(i, kb)
-      zqs = min(0.5, zqs)
-      zcor = 1./(1.-retv*zqs)
-      zqs = zqs*zcor
-    ELSE
-      IF (t(i,kb)<t_coup) THEN
-        zqs = qsats(t(i,kb))/pplay(i, kb)
-      ELSE
-        zqs = qsatl(t(i,kb))/pplay(i, kb)
-      END IF
-    END IF
-    zcll = cloib*zdthmin(i) + cloic
-    zcll = min(1.0, max(0.0,zcll))
-    zrhb = q(i, kb)/zqs
-    IF (zcll>0.0 .AND. zrhb<crhl) zcll = zcll*(1.-(crhl-zrhb)*cloid)
-    zcll = min(1.0, max(0.0,zcll))
-    diafra(i, kb) = max(diafra(i,kb), zcll)
-    dialiq(i, kb) = diafra(i, kb)*rgammas*zqs
-  END DO
-
-  RETURN
-END SUBROUTINE diagcld2
+link ../phylmd/nuage.F90
Index: LMDZ6/trunk/libf/phylmdiso/nuage.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/nuage.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/nuage.h	(revision 3940)
@@ -1,20 +1,1 @@
-!
-! $Id: nuage.h 2945 2017-07-12 14:20:24Z jbmadeleine $
-!
-      REAL rad_froid, rad_chau1, rad_chau2, t_glace_max, t_glace_min
-      REAL exposant_glace
-      REAL rei_min,rei_max
-      REAL tau_cld_cv,coefw_cld_cv
-
-      REAL tmax_fonte_cv
-
-      INTEGER iflag_t_glace, iflag_cloudth_vert, iflag_cld_cv
-      INTEGER iflag_rain_incloud_vol
-
-      common /nuagecom/ rad_froid,rad_chau1, rad_chau2,t_glace_max,     &
-     &                  t_glace_min,exposant_glace,rei_min,rei_max,     &
-     &                  tau_cld_cv,coefw_cld_cv,                        &
-     &                  tmax_fonte_cv,                                  &
-     &                  iflag_t_glace,iflag_cloudth_vert,iflag_cld_cv,  &
-     &                  iflag_rain_incloud_vol
-!$OMP THREADPRIVATE(/nuagecom/)
+link ../phylmd/nuage.h
Index: LMDZ6/trunk/libf/phylmdiso/o3_chem_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/o3_chem_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/o3_chem_m.F90	(revision 3940)
@@ -1,171 +1,1 @@
-! $Id$
-module o3_chem_m
-
-  IMPLICIT none
-
-  private o3_prod
-
-contains
-
-  subroutine o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, rlat, rlon, q)
-
-    ! This procedure evolves the ozone mass fraction through a time
-    ! step taking only chemistry into account.
-
-    ! All the 2-dimensional arrays are on the partial "physics" grid.
-    ! Their shape is "(/klon, nbp_lev/)".
-    ! Index "(i, :)" is for longitude "rlon(i)", latitude "rlat(i)".
-
-    use assert_m, only: assert
-    use dimphy, only: klon
-    use regr_pr_comb_coefoz_m, only: c_Mob, a4_mass, a2, r_het_interm
-    use mod_grid_phy_lmdz, only: nbp_lev
-    use nrtype, only: pi
-
-    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
-    real, intent(in):: gmtime ! heure de la journée en fraction de jour
-    real, intent(in):: t_seri(:, :) ! (klon, nbp_lev) temperature, in K
-
-    real, intent(in):: zmasse(:, :) ! (klon, nbp_lev)
-    ! (column-density of mass of air in a cell, in kg m-2)
-    ! "zmasse(:, k)" is for layer "k".)
-
-    real, intent(in):: pdtphys ! time step for physics, in s
-
-    REAL, intent(in):: rlat(:), rlon(:)
-    ! (longitude and latitude of each horizontal position, in degrees)
-
-    real, intent(inout):: q(:, :) ! (klon, nbp_lev) mass fraction of ozone
-    ! "q(:, k)" is at middle of layer "k".)
-
-    ! Variables local to the procedure:
-    ! (for "pi")
-    integer k
-
-    real c(klon, nbp_lev)
-    ! (constant term during a time step in the net mass production
-    ! rate of ozone by chemistry, per unit mass of air, in s-1)
-    ! "c(:, k)" is at middle of layer "k".)
-
-    real b(klon, nbp_lev)
-    ! (coefficient of "q" in the net mass production
-    ! rate of ozone by chemistry, per unit mass of air, in s-1)
-    ! "b(:, k)" is at middle of layer "k".)
-
-    real dq_o3_chem(klon, nbp_lev)
-    ! (variation of ozone mass fraction due to chemistry during a time step)
-    ! "dq_o3_chem(:, k)" is at middle of layer "k".)
-
-    real earth_long
-    ! (longitude vraie de la Terre dans son orbite solaire, par
-    ! rapport au point vernal (21 mars), en degrés)
-
-    real pmu0(klon) ! mean of cosine of solar zenith angle during "pdtphys"
-    real trash1
-    real trash2(klon)
-
-    !-------------------------------------------------------------
-
-    call assert(klon == (/size(q, 1), size(t_seri, 1), size(zmasse, 1), &
-         size(rlat), size(rlon)/), "o3_chem klon")
-    call assert(nbp_lev == (/size(q, 2), size(t_seri, 2), size(zmasse, 2)/), &
-         "o3_chem nbp_lev")
-
-    c = c_Mob + a4_mass * t_seri
-
-    ! Compute coefficient "b":
-
-    ! Heterogeneous chemistry is only at low temperature:
-    where (t_seri < 195.)
-       b = r_het_interm
-    elsewhere
-       b = 0.
-    end where
-
-    ! Heterogeneous chemistry is only during daytime:
-    call orbite(real(julien), earth_long, trash1)
-    call zenang(earth_long, gmtime, pdtphys, rlat, rlon, pmu0, trash2)
-    forall (k = 1: nbp_lev)
-       where (pmu0 <= cos(87. / 180. * pi)) b(:, k) = 0.
-    end forall
-
-    b = b + a2
-
-    ! Midpoint method:
-
-    ! Trial step to the midpoint:
-    dq_o3_chem = o3_prod(q, zmasse, c, b) * pdtphys  / 2
-    ! "Real" step across the whole interval:
-    dq_o3_chem = o3_prod(q + dq_o3_chem, zmasse, c, b) * pdtphys
-    q = q + dq_o3_chem
-
-    ! Confine the mass fraction:
-    q = min(max(q, 0.), .01)
-
-  end subroutine o3_chem
-
-  !*************************************************
-
-  function o3_prod(q, zmasse, c, b)
-
-    ! This function computes the production rate of ozone by chemistry.
-
-    ! All the 2-dimensional arrays are on the partial "physics" grid.
-    ! Their shape is "(/klon, nbp_lev/)".
-    ! Index "(i, :)" is for longitude "rlon(i)", latitude "rlat(i)".
-
-    use regr_pr_comb_coefoz_m, only: a6_mass
-    use assert_m, only: assert
-    use dimphy, only: klon
-    use mod_grid_phy_lmdz, only: nbp_lev
-
-    real, intent(in):: q(:, :) ! mass fraction of ozone
-    ! "q(:, k)" is at middle of layer "k".)
-
-    real, intent(in):: zmasse(:, :)
-    ! (column-density of mass of air in a layer, in kg m-2)
-    ! ("zmasse(:, k)" is for layer "k".)
-
-    real, intent(in):: c(:, :)
-    ! (constant term during a time step in the net mass production
-    ! rate of ozone by chemistry, per unit mass of air, in s-1)
-    ! "c(:, k)" is at middle of layer "k".)
-
-    real, intent(in):: b(:, :)
-    ! (coefficient of "q" in the net mass production rate of ozone by
-    ! chemistry, per unit mass of air, in s-1)
-    ! ("b(:, k)" is at middle of layer "k".)
-
-    real o3_prod(klon, nbp_lev)
-    ! (net mass production rate of ozone by chemistry, per unit mass
-    ! of air, in s-1)
-    ! ("o3_prod(:, k)" is at middle of layer "k".)
-
-    ! Variables local to the procedure:
-
-    real sigma_mass(klon, nbp_lev)
-    ! (mass column-density of ozone above point, in kg m-2)
-    ! ("sigma_mass(:, k)" is at middle of layer "k".)
-
-    integer k
-
-    !-------------------------------------------------------------------
-
-    call assert(klon == (/size(q, 1), size(zmasse, 1), size(c, 1), &
-         size(b, 1)/), "o3_prod 1")
-    call assert(nbp_lev == (/size(q, 2), size(zmasse, 2), size(c, 2), &
-         size(b, 2)/), "o3_prod 2")
-
-    ! Compute the column-density above the base of layer
-    ! "k", and, as a first approximation, take it as column-density
-    ! above the middle of layer "k":
-    sigma_mass(:, nbp_lev) = zmasse(:, nbp_lev) * q(:, nbp_lev) ! top layer
-    do k =  nbp_lev - 1, 1, -1
-       sigma_mass(:, k) = sigma_mass(:, k+1) + zmasse(:, k) * q(:, k)
-    end do
-
-    o3_prod = c + b * q + a6_mass * sigma_mass
-
-  end function o3_prod
-
-end module o3_chem_m
+link ../phylmd/o3_chem_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/o3cm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/o3cm.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/o3cm.F90	(revision 3940)
@@ -1,68 +1,1 @@
-
-! $Id: o3cm.F90 2311 2015-06-25 07:45:24Z emillour $
-
-SUBROUTINE o3cm(amb, bmb, sortie, ntab)
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-  ! Objet: Ce programme calcule le contenu en ozone "sortie"
-  ! (unite: cm.atm) entre deux niveaux "amb" et "bmb" (unite: mb)
-  ! "ntab" est le nombre d'intervalles pour l'integration, sa
-  ! valeur depend bien sur de l'epaisseur de la couche et de
-  ! la precision qu'on souhaite a obtenir
-  ! ======================================================================
-  REAL amb, bmb, sortie
-  INTEGER ntab
-  ! ======================================================================
-  INTEGER n
-  REAL xtab(500), xa, xb, ya, yb, xincr
-  ! ======================================================================
-  EXTERNAL mbtozm
-  CHARACTER (LEN=20) :: modname = ''
-  CHARACTER (LEN=80) :: abort_message
-  ! ======================================================================
-  ! la fonction en ligne w(x) donne le profil de l'ozone en fonction
-  ! de l'altitude (unite: cm.atm / km)
-  ! (Green 1964, Appl. Opt. 3: 203-208)
-  REAL wp, xp, h, x, w, con
-  PARAMETER (wp=0.218, xp=23.25, h=4.63, con=1.0)
-
-  w(x) = wp/h*exp((x-xp)/h)/(con+exp((x-xp)/h))**2
-  ! ======================================================================
-  IF (ntab>499) THEN
-    abort_message = 'BIG ntab'
-    CALL abort_physic(modname, abort_message, 1)
-  END IF
-  xincr = (bmb-amb)/real(ntab)
-  xtab(1) = amb
-  DO n = 2, ntab
-    xtab(n) = xtab(n-1) + xincr
-  END DO
-  xtab(ntab+1) = bmb
-  sortie = 0.0
-  DO n = 1, ntab
-    CALL mbtozm(xtab(n), xa)
-    CALL mbtozm(xtab(n+1), xb)
-    xa = xa/1000.
-    xb = xb/1000.
-    ya = w(xa)
-    yb = w(xb)
-    sortie = sortie + (ya+yb)/2.0*abs(xb-xa)
-  END DO
-  RETURN
-END SUBROUTINE o3cm
-SUBROUTINE mbtozm(rmb, zm)
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS)
-  ! Objet: transformer une hauteur de mb (rmb) en metre (zm)
-  ! ======================================================================
-  REAL rmb, zm
-  ! ======================================================================
-  REAL gama, tzero, pzero, g, r
-  PARAMETER (gama=6.5E-3, tzero=288., pzero=1013.25)
-  PARAMETER (g=9.81, r=287.0)
-
-  zm = tzero/gama*(1.-(rmb/pzero)**(r*gama/g))
-  RETURN
-END SUBROUTINE mbtozm
+link ../phylmd/o3cm.F90
Index: LMDZ6/trunk/libf/phylmdiso/oasis.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/oasis.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/oasis.F90	(revision 3940)
@@ -1,515 +1,1 @@
-!
-MODULE oasis
-!
-! This module contains subroutines for initialization, sending and receiving 
-! towards the coupler OASIS3. It also contains some parameters for the coupling.
-!
-! This module should always be compiled. With the coupler OASIS3 available the cpp key
-! CPP_COUPLE should be set and the entier of this file will then be compiled. 
-! In a forced mode CPP_COUPLE should not be defined and the compilation ends before 
-! the CONTAINS, without compiling the subroutines.
-!
-  USE dimphy 
-  USE mod_phys_lmdz_para
-  USE write_field_phy
-
-#ifdef CPP_COUPLE
-! Use of Oasis-MCT coupler 
-#if defined CPP_OMCT
-  USE mod_prism
-! Use of Oasis3 coupler 
-#else 
-  USE mod_prism_proto
-  USE mod_prism_def_partition_proto
-  USE mod_prism_get_proto
-  USE mod_prism_put_proto
-#endif
-#endif
-  
-  IMPLICIT NONE
-  
-  ! Id for fields sent to ocean
-  INTEGER, PARAMETER :: ids_tauxxu = 1
-  INTEGER, PARAMETER :: ids_tauyyu = 2
-  INTEGER, PARAMETER :: ids_tauzzu = 3
-  INTEGER, PARAMETER :: ids_tauxxv = 4
-  INTEGER, PARAMETER :: ids_tauyyv = 5
-  INTEGER, PARAMETER :: ids_tauzzv = 6
-  INTEGER, PARAMETER :: ids_windsp = 7
-  INTEGER, PARAMETER :: ids_shfice = 8
-  INTEGER, PARAMETER :: ids_shfoce = 9
-  INTEGER, PARAMETER :: ids_shftot = 10
-  INTEGER, PARAMETER :: ids_nsfice = 11
-  INTEGER, PARAMETER :: ids_nsfoce = 12
-  INTEGER, PARAMETER :: ids_nsftot = 13
-  INTEGER, PARAMETER :: ids_dflxdt = 14
-  INTEGER, PARAMETER :: ids_totrai = 15
-  INTEGER, PARAMETER :: ids_totsno = 16
-  INTEGER, PARAMETER :: ids_toteva = 17
-  INTEGER, PARAMETER :: ids_icevap = 18
-  INTEGER, PARAMETER :: ids_ocevap = 19
-  INTEGER, PARAMETER :: ids_calvin = 20
-  INTEGER, PARAMETER :: ids_liqrun = 21
-  INTEGER, PARAMETER :: ids_runcoa = 22
-  INTEGER, PARAMETER :: ids_rivflu = 23
-  INTEGER, PARAMETER :: ids_atmco2 = 24
-  INTEGER, PARAMETER :: ids_taumod = 25
-  INTEGER, PARAMETER :: ids_qraioc = 26
-  INTEGER, PARAMETER :: ids_qsnooc = 27
-  INTEGER, PARAMETER :: ids_qraiic = 28
-  INTEGER, PARAMETER :: ids_qsnoic = 29
-  INTEGER, PARAMETER :: maxsend    = 29  ! Maximum number of fields to send
-  
-  ! Id for fields received from ocean
-  INTEGER, PARAMETER :: idr_sisutw = 1
-  INTEGER, PARAMETER :: idr_icecov = 2
-  INTEGER, PARAMETER :: idr_icealw = 3
-  INTEGER, PARAMETER :: idr_icetem = 4
-  INTEGER, PARAMETER :: idr_curenx = 5
-  INTEGER, PARAMETER :: idr_cureny = 6
-  INTEGER, PARAMETER :: idr_curenz = 7
-  INTEGER, PARAMETER :: idr_oceco2 = 8
-  INTEGER, PARAMETER :: maxrecv    = 8  ! Maximum number of fields to receive
-  
-
-  TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
-     CHARACTER(len = 8) ::   name      ! Name of the coupling field   
-     LOGICAL            ::   action    ! To be exchanged or not
-     INTEGER            ::   nid       ! Id of the field
-  END TYPE FLD_CPL
-
-  TYPE(FLD_CPL), DIMENSION(maxsend), SAVE, PUBLIC :: infosend   ! Information for sending coupling fields
-!$OMP THREADPRIVATE(infosend)
-  TYPE(FLD_CPL), DIMENSION(maxrecv), SAVE, PUBLIC :: inforecv   ! Information for receiving coupling fields
-!$OMP THREADPRIVATE(inforecv)
-  
-  LOGICAL,SAVE :: cpl_current
-!$OMP THREADPRIVATE(cpl_current)
-
-#ifdef CPP_COUPLE
-
-CONTAINS
-
-  SUBROUTINE inicma
-!************************************************************************************
-!**** *INICMA*  - Initialize coupled mode communication for atmosphere
-!                 and exchange some initial information with Oasis
-!
-!     Rewrite to take the PRISM/psmile library into account
-!     LF 09/2003
-!
-    USE IOIPSL
-    USE surface_data, ONLY : version_ocean
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-#ifdef CPP_XIOS
-    USE wxios, ONLY : wxios_context_init 
-    USE xios  
-#endif
-    USE print_control_mod, ONLY: lunout
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
-    USE geometry_mod, ONLY: ind_cell_glo                    
-    USE mod_phys_lmdz_mpi_data, ONLY: klon_mpi_para_nb
-    
-
-
-! Local variables
-!************************************************************************************
-    INTEGER                            :: comp_id
-    INTEGER                            :: ierror, il_commlocal
-    INTEGER                            :: il_part_id
-    INTEGER, ALLOCATABLE               :: ig_paral(:)
-    INTEGER, DIMENSION(2)              :: il_var_nodims
-    INTEGER, DIMENSION(4)              :: il_var_actual_shape
-    INTEGER                            :: il_var_type
-    INTEGER                            :: jf
-    CHARACTER (len = 6)                :: clmodnam
-    CHARACTER (len = 20)               :: modname = 'inicma'
-    CHARACTER (len = 80)               :: abort_message 
-    LOGICAL, SAVE                      :: cpl_current_omp
-
-!*    1. Initializations
-!        ---------------
-!************************************************************************************
-    WRITE(lunout,*) ' '
-    WRITE(lunout,*) ' '
-    WRITE(lunout,*) ' ROUTINE INICMA'
-    WRITE(lunout,*) ' **************'
-    WRITE(lunout,*) ' '
-    WRITE(lunout,*) ' '
-
-!
-! Define the model name
-!
-    IF (grid_type==unstructured) THEN
-        clmodnam = 'icosa'                 ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
-    ELSE IF (grid_type==regular_lonlat) THEN
-        clmodnam = 'LMDZ'                  ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
-    ELSE
-	abort_message='Pb : type of grid unknown'
-	CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-
-!************************************************************************************
-! Define if coupling ocean currents or not
-!************************************************************************************
-!$OMP MASTER
-    cpl_current_omp = .FALSE.
-    CALL getin('cpl_current', cpl_current_omp)
-!$OMP END MASTER
-!$OMP BARRIER
-    cpl_current = cpl_current_omp
-    WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current 
-
-!************************************************************************************
-! Define coupling variables
-!************************************************************************************
-
-! Atmospheric variables to send
-
-!$OMP MASTER
-    infosend(:)%action = .FALSE.
-
-    infosend(ids_tauxxu)%action = .TRUE. ; infosend(ids_tauxxu)%name = 'COTAUXXU'
-    infosend(ids_tauyyu)%action = .TRUE. ; infosend(ids_tauyyu)%name = 'COTAUYYU'
-    infosend(ids_tauzzu)%action = .TRUE. ; infosend(ids_tauzzu)%name = 'COTAUZZU'
-    infosend(ids_tauxxv)%action = .TRUE. ; infosend(ids_tauxxv)%name = 'COTAUXXV'
-    infosend(ids_tauyyv)%action = .TRUE. ; infosend(ids_tauyyv)%name = 'COTAUYYV'
-    infosend(ids_tauzzv)%action = .TRUE. ; infosend(ids_tauzzv)%name = 'COTAUZZV'
-    infosend(ids_windsp)%action = .TRUE. ; infosend(ids_windsp)%name = 'COWINDSP'
-    infosend(ids_shfice)%action = .TRUE. ; infosend(ids_shfice)%name = 'COSHFICE'
-    infosend(ids_nsfice)%action = .TRUE. ; infosend(ids_nsfice)%name = 'CONSFICE'
-    infosend(ids_dflxdt)%action = .TRUE. ; infosend(ids_dflxdt)%name = 'CODFLXDT'
-    infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN'
-    
-    IF (version_ocean=='nemo') THEN
-        infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX'
-        infosend(ids_nsftot)%action = .TRUE. ; infosend(ids_nsftot)%name = 'COQNSMIX'
-        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOTRAI'
-        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOTSNO'
-        infosend(ids_toteva)%action = .TRUE. ; infosend(ids_toteva)%name = 'COTOTEVA'
-        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COICEVAP'
-        infosend(ids_liqrun)%action = .TRUE. ; infosend(ids_liqrun)%name = 'COLIQRUN'
-        infosend(ids_taumod)%action = .TRUE. ; infosend(ids_taumod)%name = 'COTAUMOD'
-        IF (carbon_cycle_cpl) THEN
-            infosend(ids_atmco2)%action = .TRUE. ; infosend(ids_atmco2)%name = 'COATMCO2'
-        ENDIF
-        infosend(ids_qraioc)%action = .TRUE. ; infosend(ids_qraioc)%name = 'COQRAIOC'
-        infosend(ids_qsnooc)%action = .TRUE. ; infosend(ids_qsnooc)%name = 'COQSNOOC'
-        infosend(ids_qraiic)%action = .TRUE. ; infosend(ids_qraiic)%name = 'COQRAIIC'
-        infosend(ids_qsnoic)%action = .TRUE. ; infosend(ids_qsnoic)%name = 'COQSNOIC'
-        
-    ELSE IF (version_ocean=='opa8') THEN
-        infosend(ids_shfoce)%action = .TRUE. ; infosend(ids_shfoce)%name = 'COSHFOCE'
-        infosend(ids_nsfoce)%action = .TRUE. ; infosend(ids_nsfoce)%name = 'CONSFOCE'
-        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COTFSICE'
-        infosend(ids_ocevap)%action = .TRUE. ; infosend(ids_ocevap)%name = 'COTFSOCE'
-        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOLPSU'
-        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOSPSU'
-        infosend(ids_runcoa)%action = .TRUE. ; infosend(ids_runcoa)%name = 'CORUNCOA'
-        infosend(ids_rivflu)%action = .TRUE. ; infosend(ids_rivflu)%name = 'CORIVFLU'
-   ENDIF
-        
-! Oceanic variables to receive
-
-   inforecv(:)%action = .FALSE.
-
-   inforecv(idr_sisutw)%action = .TRUE. ; inforecv(idr_sisutw)%name = 'SISUTESW'
-   inforecv(idr_icecov)%action = .TRUE. ; inforecv(idr_icecov)%name = 'SIICECOV'
-   inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW'
-   inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW'
-   
-   IF (cpl_current ) THEN
-       inforecv(idr_curenx)%action = .TRUE. ; inforecv(idr_curenx)%name = 'CURRENTX'
-       inforecv(idr_cureny)%action = .TRUE. ; inforecv(idr_cureny)%name = 'CURRENTY'
-       inforecv(idr_curenz)%action = .TRUE. ; inforecv(idr_curenz)%name = 'CURRENTZ'
-   ENDIF
-
-   IF (carbon_cycle_cpl ) THEN
-       inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX'
-   ENDIF
-
-!************************************************************************************
-! Here we go: psmile initialisation
-!************************************************************************************
-    IF (is_sequential) THEN
-       CALL prism_init_comp_proto (comp_id, clmodnam, ierror)
-       
-       IF (ierror .NE. PRISM_Ok) THEN
-          abort_message=' Probleme init dans prism_init_comp '
-          CALL abort_physic(modname,abort_message,1)
-       ELSE
-          WRITE(lunout,*) 'inicma : init psmile ok '
-       ENDIF
-    ENDIF
-
-    CALL prism_get_localcomm_proto (il_commlocal, ierror)
-!************************************************************************************
-! Domain decomposition
-!************************************************************************************
-    IF (grid_type==unstructured) THEN
-
-      ALLOCATE( ig_paral(klon_mpi_para_nb(mpi_rank) + 2) ) 
-
-      ig_paral(1) = 4                                      ! points partition for //
-      ig_paral(2) = klon_mpi_para_nb(mpi_rank)             ! nb of local cells
-
-      DO jf=1, klon_mpi_para_nb(mpi_rank)
-        ig_paral(2+jf) = ind_cell_glo(jf)
-      ENDDO
-
-    ELSE IF (grid_type==regular_lonlat) THEN
-
-      ALLOCATE( ig_paral(3) )
-
-      ig_paral(1) = 1                            ! apple partition for //
-      ig_paral(2) = (jj_begin-1)*nbp_lon+ii_begin-1  ! offset
-      ig_paral(3) = (jj_end*nbp_lon+ii_end) - (jj_begin*nbp_lon+ii_begin) + 1
-
-      IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+nbp_lon-1
-    ELSE
-      abort_message='Pb : type of grid unknown'
-      CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-
-    WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
-    
-    ierror=PRISM_Ok
-    CALL prism_def_partition_proto (il_part_id, ig_paral, ierror)
-
-    IF (ierror .NE. PRISM_Ok) THEN
-       abort_message=' Probleme dans prism_def_partition '
-       CALL abort_physic(modname,abort_message,1)
-    ELSE
-       WRITE(lunout,*) 'inicma : decomposition domaine psmile ok '
-    ENDIF
-
-    il_var_nodims(1) = 2                        ! rank of field array (1d or 2d)
-    il_var_nodims(2) = 1                        ! always 1 in current oasis version" doc oasis3mct p18
-
-    il_var_actual_shape(1) = 1                  ! min of 1st dimension (always 1)
-    il_var_actual_shape(2) = nbp_lon            ! max of 1st dimension
-    il_var_actual_shape(3) = 1                  ! min of 2nd dimension (always 1)
-    il_var_actual_shape(4) = nbp_lat            ! max of 2nd dimension
-   
-    il_var_type = PRISM_Real
-
-!************************************************************************************
-! Oceanic Fields to receive
-! Loop over all possible variables
-!************************************************************************************
-    DO jf=1, maxrecv
-       IF (inforecv(jf)%action) THEN
-          CALL prism_def_var_proto(inforecv(jf)%nid, inforecv(jf)%name, il_part_id, &
-               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
-               ierror)
-          IF (ierror .NE. PRISM_Ok) THEN
-             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
-                  inforecv(jf)%name
-             abort_message=' Problem in call to prism_def_var_proto for fields to receive'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-    END DO
-    
-!************************************************************************************
-! Atmospheric Fields to send
-! Loop over all possible variables
-!************************************************************************************
-    DO jf=1,maxsend
-       IF (infosend(jf)%action) THEN
-          CALL prism_def_var_proto(infosend(jf)%nid, infosend(jf)%name, il_part_id, &
-               il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
-               ierror)
-          IF (ierror .NE. PRISM_Ok) THEN
-             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
-                  infosend(jf)%name
-             abort_message=' Problem in call to prism_def_var_proto for fields to send'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-    END DO
-    
-!************************************************************************************
-! End definition
-!************************************************************************************
-#ifdef CPP_XIOS
-    CALL xios_oasis_enddef()
-#endif
-    CALL prism_enddef_proto(ierror)
-    IF (ierror .NE. PRISM_Ok) THEN
-       abort_message=' Problem in call to prism_endef_proto'
-       CALL abort_physic(modname,abort_message,1)
-    ELSE
-       WRITE(lunout,*) 'inicma : endef psmile ok '
-    ENDIF
-
-#ifdef CPP_XIOS
-!    CALL wxios_context_init()
-#endif
-
-!$OMP END MASTER
-    
-  END SUBROUTINE inicma
-
-!
-!************************************************************************************
-!
-
-  SUBROUTINE fromcpl(ktime, tab_get)
-! ======================================================================
-! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST 
-! and Sea-Ice provided by the coupler. Adaptation to psmile library
-!======================================================================
-!
-    USE print_control_mod, ONLY: lunout
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-! Input arguments
-!************************************************************************************
-    INTEGER, INTENT(IN)                               ::  ktime
-
-! Output arguments
-!************************************************************************************
-    REAL, DIMENSION(nbp_lon, jj_nb,maxrecv), INTENT(OUT) :: tab_get
-
-! Local variables
-!************************************************************************************
-    INTEGER                       :: ierror, i
-    INTEGER                       :: istart,iend
-    CHARACTER (len = 20)          :: modname = 'fromcpl'
-    CHARACTER (len = 80)          :: abort_message 
-    REAL, DIMENSION(nbp_lon*jj_nb)    :: field
-
-!************************************************************************************
-    WRITE (lunout,*) ' '
-    WRITE (lunout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime
-    WRITE (lunout,*) ' '
-    
-    istart=ii_begin
-    IF (is_south_pole_dyn) THEN
-       iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
-    ELSE
-       iend=(jj_end-jj_begin)*nbp_lon+ii_end
-    ENDIF
-    
-    DO i = 1, maxrecv
-      IF (inforecv(i)%action .AND. inforecv(i)%nid .NE. -1) THEN
-          field(:) = -99999.
-          CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror)
-          tab_get(:,:,i) = RESHAPE(field(:),(/nbp_lon,jj_nb/))
-       
-          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
-             ierror.NE.PRISM_FromRest &
-             .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut &
-             .AND. ierror.NE.PRISM_FromRestOut) THEN
-              WRITE (lunout,*)  'Error with receiving filed : ', inforecv(i)%name, ktime   
-              abort_message=' Problem in prism_get_proto '
-              CALL abort_physic(modname,abort_message,1)
-          ENDIF
-      ENDIF
-    END DO
-    
-    
-  END SUBROUTINE fromcpl
-
-!
-!************************************************************************************
-! 
-
-  SUBROUTINE intocpl(ktime, last, tab_put) 
-! ======================================================================
-! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the 
-! atmospheric coupling fields to the coupler with the psmile library.
-! IF last time step, writes output fields to binary files.
-! ======================================================================
-!
-! 
-    USE print_control_mod, ONLY: lunout
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-! Input arguments
-!************************************************************************************
-    INTEGER, INTENT(IN)                              :: ktime
-    LOGICAL, INTENT(IN)                              :: last
-    REAL, DIMENSION(nbp_lon, jj_nb, maxsend), INTENT(IN) :: tab_put
-
-! Local variables
-!************************************************************************************
-    LOGICAL                          :: checkout
-    INTEGER                          :: istart,iend
-    INTEGER                          :: wstart,wend
-    INTEGER                          :: ierror, i
-    REAL, DIMENSION(nbp_lon*jj_nb)       :: field
-    CHARACTER (len = 20),PARAMETER   :: modname = 'intocpl'
-    CHARACTER (len = 80)             :: abort_message 
-
-!************************************************************************************
-    checkout=.FALSE.
-
-    WRITE(lunout,*) ' '
-    WRITE(lunout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime
-    WRITE(lunout,*) 'last = ', last
-    WRITE(lunout,*)
-
-
-    istart=ii_begin
-    IF (is_south_pole_dyn) THEN
-       iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
-    ELSE
-       iend=(jj_end-jj_begin)*nbp_lon+ii_end
-    ENDIF
-    
-    IF (checkout) THEN   
-       wstart=istart
-       wend=iend
-       IF (is_north_pole_dyn) wstart=istart+nbp_lon-1
-       IF (is_south_pole_dyn) wend=iend-nbp_lon+1
-       
-       DO i = 1, maxsend
-          IF (infosend(i)%action) THEN
-             field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
-             CALL writefield_phy(infosend(i)%name,field(wstart:wend),1)
-          END IF
-       END DO
-    END IF
-
-!************************************************************************************
-! PRISM_PUT
-!************************************************************************************
-
-    DO i = 1, maxsend
-      IF (infosend(i)%action .AND. infosend(i)%nid .NE. -1 ) THEN
-          field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
-          CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror)
-          
-          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest &
-             .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. &
-             ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN
-              WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime   
-              abort_message=' Problem in prism_put_proto '
-              CALL abort_physic(modname,abort_message,1)
-          ENDIF
-      ENDIF
-    END DO
-   
-!************************************************************************************
-! Finalize PSMILE for the case is_sequential, if parallel finalization is done 
-! from Finalize_parallel in dyn3dpar/parallel.F90
-!************************************************************************************
-
-    IF (last) THEN
-       IF (is_sequential) THEN 
-          CALL prism_terminate_proto(ierror)
-          IF (ierror .NE. PRISM_Ok) THEN
-             abort_message=' Problem in prism_terminate_proto '
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-    ENDIF
-    
-    
-  END SUBROUTINE intocpl
-
-#endif
-  
-END MODULE oasis
+link ../phylmd/oasis.F90
Index: LMDZ6/trunk/libf/phylmdiso/ocean_albedo.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ocean_albedo.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ocean_albedo.F90	(revision 3940)
@@ -1,256 +1,1 @@
-!
-! $Id$
-!
-
-SUBROUTINE ocean_albedo(knon,zrmu0,knindex,pwind,SFRWL,alb_dir_new,alb_dif_new)
-!!
-!!****  *ALBEDO_RS14*  
-!!
-!!    PURPOSE
-!!    -------
-!!     computes the direct & diffuse albedo over open water
-!!     
-!!**  METHOD
-!!    ------
-!!
-!!    EXTERNAL
-!!    --------
-!!
-!!    IMPLICIT ARGUMENTS
-!!    ------------------ 
-!!      
-!!    REFERENCE
-!!    ---------
-!!      
-!!    AUTHOR
-!!    ------
-!!	R. Séférian           * Meteo-France *
-!!
-!!    MODIFICATIONS
-!!    -------------
-!!      Original    03/2014
-!!                  05/2014 R. Séférian & B. Decharme :: Adaptation to spectral
-!!                  computation for diffuse and direct albedo
-!!                  08/2014 S. Baek :: for wider wavelength range 200-4000nm and
-!!                  adaptation to LMDZ + whitecap effect by Koepke + chrolophyll
-!!                  map from climatology file
-!!                  10/2016 O. Boucher :: some optimisation following R.
-!!                  Seferian's work in the CNRM Model
-!!       
-!-------------------------------------------------------------------------------
-!
-!*           DECLARATIONS
-!            ------------
-!
-USE ocean_albedo_para
-USE dimphy
-USE phys_state_var_mod, ONLY : chl_con
-!
-!
-IMPLICIT NONE
-!
-!*      0.1    declarations of arguments
-!              -------------------------
-!
-include "clesphys.h"
-!
-INTEGER, INTENT(IN) :: knon
-INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-REAL, DIMENSION(klon), INTENT(IN) :: zrmu0         !--cos(SZA) on full vector
-REAL, DIMENSION(klon), INTENT(IN) :: pwind         !--wind speed on compressed vector
-REAL, DIMENSION(6),INTENT(IN) :: SFRWL
-REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new, alb_dif_new
-!
-!*      0.2    declarations of local variables
-!              -------------------------
-!
-REAL, DIMENSION(klon)           :: ZCHL        ! surface chlorophyll
-REAL, DIMENSION(klon)           :: ZCOSZEN     ! Cosine of the zenith solar angle
-!
-INTEGER                         :: JWL, INU    ! indexes
-INTEGER                         :: JI
-REAL                            :: ZWL         ! input parameter: wavelength and diffuse/direct fraction of light
-REAL:: ZCHLABS, ZAW, ZBW, ZREFM, ZYLMD, ZUE, ZUE2 ! scalar computation variables
-!
-REAL, DIMENSION(klon) :: ZAP, ZXX2, ZR00, ZRR0, ZRRR               ! computation variables
-REAL, DIMENSION(klon) :: ZR22, ZR11DF                              ! computation variables
-REAL, DIMENSION(klon) :: ZBBP, ZNU, ZHB                            ! computation variables
-REAL, DIMENSION(klon) :: ZR11, ZRW, ZRWDF, ZRDF                    ! 4 components of the OSA
-REAL, DIMENSION(klon) :: ZSIG, ZFWC, ZWORK1, ZWORK2, ZWORK3
-! 
-!--initialisations-------------
-!
-
-IF (knon==0) RETURN ! A verifier pourquoi on en a besoin...
-
-alb_dir_new(:,:) = 0. 
-alb_dif_new(:,:) = 0. 
-!
-! Initialisation of chlorophyll content
-! ZCHL(:) = CHL_CON!0.05 ! averaged global values for surface chlorophyll
-IF (ok_chlorophyll) THEN
-  ZCHL(1:knon)=CHL_CON(knindex(1:knon))
-ELSE 
-  ZCHL(1:knon) = 0.05
-ENDIF
-
-! variables that do not depend on wavelengths
-! loop over the grid points
-! functions of chlorophyll content
-ZWORK1(1:knon)= EXP(LOG(ZCHL(1:knon))*0.65)
-ZWORK2(1:knon)= 0.416 * EXP(LOG(ZCHL(1:knon))*0.766)
-ZWORK3(1:knon)= LOG10(ZCHL(1:knon))
-! store the cosine of the solar zenith angle
-ZCOSZEN(1:knon) = zrmu0(knindex(1:knon))
-! Compute sigma derived from wind speed (Cox & Munk reflectance model)
-ZSIG(1:knon)=SQRT(0.003+0.00512*PWIND(1:knon))
-! original : correction for foam (Eq 16-17)
-! has to be update once we have information from wave model (discussion with G. Madec)
-ZFWC(1:knon)=3.97e-4*PWIND(1:knon)**1.59 ! Salisbury 2014 eq(2) at 37GHz, value in fraction
-!
-DO JWL=1,NNWL           ! loop over the wavelengths
-  !
-  !---------------------------------------------------------------------------------
-  ! 0- Compute baseline values
-  !---------------------------------------------------------------------------------
-    
-  ! Get refractive index for the correspoding wavelength
-  ZWL=XAKWL(JWL)      !!!--------- wavelength value
-  ZREFM= XAKREFM(JWL) !!!--------- refraction index value
-  
-  !---------------------------------------------------------------------------------
-  ! 1- Compute direct surface albedo (ZR11)
-  !---------------------------------------------------------------------------------
-  !
-  ZXX2(1:knon)=SQRT(1.0-(1.0-ZCOSZEN(1:knon)**2)/ZREFM**2)
-  ZRR0(1:knon)=0.50*(((ZXX2(1:knon)-ZREFM*ZCOSZEN(1:knon))/(ZXX2(1:knon)+ZREFM*ZCOSZEN(1:knon)))**2 +  & 
-               ((ZCOSZEN(1:knon)-ZREFM*ZXX2(1:knon))/(ZCOSZEN(1:knon)+ZREFM*ZXX2(1:knon)))**2)
-  ZRRR(1:knon)=0.50*(((ZXX2(1:knon)-1.34*ZCOSZEN(1:knon))/(ZXX2(1:knon)+1.34*ZCOSZEN(1:knon)))**2 + & 
-               ((ZCOSZEN(1:knon)-1.34*ZXX2(1:knon))/(ZCOSZEN(1:knon)+1.34*ZXX2(1:knon)))**2)
-  ZR11(1:knon)=ZRR0(1:knon)-(0.0152-1.7873*ZCOSZEN(1:knon)+6.8972*ZCOSZEN(1:knon)**2-8.5778*ZCOSZEN(1:knon)**3+ & 
-               4.071*ZSIG(1:knon)-7.6446*ZCOSZEN(1:knon)*ZSIG(1:knon)) *  & 
-               EXP(0.1643-7.8409*ZCOSZEN(1:knon)-3.5639*ZCOSZEN(1:knon)**2-2.3588*ZSIG(1:knon)+ & 
-               10.0538*ZCOSZEN(1:knon)*ZSIG(1:knon))*ZRR0(1:knon)/ZRRR(1:knon)
-  ! 
-  !---------------------------------------------------------------------------------
-  ! 2- Compute surface diffuse albedo (ZRDF)
-  !---------------------------------------------------------------------------------
-  ! Diffuse albedo from Jin et al., 2006 + estimation from diffuse fraction of
-  ! light (relying later on AOD). CNRM model has opted for Eq 5b
-  ZRDF(1:knon)=-0.1482-0.012*ZSIG(1:knon)+0.1609*ZREFM-0.0244*ZSIG(1:knon)*ZREFM ! surface diffuse (Eq 5a)
-  !!ZRDF(1:knon)=-0.1479+0.1502*ZREFM-0.0176*ZSIG(1:knon)*ZREFM   ! surface diffuse (Eq 5b) 
- 
-  !---------------------------------------------------------------------------------
-  ! *- Determine absorption and backscattering
-  ! coefficients to determine reflectance below the surface (Ro) once for all
-  !
-  ! *.1- Absorption by chlorophyll
-  ZCHLABS= XAKACHL(JWL) 
-  ! *.2- Absorption by seawater 
-  ZAW= XAKAW3(JWL) 
-  ! *.3- Backscattering by seawater
-  ZBW= XAKBW(JWL) 
-  ! *.4- Backscattering by chlorophyll
-  ZYLMD = EXP(0.014*(440.0-ZWL))
-  ZAP(1:knon) = 0.06*ZCHLABS*ZWORK1(1:knon) +0.2*(XAW440+0.06*ZWORK1(1:knon))*ZYLMD
-   
-!!  WHERE ( ZCHL(1:knon) > 0.02 )
-!!    ZNU(:)=MIN(0.0,0.5*(ZWORK3(:)-0.3))
-!!    ZBBP(:)=(0.002+0.01*(0.5-0.25*ZWORK3(:))*(ZWL/550.)**ZNU(:))*ZWORK2(:)
-!!  ELSEWHERE
-!!    ZBBP(:)=0.019*(550./ZWL)*ZWORK2(:)       !ZBBPf=0.0113 at chl<=0.02
-!!  ENDWHERE
-
-    do JI = 1, knon
-      IF (ZCHL(JI) > 0.02) THEN
-        ZNU(JI)=MIN(0.0,0.5*(ZWORK3(JI)-0.3))
-        ZBBP(JI)=(0.002+0.01*(0.5-0.25*ZWORK3(JI))*(ZWL/550.)**ZNU(JI)) &
-                  *ZWORK2(JI)
-      ELSE
-        ZBBP(JI)=0.019*(550./ZWL)*ZWORK2(JI)       !ZBBPf=0.0113 at chl<=0.02 
-      ENDIF
-    ENDDO
-
-  ! Morel-Gentili(1991), Eq (12)
-  ! ZHB=h/(h+2*ZBBPf*(1.-h))        
-  ZHB(1:knon)=0.5*ZBW/(0.5*ZBW+ZBBP(1:knon))
-   
-  !---------------------------------------------------------------------------------
-  ! 3- Compute direct water-leaving albedo (ZRW)
-  !---------------------------------------------------------------------------------
-  ! Based on Morel & Gentilli 1991 parametrization
-  ZR22(1:knon)=0.48168549-0.014894708*ZSIG(1:knon)-0.20703885*ZSIG(1:knon)**2
-
-  ! Use Morel 91 formula to compute the direct reflectance
-  ! below the surface
-  ZR00(1:knon)=(0.5*ZBW+ZBBP(1:knon))/(ZAW+ZAP(1:knon)) *  & 
-               (0.6279-0.2227*ZHB(1:knon)-0.0513*ZHB(1:knon)**2 + & 
-               (-0.3119+0.2465*ZHB(1:knon))*ZCOSZEN(1:knon))
-  ZRW(1:knon)=ZR00(1:knon)*(1.-ZR22(1:knon))/(1.-ZR00(1:knon)*ZR22(1:knon))
-
-  !---------------------------------------------------------------------------------
-  ! 4- Compute diffuse water-leaving albedo (ZRWDF)
-  !---------------------------------------------------------------------------------
-  ! as previous water-leaving computation but assumes a uniform incidence of
-  ! shortwave at surface (ue)
-  ZUE=0.676               ! equivalent u_unif for diffuse incidence
-  ZUE2=SQRT(1.0-(1.0-ZUE**2)/ZREFM**2)
-  ZRR0(1:knon)=0.50*(((ZUE2-ZREFM*ZUE)/(ZUE2+ZREFM*ZUE))**2 +((ZUE-ZREFM*ZUE2)/(ZUE+ZREFM*ZUE2))**2)
-  ZRRR(1:knon)=0.50*(((ZUE2-1.34*ZUE)/(ZUE2+1.34*ZUE))**2 +((ZUE-1.34*ZUE2)/(ZUE+1.34*ZUE2))**2)
-  ZR11DF(1:knon)=ZRR0(1:knon)-(0.0152-1.7873*ZUE+6.8972*ZUE**2-8.5778*ZUE**3+4.071*ZSIG(1:knon)-7.6446*ZUE*ZSIG(1:knon)) * &
-                 EXP(0.1643-7.8409*ZUE-3.5639*ZUE**2-2.3588*ZSIG(1:knon)+10.0538*ZUE*ZSIG(1:knon))*ZRR0(1:knon)/ZRRR(1:knon)
-
-  ! Use Morel 91 formula to compute the diffuse
-  ! reflectance below the surface
-  ZR00(1:knon) = (0.5*ZBW+ZBBP(1:knon)) / (ZAW+ZAP(1:knon)) &
-       * (0.6279-0.2227*ZHB(1:knon)-0.0513*ZHB(1:knon)**2 &
-       + (-0.3119+0.2465*ZHB(1:knon))*ZUE)
-  ZRWDF(1:knon)=ZR00(1:knon)*(1.-ZR22(1:knon))*(1.-ZR11DF(1:knon))/(1.-ZR00(1:knon)*ZR22(1:knon))
-   
-  ! get waveband index inu for each nsw band
-  SELECT CASE(nsw)
-  CASE(2)
-    IF (JWL.LE.49) THEN       ! from 200  to 680 nm 
-     inu=1
-    ELSE                      ! from 690  to 4000 nm
-     inu=2
-    ENDIF
-  CASE(4)
-    IF (JWL.LE.49) THEN       ! from 200  to 680 nm 
-     inu=1
-    ELSE IF (JWL.LE.99) THEN  ! from 690  to 1180 nm
-     inu=2
-    ELSE IF (JWL.LE.218) THEN ! from 1190 to 2370 nm
-     inu=3
-    ELSE                      ! from 2380 to 4000 nm
-     inu=4
-    ENDIF
-  CASE(6)
-    IF (JWL.LE.5) THEN        ! from 200  to 240 nm 
-     inu=1
-    ELSE IF (JWL.LE.24) THEN  ! from 250  to 430 nm
-     inu=2
-    ELSE IF (JWL.LE.49) THEN  ! from 440  to 680 nm
-     inu=3
-    ELSE IF (JWL.LE.99) THEN  ! from 690  to 1180 nm
-     inu=4
-    ELSE IF (JWL.LE.218) THEN ! from 1190 to 2370 nm
-     inu=5
-    ELSE                      ! from 2380 to 4000 nm
-     inu=6
-    ENDIF
-  END SELECT
-
-  ! partitionning direct and diffuse albedo
-  ! excluding diffuse albedo ZRW on ZDIR_ALB
-
-  !--direct
-  alb_dir_new(1:knon,inu)=alb_dir_new(1:knon,inu) + & 
-                          ( XFRWL(JWL) * ((1.-ZFWC(1:knon)) * (ZR11(1:knon)+ZRW(1:knon))   + ZFWC(1:knon)*XRWC(JWL)) )/SFRWL(inu)
-  !--diffuse
-  alb_dif_new(1:knon,inu)=alb_dif_new(1:knon,inu) + & 
-                          ( XFRWL(JWL) * ((1.-ZFWC(1:knon)) * (ZRDF(1:knon)+ZRWDF(1:knon)) + ZFWC(1:knon)*XRWC(JWL)) )/SFRWL(inu)
-
-ENDDO ! ending loop over wavelengths
-
-END SUBROUTINE ocean_albedo
+link ../phylmd/ocean_albedo.F90
Index: LMDZ6/trunk/libf/phylmdiso/ocean_albedo_para.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ocean_albedo_para.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ocean_albedo_para.F90	(revision 3940)
@@ -1,646 +1,1 @@
-!
-! $Id$
-!
-!     ######################
-MODULE ocean_albedo_para
-!     ######################
-!
-!!****  *MOD_DALBEDO_RS14* - declaration of ISBA parameters
-!!
-!!    PURPOSE
-!!    -------
-!       The purpose of this declarative module is to specify  the 
-!     parameters related to direct & diffuse albedo over open water 
-!
-!!
-!!      
-!!
-!!    AUTHOR
-!!    ------
-!!	R. Séférian           * Meteo-France *
-!!
-!!    MODIFICATIONS
-!!    -------------
-!       S. Baek : extention from 200-800nm to 200-40000nm 
-!-------------------------------------------------------------------------------
-!
-!*       0.   DECLARATIONS
-!             ------------
-!
-
-IMPLICIT NONE
-!
-INTEGER, PARAMETER   :: NNWL = 381                ! number of wavelength
-!
-! absorption coefficients for seawater et 440 nm
-REAL, PARAMETER      :: XAW440 =  0.00635
-!
-!! white-caps reflectance (Koepke , 1983 estimation)
-!REAL, PARAMETER      :: XRWC   =  0.55
-!
-! table of wavelength discretization
-REAL, PARAMETER, DIMENSION(NNWL)::  XAKWL= &
-    (/ 200.0, 210.0, 220.0, 230.0, 240.0, 250.0, 260.0, 270.0, 280.0,  &
-    290.0, 300.0, 310.0, 320.0, 330.0, 340.0, 350.0, 360.0, 370.0,            &
-    380.0, 390.0, 400.0, 410.0, 420.0, 430.0, 440.0, 450.0, 460.0,            &
-    470.0, 480.0, 490.0, 500.0, 510.0, 520.0, 530.0, 540.0, 550.0,            &
-    560.0, 570.0, 580.0, 590.0, 600.0, 610.0, 620.0, 630.0, 640.0,            &
-    650.0, 660.0, 670.0, 680.0, 690.0, 700.0, 710.0, 720.0, 730.0,            &
-    740.0, 750.0, 760.0, 770.0, 780.0, 790.0, 800.0, 810.0, 820.0,            &
-    830.0, 840.0, 850.0, 860.0, 870.0, 880.0, 890.0, 900.0, 910.0,            &
-    920.0, 930.0, 940.0, 950.0, 960.0, 970.0, 980.0, 990.0, 1000.0, 1010.0,   &
-    1020.0, 1030.0, 1040.0, 1050.0, 1060.0, 1070.0, 1080.0, 1090.0, 1100.0,   &
-    1110.0, 1120.0, 1130.0, 1140.0, 1150.0, 1160.0, 1170.0, 1180.0, 1190.0,   &
-    1200.0, 1210.0, 1220.0, 1230.0, 1240.0, 1250.0, 1260.0, 1270.0, 1280.0,   &
-    1290.0, 1300.0, 1310.0, 1320.0, 1330.0, 1340.0, 1350.0, 1360.0, 1370.0,   &
-    1380.0, 1390.0, 1400.0, 1410.0, 1420.0, 1430.0, 1440.0, 1450.0, 1460.0,   &
-    1470.0, 1480.0, 1490.0, 1500.0, 1510.0, 1520.0, 1530.0, 1540.0, 1550.0,   &
-    1560.0, 1570.0, 1580.0, 1590.0, 1600.0, 1610.0, 1620.0, 1630.0, 1640.0,   &
-    1650.0, 1660.0, 1670.0, 1680.0, 1690.0, 1700.0, 1710.0, 1720.0, 1730.0,   &
-    1740.0, 1750.0, 1760.0, 1770.0, 1780.0, 1790.0, 1800.0, 1810.0, 1820.0,   &
-    1830.0, 1840.0, 1850.0, 1860.0, 1870.0, 1880.0, 1890.0, 1900.0, 1910.0,   &
-1920.0, 1930.0, 1940.0, 1950.0, 1960.0, 1970.0, 1980.0, 1990.0, 2000.0, 2010.0,& 
-2020.0, 2030.0, 2040.0, 2050.0, 2060.0, 2070.0, 2080.0, 2090.0, 2100.0, 2110.0,&
-2120.0, 2130.0, 2140.0, 2150.0, 2160.0, 2170.0, 2180.0, 2190.0, 2200.0, 2210.0,&
-2220.0, 2230.0, 2240.0, 2250.0, 2260.0, 2270.0, 2280.0, 2290.0, 2300.0, 2310.0,&
-2320.0, 2330.0, 2340.0, 2350.0, 2360.0, 2370.0, 2380.0, 2390.0, 2400.0, 2410.0,&
-2420.0, 2430.0, 2440.0, 2450.0, 2460.0, 2470.0, 2480.0, 2490.0, 2500.0, 2510.0,&
-2520.0, 2530.0, 2540.0, 2550.0, 2560.0, 2570.0, 2580.0, 2590.0, 2600.0, 2610.0,&
-2620.0, 2630.0, 2640.0, 2650.0, 2660.0, 2670.0, 2680.0, 2690.0, 2700.0, 2710.0,&
-2720.0, 2730.0, 2740.0, 2750.0, 2760.0, 2770.0, 2780.0, 2790.0, 2800.0, 2810.0,&
-2820.0, 2830.0, 2840.0, 2850.0, 2860.0, 2870.0, 2880.0, 2890.0, 2900.0, 2910.0,&
-2920.0, 2930.0, 2940.0, 2950.0, 2960.0, 2970.0, 2980.0, 2990.0, 3000.0, 3010.0,&
-3020.0, 3030.0, 3040.0, 3050.0, 3060.0, 3070.0, 3080.0, 3090.0, 3100.0, 3110.0,&
-3120.0, 3130.0, 3140.0, 3150.0, 3160.0, 3170.0, 3180.0, 3190.0, 3200.0, 3210.0,&
-3220.0, 3230.0, 3240.0, 3250.0, 3260.0, 3270.0, 3280.0, 3290.0, 3300.0, 3310.0,&
-3320.0, 3330.0, 3340.0, 3350.0, 3360.0, 3370.0, 3380.0, 3390.0, 3400.0, 3410.0,&
-3420.0, 3430.0, 3440.0, 3450.0, 3460.0, 3470.0, 3480.0, 3490.0, 3500.0, 3510.0,&
-3520.0, 3530.0, 3540.0, 3550.0, 3560.0, 3570.0, 3580.0, 3590.0, 3600.0, 3610.0,&
-3620.0, 3630.0, 3640.0, 3650.0, 3660.0, 3670.0, 3680.0, 3690.0, 3700.0, 3710.0,&
-3720.0, 3730.0, 3740.0, 3750.0, 3760.0, 3770.0, 3780.0, 3790.0, 3800.0, 3810.0,&
-3820.0, 3830.0, 3840.0, 3850.0, 3860.0, 3870.0, 3880.0, 3890.0, 3900.0, 3910.0,&
-3920.0, 3930.0, 3940.0, 3950.0, 3960.0, 3970.0, 3980.0, 3990.0, 4000.0 /) 
-
-
- 
-!
-! proportion of each wavelength
-REAL, PARAMETER, DIMENSION(NNWL)::  XFRWL= &
-(/0.5399519E-04, 0.2057802E-03, 0.3488387E-03, 0.3841427E-03, 0.2915711E-03, &
-0.4429581E-03, 0.6302387E-03, 0.1970095E-02, 0.6974564E-03, 0.4431792E-02,   &
-0.3095547E-02, 0.4587307E-02, 0.5933870E-02, 0.7488277E-02, 0.7421943E-02,   &
-0.7738869E-02, 0.7155137E-02, 0.8394831E-02, 0.8859162E-02, 0.9190828E-02,   &
-0.1239693E-01, 0.1129138E-01, 0.1294971E-01, 0.8365349E-02, 0.1262541E-01,&
-0.1580203E-01, 0.1503552E-01, 0.1383415E-01, 0.1499867E-01, 0.1479230E-01,&
-0.1368674E-01, 0.1435007E-01, 0.1349511E-01, 0.1438693E-01, 0.1303815E-01,&
-0.1372359E-01, 0.1358356E-01, 0.1303815E-01, 0.1354671E-01, 0.1336245E-01,&
-0.1286863E-01, 0.1255171E-01, 0.1278019E-01, 0.1208001E-01, 0.1189575E-01,&
-0.1183678E-01, 0.1157882E-01, 0.1117345E-01, 0.1099656E-01, 0.1067227E-01,&
-0.1021531E-01, 0.1020794E-01, 0.9809937E-02, 0.9773086E-02, 0.9271902E-02,&
-0.9301383E-02, 0.9117125E-02, 0.8873903E-02, 0.8748608E-02, 0.8534866E-02,&
-0.8416941E-02, 0.8210571E-02, 0.7959980E-02, 0.7834683E-02, 0.7665165E-02,&
-0.7119759E-02, 0.7347503E-02, 0.7183881E-02, 0.7041634E-02, 0.7023945E-02,&
-0.6749768E-02, 0.6571406E-02, 0.6565509E-02, 0.6395254E-02, 0.6219103E-02,&
-0.6168247E-02, 0.6007574E-02, 0.5866062E-02, 0.5709074E-02, 0.5557982E-02,&
-0.5512286E-02, 0.5389938E-02, 0.5189464E-02, 0.5112813E-02, 0.4983095E-02,&
-0.4880646E-02, 0.4728080E-02, 0.4599837E-02, 0.4604259E-02, 0.4568881E-02,&
-0.4453166E-02, 0.4352930E-02, 0.4231319E-02, 0.4166460E-02, 0.4075804E-02,&
-0.4045586E-02, 0.3921027E-02, 0.3888597E-02, 0.3861327E-02, 0.3747823E-02,&
-0.3687387E-02, 0.3598206E-02, 0.3593046E-02, 0.3531872E-02, 0.3429424E-02,&
-0.3408050E-02, 0.3338769E-02, 0.3282018E-02, 0.3210525E-02, 0.3136085E-02,&
-0.3085229E-02, 0.3026266E-02, 0.2959933E-02, 0.2858222E-02, 0.2793363E-02,&
-0.2744719E-02, 0.2707130E-02, 0.2652589E-02, 0.2637849E-02, 0.2584045E-02,&
-0.2525819E-02, 0.2519186E-02, 0.2474227E-02, 0.2400524E-02, 0.2349668E-02,&
-0.2348931E-02, 0.2326083E-02, 0.2286283E-02, 0.2261224E-02, 0.2222161E-02,&
-0.2219213E-02, 0.2172043E-02, 0.2112343E-02, 0.2037902E-02, 0.2012106E-02,&
-0.1999576E-02, 0.1977465E-02, 0.1949458E-02, 0.1953143E-02, 0.1772569E-02,&
-0.1851432E-02, 0.1768884E-02, 0.1746036E-02, 0.1763725E-02, 0.1667173E-02,&
-0.1674544E-02, 0.1654644E-02, 0.1639903E-02, 0.1533033E-02, 0.1551459E-02,&
-0.1520504E-02, 0.1483652E-02, 0.1468911E-02, 0.1462278E-02, 0.1404052E-02,&
-0.1369411E-02, 0.1349511E-02, 0.1320030E-02, 0.1294234E-02, 0.1277282E-02,&
-0.1252223E-02, 0.1242641E-02, 0.1176308E-02, 0.1183679E-02, 0.1151249E-02,&
-0.1139456E-02, 0.1107764E-02, 0.1111449E-02, 0.1077545E-02, 0.1049538E-02,&
-0.1029638E-02, 0.1015634E-02, 0.9824679E-03, 0.9677272E-03, 0.9574086E-03,&
-0.9294013E-03, 0.9294013E-03, 0.9131865E-03, 0.8814940E-03, 0.8829681E-03,&
-0.8623311E-03, 0.8468534E-03, 0.8225312E-03, 0.8004201E-03, 0.7945239E-03,&
-0.7805202E-03, 0.7576721E-03, 0.7392463E-03, 0.7280433E-03, 0.7214100E-03,&
-0.7079960E-03, 0.6925183E-03, 0.6836001E-03, 0.6787357E-03, 0.6694490E-03,&
-0.6601624E-03, 0.6471906E-03, 0.6306809E-03, 0.6262587E-03, 0.6120340E-03,&
-0.6091595E-03, 0.5955244E-03, 0.5894070E-03, 0.5771722E-03, 0.5630211E-03,&
-0.5557982E-03, 0.5469538E-03, 0.5378146E-03, 0.5280857E-03, 0.5240319E-03,&
-0.5124605E-03, 0.5063431E-03, 0.4988254E-03, 0.4876225E-03, 0.4805469E-03,&
-0.4756088E-03, 0.4649218E-03, 0.4577725E-03, 0.4548981E-03, 0.4443585E-03,&
-0.4380937E-03, 0.4349982E-03, 0.4252693E-03, 0.4209945E-03, 0.4156141E-03,&
-0.4025686E-03, 0.4022001E-03, 0.3895231E-03, 0.3815631E-03, 0.3851009E-03,&
-0.3799416E-03, 0.3736400E-03, 0.3673383E-03, 0.3610735E-03, 0.3548087E-03,&
-0.3495758E-03, 0.3443428E-03, 0.3398469E-03, 0.3353510E-03, 0.3319237E-03,&
-0.3284966E-03, 0.3228951E-03, 0.3172936E-03, 0.3138296E-03, 0.3103655E-03,&
-0.3055011E-03, 0.3006366E-03, 0.2965461E-03, 0.2924555E-03, 0.2887335E-03,&
-0.2850115E-03, 0.2811789E-03, 0.2773463E-03, 0.2736611E-03, 0.2699760E-03,&
-0.2656643E-03, 0.2613527E-03, 0.2584782E-03, 0.2556038E-03, 0.2525451E-03,&
-0.2494864E-03, 0.2462434E-03, 0.2430005E-03, 0.2397575E-03, 0.2365146E-03,&
-0.2331979E-03, 0.2298813E-03, 0.2266752E-03, 0.2234690E-03, 0.2211474E-03,&
-0.2188257E-03, 0.2159144E-03, 0.2130031E-03, 0.2103130E-03, 0.2076228E-03,&
-0.2051537E-03, 0.2026847E-03, 0.2001787E-03, 0.1976728E-03, 0.1950932E-03,&
-0.1925136E-03, 0.1901182E-03, 0.1877228E-03, 0.1847010E-03, 0.1816792E-03,&
-0.1800945E-03, 0.1785099E-03, 0.1763725E-03, 0.1742351E-03, 0.1720977E-03,&
-0.1699603E-03, 0.1677492E-03, 0.1655381E-03, 0.1637692E-03, 0.1620003E-03,&
-0.1600103E-03, 0.1580203E-03, 0.1562514E-03, 0.1544826E-03, 0.1527137E-03,&
-0.1509448E-03, 0.1491759E-03, 0.1474070E-03, 0.1456013E-03, 0.1437956E-03,&
-0.1421741E-03, 0.1405526E-03, 0.1387469E-03, 0.1369411E-03, 0.1348774E-03,&
-0.1328137E-03, 0.1315608E-03, 0.1303078E-03, 0.1291654E-03, 0.1280230E-03,&
-0.1265489E-03, 0.1250749E-03, 0.1236745E-03, 0.1222741E-03, 0.1206526E-03,&
-0.1190312E-03, 0.1178888E-03, 0.1167464E-03, 0.1156408E-03, 0.1145353E-03,&
-0.1132823E-03, 0.1120294E-03, 0.1107764E-03, 0.1095234E-03, 0.1084179E-03,&
-0.1073123E-03, 0.1061699E-03, 0.1050275E-03, 0.1038483E-03, 0.1026690E-03,&
-0.1015266E-03, 0.1003842E-03, 0.9935234E-04, 0.9832049E-04, 0.9732549E-04,&
-0.9633049E-04, 0.9537235E-04, 0.9441420E-04, 0.9330864E-04, 0.9220310E-04,&
-0.9113440E-04, 0.9006570E-04, 0.8899700E-04, 0.8792829E-04, 0.8678589E-04,&
-0.8564349E-04, 0.8501700E-04, 0.8439052E-04, 0.8302701E-04, 0.8166349E-04,&
-0.8122127E-04, 0.8077905E-04, 0.8011572E-04, 0.7945239E-04, 0.7867850E-04,&
-0.7790462E-04, 0.7720443E-04, 0.7650425E-04, 0.7580406E-04, 0.7510388E-04,&
-0.7434105E-04, 0.7357822E-04, 0.7283750E-04, 0.7209678E-04, 0.7142239E-04,&
-0.7074801E-04, 0.7011415E-04, 0.6948030E-04, 0.6876537E-04, 0.6805045E-04,&
-0.6730973E-04, 0.6656901E-04, 0.6592411E-04, 0.6527920E-04, 0.6458639E-04,&
-0.6389357E-04 /) 
-
-
-!
-! Table for computing Reflectance just below ocean surface (bounded to 200-800 nm)
-! table of refractive index as function of wavelength
-REAL, PARAMETER, DIMENSION(NNWL)::  XAKREFM= &
-(/ 1.4517,  1.4345,  1.4214,  1.4108,  1.4022,  1.3950,  1.3889,  1.3836,      &
-1.3790,  1.3750,  1.3714,  1.3682,  1.3653,  1.3627,  1.3604,  1.3582,  1.3562,&
-1.3544,  1.3528,  1.3512,  1.3498,  1.3484,  1.3472,  1.3460,  1.3449,  1.3439,&
-1.3429,  1.3420,  1.3411,  1.3402,  1.3394,  1.3387,  1.3379,  1.3372,  1.3366,&
-1.3359,  1.3353,  1.3347,  1.3342,  1.3336,  1.3331,  1.3326,  1.3321,  1.3316,&
-1.3311,  1.3307,  1.3303,  1.3299,  1.3295,  1.3291,  1.3288,  1.3284,  1.3281,&
-1.3278,  1.3275,  1.3272,  1.3269,  1.3266,  1.3264,  1.3261,  1.3259,  1.3256,&
-1.3254,  1.3252,  1.3249,  1.3247,  1.3245,  1.3243,  1.3241,  1.3238,  1.3236,&
-1.3234,  1.3232,  1.3230,  1.3228,  1.3226,  1.3225,  1.3223,  1.3221,  1.3219,&
-1.3217,  1.3215,  1.3213,  1.3211,  1.3210,  1.3208,  1.3206,  1.3204,  1.3202,&
-1.3200,  1.3198,  1.3197,  1.3195,  1.3193,  1.3191,  1.3189,  1.3187,  1.3186,&
-1.3184,  1.3182,  1.3180,  1.3178,  1.3176,  1.3174,  1.3172,  1.3170,  1.3169,&
-1.3167,  1.3165,  1.3163,  1.3161,  1.3159,  1.3156,  1.3154,  1.3152,  1.3150,&
-1.3148,  1.3146,  1.3143,  1.3141,  1.3139,  1.3137,  1.3135,  1.3134,  1.3132,&
-1.3130,  1.3129,  1.3127,  1.3125,  1.3123,  1.3121,  1.3119,  1.3116,  1.3114,&
-1.3111,  1.3109,  1.3106,  1.3104,  1.3101,  1.3099,  1.3096,  1.3094,  1.3091,&
-1.3088,  1.3086,  1.3083,  1.3080,  1.3077,  1.3074,  1.3071,  1.3068,  1.3065,&
-1.3061,  1.3058,  1.3055,  1.3051,  1.3048,  1.3044,  1.3041,  1.3037,  1.3034,&
-1.3030,  1.3026,  1.3022,  1.3017,  1.3013,  1.3007,  1.3002,  1.2998,  1.2995,&
-1.2990,  1.2988,  1.2988,  1.2987,  1.2986,  1.2985,  1.2983,  1.2980,  1.2977,&
-1.2973,  1.2969,  1.2965,  1.2960,  1.2955,  1.2950,  1.2945,  1.2940,  1.2935,&
-1.2929,  1.2924,  1.2918,  1.2913,  1.2907,  1.2901,  1.2895,  1.2889,  1.2883,&
-1.2876,  1.2870,  1.2863,  1.2856,  1.2849,  1.2842,  1.2835,  1.2828,  1.2820,&
-1.2812,  1.2804,  1.2796,  1.2788,  1.2779,  1.2770,  1.2761,  1.2751,  1.2741,&
-1.2731,  1.2721,  1.2711,  1.2699,  1.2688,  1.2676,  1.2664,  1.2652,  1.2639,&
-1.2625,  1.2612,  1.2597,  1.2582,  1.2567,  1.2552,  1.2535,  1.2518,  1.2499,&
-1.2480,  1.2459,  1.2436,  1.2413,  1.2388,  1.2361,  1.2331,  1.2299,  1.2263,&
-1.2223,  1.2182,  1.2140,  1.2091,  1.2034,  1.1973,  1.1910,  1.1850,  1.1780,&
-1.1691,  1.1564,  1.1489,  1.1430,  1.1351,  1.1318,  1.1323,  1.1308,  1.1277,&
-1.1294,  1.1286,  1.1255,  1.1271,  1.1348,  1.1417,  1.1480,  1.1612,  1.1736,&
-1.1847,  1.2008,  1.2177,  1.2336,  1.2505,  1.2678,  1.2840,  1.3007,  1.3149,&
-1.3281,  1.3407,  1.3539,  1.3661,  1.3782,  1.3903,  1.4024,  1.4136,  1.4217,&
-1.4299,  1.4380,  1.4461,  1.4528,  1.4557,  1.4587,  1.4616,  1.4645,  1.4665,&
-1.4655,  1.4645,  1.4634,  1.4624,  1.4613,  1.4589,  1.4566,  1.4543,  1.4519,&
-1.4496,  1.4465,  1.4433,  1.4401,  1.4369,  1.4338,  1.4304,  1.4271,  1.4237,&
-1.4203,  1.4170,  1.4144,  1.4117,  1.4091,  1.4065,  1.4041,  1.4020,  1.3999,&
-1.3977,  1.3956,  1.3936,  1.3916,  1.3897,  1.3879,  1.3860,  1.3841,  1.3824,&
-1.3808,  1.3791,  1.3774,  1.3758,  1.3743,  1.3729,  1.3714,  1.3700,  1.3685,&
-1.3673,  1.3660,  1.3647,  1.3635,  1.3623,  1.3612,  1.3601,  1.3589,  1.3578,&
-1.3568,  1.3558,  1.3548,  1.3538,  1.3528,  1.3519,  1.3510,  1.3501,  1.3493,&
-1.3484,  1.3476,  1.3468,  1.3460,  1.3452,  1.3444,  1.3437,  1.3430,  1.3422,&
-1.3415,  1.3408,  1.3401,  1.3395,  1.3388,  1.3382,  1.3375,  1.3369,  1.3363,&
-1.3357,  1.3351,  1.3345,  1.3339 /)
-
-
-
-
-!
-! table of chlorophyll absorption coefficient as function of wavelength
-REAL, PARAMETER, DIMENSION(NNWL)::  XAKACHL= &
-(/0.4629505E+00, 0.4694205E+00, 0.4758904E+00, 0.4823604E+00, 0.4888304E+00,&
-0.4953003E+00, 0.5017703E+00, 0.5082403E+00, 0.5147102E+00, 0.5211802E+00,&
-0.5276502E+00, 0.5341201E+00, 0.5405901E+00, 0.5470601E+00, 0.5535300E+00,&
-0.5600000E+00, 0.5700000E+00, 0.5900000E+00, 0.6100000E+00, 0.6600000E+00,&
-0.6870000E+00, 0.8280000E+00, 0.9130000E+00, 0.9730000E+00, 0.1000000E+01,&
-0.9440000E+00, 0.9170000E+00, 0.8700000E+00, 0.7980000E+00, 0.7500000E+00,&
-0.6680000E+00, 0.6180000E+00, 0.5280000E+00, 0.4740000E+00, 0.4160000E+00,&
-0.3570000E+00, 0.2940000E+00, 0.2760000E+00, 0.2910000E+00, 0.2820000E+00,&
-0.2360000E+00, 0.2520000E+00, 0.2760000E+00, 0.3170000E+00, 0.3340000E+00,&
-0.3560000E+00, 0.4410000E+00, 0.5950000E+00, 0.5020000E+00, 0.3290000E+00,&
-0.2150000E+00, 0.2150000E+00, 0.2083276E+00, 0.2016552E+00, 0.1949828E+00,&
-0.1883103E+00, 0.1816379E+00, 0.1749655E+00, 0.1682931E+00, 0.1616207E+00,&
-0.1549483E+00, 0.1482759E+00, 0.1416035E+00, 0.1349310E+00, 0.1282586E+00,&
-0.1215862E+00, 0.1149138E+00, 0.1082414E+00, 0.1015690E+00, 0.9489655E-01,&
-0.8822414E-01, 0.8155172E-01, 0.7487931E-01, 0.6820690E-01, 0.6153448E-01,&
-0.5486207E-01, 0.4818965E-01, 0.4151724E-01, 0.3484483E-01, 0.2817241E-01,&
-0.2150000E-01, 0.2143550E-01, 0.2137100E-01, 0.2130650E-01, 0.2124200E-01,&
-0.2117750E-01, 0.2111300E-01, 0.2104850E-01, 0.2098400E-01, 0.2091950E-01,&
-0.2085500E-01, 0.2079050E-01, 0.2072600E-01, 0.2066150E-01, 0.2059700E-01,&
-0.2053250E-01, 0.2046800E-01, 0.2040350E-01, 0.2033900E-01, 0.2027450E-01,&
-0.2021000E-01, 0.2014550E-01, 0.2008100E-01, 0.2001650E-01, 0.1995200E-01,&
-0.1988750E-01, 0.1982300E-01, 0.1975850E-01, 0.1969400E-01, 0.1962950E-01,&
-0.1956500E-01, 0.1950050E-01, 0.1943600E-01, 0.1937150E-01, 0.1930700E-01,&
-0.1924250E-01, 0.1917800E-01, 0.1911350E-01, 0.1904900E-01, 0.1898450E-01,&
-0.1892000E-01, 0.1885550E-01, 0.1879100E-01, 0.1872650E-01, 0.1866200E-01,&
-0.1859750E-01, 0.1853300E-01, 0.1846850E-01, 0.1840400E-01, 0.1833950E-01,&
-0.1827500E-01, 0.1821050E-01, 0.1814600E-01, 0.1808150E-01, 0.1801700E-01,&
-0.1795250E-01, 0.1788800E-01, 0.1782350E-01, 0.1775900E-01, 0.1769450E-01,&
-0.1763000E-01, 0.1756550E-01, 0.1750100E-01, 0.1743650E-01, 0.1737200E-01,&
-0.1730750E-01, 0.1724300E-01, 0.1717850E-01, 0.1711400E-01, 0.1704950E-01,&
-0.1698500E-01, 0.1692050E-01, 0.1685600E-01, 0.1679150E-01, 0.1672700E-01,&
-0.1666250E-01, 0.1659800E-01, 0.1653350E-01, 0.1646900E-01, 0.1640450E-01,&
-0.1634000E-01, 0.1627550E-01, 0.1621100E-01, 0.1614650E-01, 0.1608200E-01,&
-0.1601750E-01, 0.1595300E-01, 0.1588850E-01, 0.1582400E-01, 0.1575950E-01,&
-0.1569500E-01, 0.1563050E-01, 0.1556600E-01, 0.1550150E-01, 0.1543700E-01,&
-0.1537250E-01, 0.1530800E-01, 0.1524350E-01, 0.1517900E-01, 0.1511450E-01,&
-0.1505000E-01, 0.1498550E-01, 0.1492100E-01, 0.1485650E-01, 0.1479200E-01,&
-0.1472750E-01, 0.1466300E-01, 0.1459850E-01, 0.1453400E-01, 0.1446950E-01,&
-0.1440500E-01, 0.1434050E-01, 0.1427600E-01, 0.1421150E-01, 0.1414700E-01,&
-0.1408250E-01, 0.1401800E-01, 0.1395350E-01, 0.1388900E-01, 0.1382450E-01,&
-0.1376000E-01, 0.1369550E-01, 0.1363100E-01, 0.1356650E-01, 0.1350200E-01,&
-0.1343750E-01, 0.1337300E-01, 0.1330850E-01, 0.1324400E-01, 0.1317950E-01,&
-0.1311500E-01, 0.1305050E-01, 0.1298600E-01, 0.1292150E-01, 0.1285700E-01,&
-0.1279250E-01, 0.1272800E-01, 0.1266350E-01, 0.1259900E-01, 0.1253450E-01,&
-0.1247000E-01, 0.1240550E-01, 0.1234100E-01, 0.1227650E-01, 0.1221200E-01,&
-0.1214750E-01, 0.1208300E-01, 0.1201850E-01, 0.1195400E-01, 0.1188950E-01,&
-0.1182500E-01, 0.1176050E-01, 0.1169600E-01, 0.1163150E-01, 0.1156700E-01,&
-0.1150250E-01, 0.1143800E-01, 0.1137350E-01, 0.1130900E-01, 0.1124450E-01,&
-0.1118000E-01, 0.1111550E-01, 0.1105100E-01, 0.1098650E-01, 0.1092200E-01,&
-0.1085750E-01, 0.1079300E-01, 0.1072850E-01, 0.1066400E-01, 0.1059950E-01,&
-0.1053500E-01, 0.1047050E-01, 0.1040600E-01, 0.1034150E-01, 0.1027700E-01,&
-0.1021250E-01, 0.1014800E-01, 0.1008350E-01, 0.1001900E-01, 0.9954500E-02,&
-0.9890000E-02, 0.9825500E-02, 0.9761000E-02, 0.9696500E-02, 0.9632000E-02,&
-0.9567500E-02, 0.9503000E-02, 0.9438500E-02, 0.9374000E-02, 0.9309500E-02,&
-0.9245000E-02, 0.9180500E-02, 0.9116000E-02, 0.9051500E-02, 0.8987000E-02,&
-0.8922500E-02, 0.8858000E-02, 0.8793500E-02, 0.8729000E-02, 0.8664500E-02,&
-0.8600000E-02, 0.8535500E-02, 0.8471000E-02, 0.8406500E-02, 0.8342000E-02,&
-0.8277500E-02, 0.8213000E-02, 0.8148500E-02, 0.8084000E-02, 0.8019500E-02,&
-0.7955000E-02, 0.7890500E-02, 0.7826000E-02, 0.7761500E-02, 0.7697000E-02,&
-0.7632500E-02, 0.7568000E-02, 0.7503500E-02, 0.7439000E-02, 0.7374500E-02,&
-0.7310000E-02, 0.7245500E-02, 0.7181000E-02, 0.7116500E-02, 0.7052000E-02,&
-0.6987500E-02, 0.6923000E-02, 0.6858500E-02, 0.6794000E-02, 0.6729500E-02,&
-0.6665000E-02, 0.6600500E-02, 0.6536000E-02, 0.6471500E-02, 0.6407000E-02,&
-0.6342500E-02, 0.6278000E-02, 0.6213500E-02, 0.6149000E-02, 0.6084500E-02,&
-0.6020000E-02, 0.5955500E-02, 0.5891000E-02, 0.5826500E-02, 0.5762000E-02,&
-0.5697500E-02, 0.5633000E-02, 0.5568500E-02, 0.5504000E-02, 0.5439500E-02,&
-0.5375000E-02, 0.5310500E-02, 0.5246000E-02, 0.5181500E-02, 0.5117000E-02,&
-0.5052500E-02, 0.4988000E-02, 0.4923500E-02, 0.4859000E-02, 0.4794500E-02,&
-0.4730000E-02, 0.4665500E-02, 0.4601000E-02, 0.4536500E-02, 0.4472000E-02,&
-0.4407500E-02, 0.4343000E-02, 0.4278500E-02, 0.4214000E-02, 0.4149500E-02,&
-0.4085000E-02, 0.4020500E-02, 0.3956000E-02, 0.3891500E-02, 0.3827000E-02,&
-0.3762500E-02, 0.3698000E-02, 0.3633500E-02, 0.3569000E-02, 0.3504500E-02,&
-0.3440000E-02, 0.3375500E-02, 0.3311000E-02, 0.3246500E-02, 0.3182000E-02,&
-0.3117500E-02, 0.3053000E-02, 0.2988500E-02, 0.2924000E-02, 0.2859500E-02,&
-0.2795000E-02, 0.2730500E-02, 0.2666000E-02, 0.2601500E-02, 0.2537000E-02,&
-0.2472500E-02, 0.2408000E-02, 0.2343500E-02, 0.2279000E-02, 0.2214500E-02,&
-0.2150000E-02 /)
-
-REAL, PARAMETER, DIMENSION(NNWL)::  XAKACHL2= &
-(/0.7745835E+00,  0.7522619E+00,  0.7299404E+00,  0.7076188E+00, 0.6852972E+00,&
-0.6629756E+00,  0.5767828E+00,  0.5011461E+00,  0.4285168E+00,  0.3946458E+00,&
-0.4330427E+00,  0.5309876E+00,  0.6371105E+00,  0.7297136E+00,  0.7904093E+00,&
-0.8097131E+00,  0.8760642E+00,  0.9381161E+00,  0.9457293E+00,  0.9258360E+00,&
-0.9025422E+00,  0.9252829E+00,  0.9270173E+00,  0.9995731E+00,  0.8171211E+00,&
-0.5353835E+00,  0.5329482E+00,  0.5348938E+00,  0.3804893E+00,  0.2089162E+00,&
-0.1108572E+00,  0.7056972E-01,  0.6340462E-01,  0.7044097E-01,  0.8182860E-01,&
-0.9896376E-01,  0.1267309E+00,  0.1598070E+00,  0.1993082E+00,  0.2502128E+00,&
-0.3026099E+00,  0.3196909E+00,  0.2917686E+00,  0.2666667E+00,  0.3314760E+00,&
-0.5711130E+00,  0.7452133E+00,  0.5497976E+00,  0.2406984E+00,  0.1315954E+00,&
-0.1197734E+00,  0.1258391E+00,  0.1367452E+00,  0.1552781E+00,  0.1936057E+00,&
-0.2571016E+00,  0.3363165E+00,  0.4064784E+00,  0.4289439E+00,  0.3819179E+00,&
-0.2987019E+00,  0.2160145E+00,  0.1343931E+00,  0.6321464E-01,  0.2241001E-01,&
-0.5134957E-02, -0.1242093E-02, -0.2531676E-02, -0.4085609E-02, -0.4713067E-02,&
--0.5693497E-02, -0.1090849E-01, -0.1407841E-01, -0.1816251E-01, -0.2587014E-01,&
--0.3565745E-01, -0.4546714E-01, -0.5446691E-01, -0.5650476E-01, -0.5981312E-01,&
--0.5981312E-01, -0.6451318E-01, -0.4835265E-01, -0.4864828E-01, -0.4876773E-01,&
--0.4840301E-01, -0.4866588E-01, -0.4836091E-01, -0.4851014E-01, -0.4860595E-01,&
--0.4852568E-01, -0.4805798E-01, -0.4859427E-01, -0.4795901E-01, -0.4846919E-01,&
--0.4850669E-01, -0.4854093E-01, -0.4849193E-01, -0.4841270E-01, -0.4855558E-01,&
--0.4827924E-01, -0.4906723E-01, -0.4822920E-01, -0.4818162E-01, -0.4854826E-01,&
--0.4875536E-01, -0.4863250E-01, -0.4843162E-01, -0.4836087E-01, -0.4913286E-01,&
--0.4884187E-01, -0.4864121E-01, -0.4865143E-01, -0.4821299E-01, -0.4880581E-01,&
--0.4887014E-01, -0.4868441E-01, -0.4861962E-01, -0.4806854E-01, -0.4918258E-01,&
--0.4813463E-01, -0.4876416E-01, -0.4831872E-01, -0.4867297E-01, -0.4862849E-01,&
--0.4836460E-01, -0.4858448E-01, -0.4886762E-01, -0.4875397E-01, -0.4863992E-01,&
--0.4862744E-01, -0.4887019E-01, -0.4816946E-01, -0.4892569E-01, -0.4864310E-01,&
--0.4881326E-01, -0.4819329E-01, -0.4852681E-01, -0.4803719E-01, -0.4831237E-01,&
--0.4866472E-01, -0.4815419E-01, -0.4873738E-01, -0.4851730E-01, -0.4848577E-01,&
--0.4881878E-01, -0.4878175E-01, -0.4839409E-01, -0.4850954E-01, -0.4846783E-01,&
--0.4847389E-01, -0.4833271E-01, -0.4859281E-01, -0.4863393E-01, -0.4839972E-01,&
--0.4851298E-01, -0.4831513E-01, -0.4842690E-01, -0.4784760E-01, -0.4914954E-01,&
--0.4866549E-01, -0.4890948E-01, -0.4834954E-01, -0.4830681E-01, -0.4859897E-01,&
--0.4838582E-01, -0.4851704E-01, -0.4866422E-01, -0.4881537E-01, -0.4851842E-01,&
--0.4877209E-01, -0.4873482E-01, -0.4825956E-01, -0.4852063E-01, -0.4867407E-01,&
--0.4878135E-01, -0.4830102E-01, -0.4826979E-01, -0.4870005E-01, -0.4902764E-01,&
--0.4871316E-01, -0.4853799E-01, -0.4867663E-01, -0.4823785E-01, -0.4855946E-01,&
--0.4875993E-01, -0.4846177E-01, -0.4886679E-01, -0.4859700E-01, -0.4809872E-01,&
--0.4822881E-01, -0.4837712E-01, -0.4855768E-01, -0.4867230E-01, -0.4838317E-01,&
--0.4876311E-01, -0.4812689E-01, -0.4820772E-01, -0.4904227E-01, -0.4871970E-01,&
--0.4853304E-01, -0.4859587E-01, -0.4845879E-01, -0.4837155E-01, -0.4874718E-01,&
--0.4873789E-01, -0.4851343E-01, -0.4851316E-01, -0.4901856E-01, -0.4836449E-01,&
--0.4880954E-01, -0.4853077E-01, -0.4898909E-01, -0.4812662E-01, -0.4832583E-01,&
--0.4847423E-01, -0.4846226E-01, -0.4844360E-01, -0.4835512E-01, -0.4893025E-01,&
--0.4853777E-01, -0.4873621E-01, -0.4832436E-01, -0.4854396E-01, -0.4848187E-01,&
--0.4850079E-01, -0.4843526E-01, -0.4818938E-01, -0.4874043E-01, -0.4847353E-01,&
--0.4865320E-01, -0.4853667E-01, -0.4859223E-01, -0.4872705E-01, -0.4821515E-01,&
--0.4844453E-01, -0.4870005E-01, -0.4881809E-01, -0.4865348E-01, -0.4871232E-01,&
--0.4859998E-01, -0.4833980E-01, -0.4860161E-01, -0.4839900E-01, -0.4853466E-01,&
--0.4864573E-01, -0.4863669E-01, -0.4901951E-01, -0.4832310E-01, -0.4890333E-01,&
--0.4880714E-01, -0.4855986E-01, -0.4852934E-01, -0.4818182E-01, -0.4795438E-01,&
--0.4834752E-01, -0.4810626E-01, -0.4861891E-01, -0.4872801E-01, -0.4814039E-01,&
--0.4894429E-01, -0.4881275E-01, -0.4903332E-01, -0.4835438E-01, -0.4865217E-01,&
--0.4853667E-01, -0.4841790E-01, -0.4869760E-01, -0.4900452E-01, -0.4856053E-01,&
--0.4825166E-01, -0.4837719E-01, -0.4872088E-01, -0.4873605E-01, -0.4868101E-01,&
--0.4883375E-01, -0.4870022E-01, -0.4875332E-01, -0.4836111E-01, -0.4863061E-01,&
--0.4875719E-01, -0.4874192E-01, -0.4847357E-01, -0.4867528E-01, -0.4836407E-01,&
--0.4828474E-01, -0.4860063E-01, -0.4861546E-01, -0.4864795E-01, -0.4844943E-01,&
--0.4904242E-01, -0.4843469E-01, -0.4866992E-01, -0.4900254E-01, -0.4864337E-01,&
--0.4844130E-01, -0.4837940E-01, -0.4855977E-01, -0.4874923E-01, -0.4906257E-01,&
--0.4864537E-01, -0.4834532E-01, -0.4869347E-01, -0.4858449E-01, -0.4877963E-01,&
--0.4863986E-01, -0.4848931E-01, -0.4836552E-01, -0.4849740E-01, -0.4887220E-01,&
--0.4904565E-01, -0.4872388E-01, -0.4810480E-01, -0.4806256E-01, -0.4874242E-01,&
--0.4819115E-01, -0.4862189E-01, -0.4871701E-01, -0.4839065E-01, -0.4877597E-01,&
--0.4905847E-01, -0.4861049E-01, -0.4812144E-01, -0.4872767E-01, -0.4891870E-01,&
--0.4890406E-01, -0.4818467E-01, -0.4847043E-01, -0.4841457E-01, -0.4821321E-01,&
--0.4847127E-01, -0.4868549E-01, -0.4910397E-01, -0.4863713E-01, -0.4831791E-01,&
--0.4807175E-01, -0.4877013E-01, -0.4882632E-01, -0.4808306E-01, -0.4848078E-01,&
--0.4849469E-01, -0.4864521E-01, -0.4823979E-01, -0.4866831E-01, -0.4870176E-01,&
--0.4837111E-01, -0.4899544E-01, -0.4904284E-01, -0.4913362E-01, -0.4821655E-01,&
--0.4833322E-01, -0.4831560E-01, -0.4840073E-01, -0.4852060E-01, -0.4897843E-01,&
--0.4829322E-01, -0.4884781E-01, -0.4827255E-01, -0.4827960E-01, -0.4864042E-01,&
--0.4828514E-01, -0.4897902E-01, -0.4855954E-01, -0.4855975E-01, -0.4858216E-01,&
--0.4827806E-01, -0.4847189E-01, -0.4860275E-01, -0.4906456E-01, -0.4853636E-01,&
--0.4862808E-01, -0.4848551E-01, -0.4869109E-01, -0.4848604E-01, -0.4866388E-01,&
--0.4846765E-01, -0.4875867E-01, -0.4807435E-01, -0.4867530E-01, -0.4888080E-01,&
--0.4844930E-01 /)
-
-
-
-
-
-
-
-!
-! table of seawater absorption coefficient as function of wavelength
-REAL, PARAMETER, DIMENSION(NNWL)::  XAKAW3= &
-(/0.3067439E+01, 0.1993737E+01, 0.1309263E+01, 0.9275307E+00, 0.7183294E+00,&
-0.5608010E+00, 0.4552411E+00, 0.3738498E+00, 0.2879400E+00, 0.2145172E+00,&
-0.1415658E+00, 0.1048958E+00, 0.8411996E-01, 0.6814662E-01, 0.5585442E-01,&
-0.4638546E-01, 0.3791143E-01, 0.2984669E-01, 0.2234093E-01, 0.1870175E-01,&
-0.1737227E-01, 0.1609624E-01, 0.1530537E-01, 0.1443961E-01, 0.1437088E-01,&
-0.1480803E-01, 0.1517563E-01, 0.1592806E-01, 0.1743279E-01, 0.1967369E-01,&
-0.2564243E-01, 0.3598580E-01, 0.4703195E-01, 0.5145027E-01, 0.5534469E-01,&
-0.6400512E-01, 0.7030880E-01, 0.8172981E-01, 0.1033439E+00, 0.1638825E+00,&
-0.2387544E+00, 0.2908335E+00, 0.3086321E+00, 0.3193000E+00, 0.3277702E+00,&
-0.3523264E+00, 0.3957919E+00, 0.4326377E+00, 0.4485145E+00, 0.5016078E+00,&
-0.6481431E+00, 0.8408502E+00, 0.1165249E+01, 0.1810640E+01, 0.2364421E+01,&
-0.2479177E+01, 0.2547112E+01, 0.2511108E+01, 0.2356959E+01, 0.2164139E+01,&
-0.2068389E+01, 0.2334173E+01, 0.3101571E+01, 0.3715746E+01, 0.4069374E+01,&
-0.4055130E+01, 0.3662220E+01, 0.3265983E+01, 0.3338288E+01, 0.4351006E+01,&
-0.6776006E+01, 0.1092508E+02, 0.1646968E+02, 0.2292120E+02, 0.2979101E+02,&
-0.3659049E+02, 0.4255537E+02, 0.4581877E+02, 0.4488433E+02, 0.4084045E+02,&
-0.3542173E+02, 0.3008784E+02, 0.2519888E+02, 0.2084002E+02, 0.1709645E+02,&
-0.1405336E+02, 0.1179592E+02, 0.1051821E+02, 0.1084989E+02, 0.1352949E+02,&
-0.1929556E+02, 0.2856379E+02, 0.4045844E+02, 0.5378094E+02, 0.6733270E+02,&
-0.7991512E+02, 0.9045451E+02, 0.9837671E+02, 0.1032324E+03, 0.1045724E+03,&
-0.1024582E+03, 0.9870555E+02, 0.9448188E+02, 0.9066481E+02, 0.8813195E+02,&
-0.8776093E+02, 0.9009315E+02, 0.9432506E+02, 0.9931691E+02, 0.1039289E+03,&
-0.1070213E+03, 0.1091415E+03, 0.1175854E+03, 0.1413362E+03, 0.1893769E+03,&
-0.2706907E+03, 0.3927593E+03, 0.5570592E+03, 0.7635654E+03, 0.1012253E+04,&
-0.1303097E+04, 0.1629710E+04, 0.1960254E+04, 0.2256530E+04, 0.2480335E+04,&
-0.2593472E+04, 0.2570322E+04, 0.2435603E+04, 0.2226617E+04, 0.1980665E+04,&
-0.1735048E+04, 0.1520186E+04, 0.1338970E+04, 0.1187410E+04, 0.1061517E+04,&
-0.9572996E+03, 0.8707689E+03, 0.7979346E+03, 0.7348066E+03, 0.6773950E+03,&
-0.6217097E+03, 0.5658621E+03, 0.5163686E+03, 0.4818471E+03, 0.4709154E+03,&
-0.4921914E+03, 0.5339673E+03, 0.5283995E+03, 0.4879842E+03, 0.4503842E+03,&
-0.4532622E+03, 0.5219655E+03, 0.6325787E+03, 0.7488713E+03, 0.8346125E+03,&
-0.8535717E+03, 0.7823218E+03, 0.6486514E+03, 0.4931527E+03, 0.3564180E+03,&
-0.2790396E+03, 0.2973530E+03, 0.4306661E+03, 0.6940303E+03, 0.1102497E+04,&
-0.1671116E+04, 0.2414941E+04, 0.3349021E+04, 0.4488408E+04, 0.5848154E+04,&
-0.7443309E+04, 0.9216590E+04, 0.1082137E+05, 0.1183869E+05, 0.1184960E+05,&
-0.1078493E+05, 0.9686200E+04, 0.8790378E+04, 0.8045845E+04, 0.7400985E+04,&
-0.6804181E+04, 0.6214741E+04, 0.5635665E+04, 0.5080881E+04, 0.4564313E+04,&
-0.4099888E+04, 0.3697940E+04, 0.3354440E+04, 0.3061767E+04, 0.2812299E+04,&
-0.2598416E+04, 0.2413350E+04, 0.2253741E+04, 0.2117085E+04, 0.2000874E+04,&
-0.1902603E+04, 0.1819767E+04, 0.1749858E+04, 0.1690372E+04, 0.1638801E+04,&
-0.1592640E+04, 0.1555394E+04, 0.1548293E+04, 0.1573317E+04, 0.1626133E+04,&
-0.1702405E+04, 0.1797857E+04, 0.1908438E+04, 0.2030156E+04, 0.2159016E+04,&
-0.2291026E+04, 0.2423482E+04, 0.2558843E+04, 0.2700856E+04, 0.2853272E+04,&
-0.3019837E+04, 0.3204129E+04, 0.3409039E+04, 0.3637285E+04, 0.3891587E+04,&
-0.4174664E+04, 0.4489235E+04, 0.4838020E+04, 0.5223737E+04, 0.5649106E+04,&
-0.6116846E+04, 0.6622627E+04, 0.7133928E+04, 0.7611180E+04, 0.8014812E+04,&
-0.8305254E+04, 0.8466704E+04, 0.8578431E+04, 0.8743467E+04, 0.9064849E+04,&
-0.9645611E+04, 0.1051240E+05, 0.1138630E+05, 0.1191200E+05, 0.1173420E+05,&
-0.1049759E+05, 0.8305364E+04, 0.7094721E+04, 0.9142031E+04, 0.1397930E+05,&
-0.1839416E+05, 0.1986234E+05, 0.1908920E+05, 0.1758752E+05, 0.1687005E+05,&
-0.1844957E+05, 0.2383885E+05, 0.3455066E+05, 0.5209777E+05, 0.7799295E+05,&
-0.1137490E+06, 0.1602886E+06, 0.2161751E+06, 0.2793814E+06, 0.3478807E+06,&
-0.4196461E+06, 0.4928405E+06, 0.5663854E+06, 0.6393920E+06, 0.7109715E+06,&
-0.7802351E+06, 0.8462941E+06, 0.9082596E+06, 0.9652429E+06, 0.1016355E+07,&
-0.1060708E+07, 0.1097549E+07, 0.1126679E+07, 0.1148035E+07, 0.1161554E+07,&
-0.1167173E+07, 0.1164996E+07, 0.1155796E+07, 0.1140514E+07, 0.1120088E+07,&
-0.1095461E+07, 0.1067479E+07, 0.1036628E+07, 0.1003298E+07, 0.9678839E+06,&
-0.9307769E+06, 0.8923695E+06, 0.8530543E+06, 0.8132238E+06, 0.7732703E+06,&
-0.7335864E+06, 0.6945089E+06, 0.6561521E+06, 0.6185746E+06, 0.5818354E+06,&
-0.5459929E+06, 0.5111060E+06, 0.4772333E+06, 0.4444336E+06, 0.4127655E+06,&
-0.3822878E+06, 0.3530592E+06, 0.3251383E+06, 0.2985839E+06, 0.2734547E+06,&
-0.2498094E+06, 0.2277067E+06, 0.2072053E+06, 0.1883639E+06, 0.1712413E+06,&
-0.1558960E+06, 0.1423474E+06, 0.1304565E+06, 0.1200447E+06, 0.1109338E+06,&
-0.1029451E+06, 0.9590033E+05, 0.8962092E+05, 0.8392845E+05, 0.7864446E+05,&
-0.7359050E+05, 0.6862405E+05, 0.6374646E+05, 0.5899502E+05, 0.5440700E+05,&
-0.5001969E+05, 0.4587039E+05, 0.4199638E+05, 0.3843495E+05, 0.3522339E+05,&
-0.3239897E+05, 0.2998538E+05, 0.2795181E+05, 0.2625384E+05, 0.2484704E+05,&
-0.2368700E+05, 0.2272929E+05, 0.2192950E+05, 0.2124319E+05, 0.2062596E+05,&
-0.2003338E+05, 0.1942931E+05, 0.1881074E+05, 0.1818297E+05, 0.1755126E+05,&
-0.1692090E+05, 0.1629717E+05, 0.1568535E+05, 0.1509072E+05, 0.1451856E+05,&
-0.1397415E+05, 0.1346277E+05, 0.1298970E+05, 0.1256022E+05, 0.1217961E+05,&
-0.1185315E+05, 0.1158473E+05, 0.1137272E+05, 0.1121409E+05, 0.1110580E+05,&
-0.1104483E+05, 0.1102816E+05, 0.1105274E+05, 0.1111556E+05, 0.1121359E+05,&
-0.1134380E+05, 0.1150316E+05, 0.1168864E+05, 0.1189722E+05, 0.1212586E+05,&
-0.1237155E+05, 0.1263124E+05, 0.1290192E+05, 0.1318056E+05, 0.1346412E+05,&
-0.1374958E+05, 0.1403392E+05, 0.1431409E+05, 0.1458709E+05, 0.1484987E+05,&
-0.1509941E+05 /)
-
-
-
-!
-! table of seawater backscattering coefficient as function of wavelength
-REAL, PARAMETER, DIMENSION(NNWL)::  XAKBW= &
-(/0.1510000E+00, 0.1190000E+00, 0.9950015E-01, 0.8199944E-01, 0.6850207E-01,&
-0.5749506E-01, 0.4850663E-01, 0.4149505E-01, 0.3530210E-01, 0.3049935E-01,&
-0.2620052E-01, 0.2289856E-01, 0.2000336E-01, 0.1749553E-01, 0.1530325E-01,&
-0.1339897E-01, 0.1199900E-01, 0.1060502E-01, 0.9387780E-02, 0.8416411E-02,&
-0.7587748E-02, 0.6805146E-02, 0.6098530E-02, 0.5500733E-02, 0.4898538E-02,&
-0.4503288E-02, 0.4095613E-02, 0.3703303E-02, 0.3398477E-02, 0.3100964E-02,&
-0.2897666E-02, 0.2608371E-02, 0.2380034E-02, 0.2226757E-02, 0.2080041E-02,&
-0.1908345E-02, 0.1797763E-02, 0.1700603E-02, 0.1599833E-02, 0.1500036E-02,&
-0.1400066E-02, 0.1299673E-02, 0.1201250E-02, 0.1095326E-02, 0.1017446E-02,&
-0.9582712E-03, 0.8559384E-03, 0.7582711E-03, 0.7174466E-03, 0.6953252E-03,&
-0.7012525E-03, 0.6996646E-03, 0.6000893E-03, 0.5999768E-03, 0.6000058E-03,&
-0.4999986E-03, 0.5000004E-03, 0.4999999E-03, 0.4000000E-03, 0.4000000E-03,&
-0.4000000E-03, 0.4000000E-03, 0.3987586E-03, 0.3975172E-03, 0.3962759E-03,&
-0.3950345E-03, 0.3937931E-03, 0.3925517E-03, 0.3913103E-03, 0.3900690E-03,&
-0.3888276E-03, 0.3875862E-03, 0.3863448E-03, 0.3851035E-03, 0.3838621E-03,&
-0.3826207E-03, 0.3813793E-03, 0.3801379E-03, 0.3788965E-03, 0.3776552E-03,&
-0.3764138E-03, 0.3751724E-03, 0.3739310E-03, 0.3726897E-03, 0.3714483E-03,&
-0.3702069E-03, 0.3689655E-03, 0.3677241E-03, 0.3664828E-03, 0.3652414E-03,&
-0.3640000E-03, 0.3627586E-03, 0.3615172E-03, 0.3602759E-03, 0.3590345E-03,&
-0.3577931E-03, 0.3565517E-03, 0.3553103E-03, 0.3540690E-03, 0.3528276E-03,&
-0.3515862E-03, 0.3503448E-03, 0.3491034E-03, 0.3478621E-03, 0.3466207E-03,&
-0.3453793E-03, 0.3441379E-03, 0.3428966E-03, 0.3416552E-03, 0.3404138E-03,&
-0.3391724E-03, 0.3379310E-03, 0.3366896E-03, 0.3354483E-03, 0.3342069E-03,&
-0.3329655E-03, 0.3317241E-03, 0.3304828E-03, 0.3292414E-03, 0.3280000E-03,&
-0.3267586E-03, 0.3255172E-03, 0.3242759E-03, 0.3230345E-03, 0.3217931E-03,&
-0.3205517E-03, 0.3193103E-03, 0.3180690E-03, 0.3168276E-03, 0.3155862E-03,&
-0.3143448E-03, 0.3131035E-03, 0.3118621E-03, 0.3106207E-03, 0.3093793E-03,&
-0.3081379E-03, 0.3068965E-03, 0.3056552E-03, 0.3044138E-03, 0.3031724E-03,&
-0.3019310E-03, 0.3006897E-03, 0.2994483E-03, 0.2982069E-03, 0.2969655E-03,&
-0.2957241E-03, 0.2944828E-03, 0.2932414E-03, 0.2920000E-03, 0.2907586E-03,&
-0.2895173E-03, 0.2882759E-03, 0.2870345E-03, 0.2857931E-03, 0.2845517E-03,&
-0.2833103E-03, 0.2820690E-03, 0.2808276E-03, 0.2795862E-03, 0.2783448E-03,&
-0.2771034E-03, 0.2758621E-03, 0.2746207E-03, 0.2733793E-03, 0.2721379E-03,&
-0.2708966E-03, 0.2696552E-03, 0.2684138E-03, 0.2671724E-03, 0.2659310E-03,&
-0.2646896E-03, 0.2634483E-03, 0.2622069E-03, 0.2609655E-03, 0.2597241E-03,&
-0.2584828E-03, 0.2572414E-03, 0.2560000E-03, 0.2547586E-03, 0.2535172E-03,&
-0.2522759E-03, 0.2510345E-03, 0.2497931E-03, 0.2485517E-03, 0.2473104E-03,&
-0.2460690E-03, 0.2448276E-03, 0.2435862E-03, 0.2423448E-03, 0.2411035E-03,&
-0.2398621E-03, 0.2386207E-03, 0.2373793E-03, 0.2361379E-03, 0.2348965E-03,&
-0.2336552E-03, 0.2324138E-03, 0.2311724E-03, 0.2299310E-03, 0.2286896E-03,&
-0.2274483E-03, 0.2262069E-03, 0.2249655E-03, 0.2237241E-03, 0.2224828E-03,&
-0.2212414E-03, 0.2200000E-03, 0.2187586E-03, 0.2175172E-03, 0.2162759E-03,&
-0.2150345E-03, 0.2137931E-03, 0.2125517E-03, 0.2113103E-03, 0.2100690E-03,&
-0.2088276E-03, 0.2075862E-03, 0.2063448E-03, 0.2051035E-03, 0.2038621E-03,&
-0.2026207E-03, 0.2013793E-03, 0.2001379E-03, 0.1988966E-03, 0.1976552E-03,&
-0.1964138E-03, 0.1951724E-03, 0.1939310E-03, 0.1926897E-03, 0.1914483E-03,&
-0.1902069E-03, 0.1889655E-03, 0.1877241E-03, 0.1864828E-03, 0.1852414E-03,&
-0.1840000E-03, 0.1827586E-03, 0.1815172E-03, 0.1802759E-03, 0.1790345E-03,&
-0.1777931E-03, 0.1765517E-03, 0.1753103E-03, 0.1740690E-03, 0.1728276E-03,&
-0.1715862E-03, 0.1703448E-03, 0.1691034E-03, 0.1678621E-03, 0.1666207E-03,&
-0.1653793E-03, 0.1641379E-03, 0.1628966E-03, 0.1616552E-03, 0.1604138E-03,&
-0.1591724E-03, 0.1579310E-03, 0.1566897E-03, 0.1554483E-03, 0.1542069E-03,&
-0.1529655E-03, 0.1517241E-03, 0.1504828E-03, 0.1492414E-03, 0.1480000E-03,&
-0.1467586E-03, 0.1455172E-03, 0.1442759E-03, 0.1430345E-03, 0.1417931E-03,&
-0.1405517E-03, 0.1393103E-03, 0.1380690E-03, 0.1368276E-03, 0.1355862E-03,&
-0.1343448E-03, 0.1331034E-03, 0.1318621E-03, 0.1306207E-03, 0.1293793E-03,&
-0.1281379E-03, 0.1268966E-03, 0.1256552E-03, 0.1244138E-03, 0.1231724E-03,&
-0.1219310E-03, 0.1206897E-03, 0.1194483E-03, 0.1182069E-03, 0.1169655E-03,&
-0.1157241E-03, 0.1144828E-03, 0.1132414E-03, 0.1120000E-03, 0.1107586E-03,&
-0.1095172E-03, 0.1082759E-03, 0.1070345E-03, 0.1057931E-03, 0.1045517E-03,&
-0.1033103E-03, 0.1020690E-03, 0.1008276E-03, 0.9958621E-04, 0.9834483E-04,&
-0.9710345E-04, 0.9586207E-04, 0.9462069E-04, 0.9337931E-04, 0.9213793E-04,&
-0.9089655E-04, 0.8965517E-04, 0.8841379E-04, 0.8717241E-04, 0.8593103E-04,&
-0.8468966E-04, 0.8344828E-04, 0.8220690E-04, 0.8096552E-04, 0.7972414E-04,&
-0.7848276E-04, 0.7724138E-04, 0.7600000E-04, 0.7475862E-04, 0.7351724E-04,&
-0.7227586E-04, 0.7103448E-04, 0.6979310E-04, 0.6855172E-04, 0.6731034E-04,&
-0.6606896E-04, 0.6482759E-04, 0.6358621E-04, 0.6234483E-04, 0.6110345E-04,&
-0.5986207E-04, 0.5862069E-04, 0.5737931E-04, 0.5613793E-04, 0.5489655E-04,&
-0.5365517E-04, 0.5241379E-04, 0.5117241E-04, 0.4993103E-04, 0.4868966E-04,&
-0.4744828E-04, 0.4620690E-04, 0.4496552E-04, 0.4372414E-04, 0.4248276E-04,&
-0.4124138E-04, 0.4000000E-04, 0.3875862E-04, 0.3751724E-04, 0.3627586E-04,&
-0.3503448E-04, 0.3379311E-04, 0.3255172E-04, 0.3131034E-04, 0.3006897E-04,&
-0.2882759E-04, 0.2758621E-04, 0.2634483E-04, 0.2510345E-04, 0.2386207E-04,&
-0.2262069E-04, 0.2137931E-04, 0.2013793E-04, 0.1889655E-04, 0.1765517E-04,&
-0.1641379E-04, 0.1517241E-04, 0.1393103E-04, 0.1268965E-04, 0.1144828E-04,&
-0.1020690E-04, 0.8965517E-05, 0.7724138E-05, 0.6482759E-05, 0.5241379E-05,&
-0.4000000E-05 /)
-
-! white-caps reflectance (Koepke and Whitlock)
-! Whitlock fit varid 400nm - 2.4nm. set albedo 0 otherwise 
-REAL, PARAMETER, DIMENSION(NNWL)::  XRWC   = &
-(/0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.1986623E+00, 0.1968392E+00, 0.1955961E+00, 0.1941208E+00, 0.1939980E+00,&
-0.1947642E+00, 0.1953830E+00, 0.1965826E+00, 0.1987437E+00, 0.2014820E+00,&
-0.2068586E+00, 0.2125197E+00, 0.2160829E+00, 0.2171109E+00, 0.2178881E+00,&
-0.2192886E+00, 0.2200949E+00, 0.2212391E+00, 0.2227055E+00, 0.2247944E+00,&
-0.2262073E+00, 0.2270383E+00, 0.2273185E+00, 0.2274869E+00, 0.2276210E+00,&
-0.2280129E+00, 0.2287211E+00, 0.2293381E+00, 0.2296089E+00, 0.2305354E+00,&
-0.2332379E+00, 0.2370188E+00, 0.2373674E+00, 0.2314480E+00, 0.2291741E+00,&
-0.2288465E+00, 0.2286684E+00, 0.2287614E+00, 0.2291967E+00, 0.2298426E+00,&
-0.2302154E+00, 0.2292666E+00, 0.2275362E+00, 0.2266957E+00, 0.2263213E+00,&
-0.2263353E+00, 0.2267580E+00, 0.2272800E+00, 0.2271755E+00, 0.2260595E+00,&
-0.2243821E+00, 0.2219912E+00, 0.2188027E+00, 0.2151597E+00, 0.2114653E+00,&
-0.2080255E+00, 0.2051811E+00, 0.2036894E+00, 0.2041120E+00, 0.2059829E+00,&
-0.2086015E+00, 0.2113106E+00, 0.2139111E+00, 0.2163195E+00, 0.2184435E+00,&
-0.2201926E+00, 0.2214916E+00, 0.2222242E+00, 0.2220343E+00, 0.2204943E+00,&
-0.2171906E+00, 0.2121093E+00, 0.2061633E+00, 0.2002262E+00, 0.1948388E+00,&
-0.1903174E+00, 0.1868275E+00, 0.1843590E+00, 0.1829052E+00, 0.1825115E+00,&
-0.1831341E+00, 0.1842591E+00, 0.1855570E+00, 0.1867604E+00, 0.1875755E+00,&
-0.1876960E+00, 0.1869431E+00, 0.1856059E+00, 0.1840741E+00, 0.1827001E+00,&
-0.1818000E+00, 0.1811922E+00, 0.1788437E+00, 0.1727826E+00, 0.1624180E+00,&
-0.1487052E+00, 0.1334511E+00, 0.1185638E+00, 0.1049801E+00, 0.9298412E-01,&
-0.8257660E-01, 0.7379698E-01, 0.6696978E-01, 0.6208307E-01, 0.5897739E-01,&
-0.5756657E-01, 0.5784728E-01, 0.5956322E-01, 0.6253327E-01, 0.6660015E-01,&
-0.7143353E-01, 0.7647427E-01, 0.8148541E-01, 0.8635699E-01, 0.9099500E-01,&
-0.9533520E-01, 0.9935633E-01, 0.1030906E+00, 0.1066306E+00, 0.1101345E+00,&
-0.1138333E+00, 0.1178890E+00, 0.1218228E+00, 0.1247853E+00, 0.1257652E+00,&
-0.1238772E+00, 0.1203841E+00, 0.1208343E+00, 0.1242444E+00, 0.1276640E+00,&
-0.1273930E+00, 0.1213602E+00, 0.1130860E+00, 0.1058152E+00, 0.1011666E+00,&
-0.1002071E+00, 0.1039381E+00, 0.1120040E+00, 0.1237937E+00, 0.1375058E+00,&
-0.1474928E+00, 0.1449352E+00, 0.1295643E+00, 0.1090889E+00, 0.8941860E-01,&
-0.7284467E-01, 0.5983944E-01, 0.5022947E-01, 0.4366299E-01, 0.3977196E-01,&
-0.3822227E-01, 0.3867308E-01, 0.4026759E-01, 0.4166813E-01, 0.4168444E-01,&
-0.4022229E-01, 0.3904642E-01, 0.3841435E-01, 0.3817649E-01, 0.3823472E-01,&
-0.3855810E-01, 0.3919018E-01, 0.4018588E-01, 0.4157600E-01, 0.4335490E-01,&
-0.4545942E-01, 0.4776782E-01, 0.5018748E-01, 0.5264894E-01, 0.5509888E-01,&
-0.5750712E-01, 0.5986086E-01, 0.6212466E-01, 0.6426051E-01, 0.6623940E-01,&
-0.6804333E-01, 0.6966664E-01, 0.7111643E-01, 0.7241227E-01, 0.7358521E-01,&
-0.7467659E-01, 0.7558735E-01, 0.7576417E-01, 0.7514564E-01, 0.7388073E-01,&
-0.7214532E-01, 0.7011285E-01, 0.6793264E-01, 0.6572567E-01, 0.6358425E-01,&
-0.6157472E-01, 0.5972482E-01, 0.5798797E-01, 0.5631501E-01, 0.5467161E-01,&
-0.5303634E-01, 0.5140076E-01, 0.4977145E-01, 0.4816243E-01, 0.4659231E-01,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
-0.0000000E+00 /)
-
-
-!
-!--------------------------------------------------------------------------------
-!
-END MODULE 
-
-
-
-
-
-
-
-
-
-
-
-
+link ../phylmd/ocean_albedo_para.F90
Index: LMDZ6/trunk/libf/phylmdiso/ocean_cpl_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ocean_cpl_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ocean_cpl_mod.F90	(revision 3940)
@@ -1,363 +1,1 @@
-!
-! $Id: ocean_cpl_mod.F90 3102 2017-12-03 20:27:42Z oboucher $
-!
-MODULE ocean_cpl_mod
-!
-! This module is used both for the sub-surface ocean and sea-ice for the case of a 
-! coupled model configuration, ocean=couple. 
-!
-
-  IMPLICIT NONE
-  PRIVATE
-
-  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
-
-
-!****************************************************************************************
-!
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
-!
-! Allocate fields for this module and initailize the module mod_cpl
-!
-    USE dimphy,           ONLY : klon
-    USE cpl_mod
-
-! Input arguments
-!*************************************************************************************
-    REAL, INTENT(IN)                  :: dtime
-    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
-
-! Local variables
-!*************************************************************************************
-    INTEGER              :: error
-    CHARACTER (len = 80) :: abort_message
-    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
-
-! Initialize module cpl_init
-    CALL cpl_init(dtime, rlon, rlat)
-    
-  END SUBROUTINE ocean_cpl_init
-!
-!****************************************************************************************
-!
-  SUBROUTINE ocean_cpl_noice( &
-       swnet, lwnet, alb1, &
-       windsp, fder_old, &
-       itime, dtime, knon, knindex, &
-       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, &
-       radsol, snow, agesno, &
-       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l)
-
-!
-! This subroutine treats the "open ocean", all grid points that are not entierly covered
-! by ice. The subroutine first receives fields from coupler, then some calculations at 
-! surface is done and finally it sends some fields to the coupler.
-!
-    USE dimphy,           ONLY : klon
-    USE cpl_mod
-    USE calcul_fluxs_mod
-    USE indice_sol_mod
-    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
-    USE cpl_mod,             ONLY : gath2cpl
-
-    INCLUDE "YOMCST.h"
-    INCLUDE "clesphys.h"
-!    
-! Input arguments  
-!****************************************************************************************
-    INTEGER, INTENT(IN)                      :: itime, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
-    REAL, INTENT(IN)                         :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
-    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
-    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
-    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
-    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
-    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
-    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)        :: ps
-    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
-
-! In/Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
-  
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
-  
-
-! Local variables
-!****************************************************************************************
-    INTEGER               :: i, j
-    INTEGER, DIMENSION(1) :: iloc
-    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
-    REAL, DIMENSION(klon) :: fder_new
-    REAL, DIMENSION(klon) :: tsurf_cpl
-    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
-    REAL, DIMENSION(klon) :: u1_lay, v1_lay
-    LOGICAL               :: check=.FALSE.
-    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol    
-    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
-
-! End definitions
-!****************************************************************************************
-
-    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
-
-!****************************************************************************************
-! Receive sea-surface temperature(tsurf_cpl) from coupler
-!
-!****************************************************************************************
-    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
-
-!****************************************************************************************
-! Calculate fluxes at surface
-!
-!****************************************************************************************
-    cal = 0.
-    beta = 1.
-    dif_grnd = 0.
-    agesno(:) = 0.
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
-    
-
-    DO i = 1, knon
-       u1_lay(i) = u1(i) - u0_cpl(i)
-       v1_lay(i) = v1(i) - v0_cpl(i)
-    END DO
-
-    CALL calcul_fluxs(knon, is_oce, dtime, &
-         tsurf_cpl, p1lay, cal, beta, cdragh, cdragq, ps, &
-         precip_rain, precip_snow, snow, qsurf,  &
-         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
-         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-    do j = 1, knon
-      i = knindex(j)
-      sens_prec_liq_o(i,1) = sens_prec_liq(j)
-      sens_prec_sol_o(i,1) = sens_prec_sol(j)
-      lat_prec_liq_o(i,1) = lat_prec_liq(j)
-      lat_prec_sol_o(i,1) = lat_prec_sol(j)
-    enddo
-
-
-    
-! - Flux calculation at first modele level for U and V
-    CALL calcul_flux_wind(knon, dtime, &
-         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)  
-
-!****************************************************************************************
-! Calculate fder : flux derivative (sensible and latente)
-!
-!****************************************************************************************
-    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
-    
-    iloc = MAXLOC(fder_new(1:klon))
-    IF (check .AND. fder_new(iloc(1))> 0.) THEN
-       WRITE(*,*)'**** Debug fder****'
-       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
-       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
-            dflux_s(iloc(1)), dflux_l(iloc(1))
-    ENDIF
-
-!****************************************************************************************
-! Send and cumulate fields to the coupler
-!
-!****************************************************************************************
-
-    CALL cpl_send_ocean_fields(itime, knon, knindex, &
-         swnet, lwnet, fluxlat, fluxsens, &
-         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp,&
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-    
-
-  END SUBROUTINE ocean_cpl_noice
-!
-!****************************************************************************************
-!
-  SUBROUTINE ocean_cpl_ice( &
-       rlon, rlat, swnet, lwnet, alb1, &
-       fder_old, &
-       itime, dtime, knon, knindex, &
-       lafin, &
-       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, pctsrf, &
-       radsol, snow, qsurf, &
-       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l)
-!
-! This subroutine treats the ocean where there is ice. The subroutine first receives 
-! fields from coupler, then some calculations at surface is done and finally sends 
-! some fields to the coupler.
-!    
-    USE dimphy,           ONLY : klon
-    USE cpl_mod
-    USE calcul_fluxs_mod
-    USE indice_sol_mod
-    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
-
-    INCLUDE "YOMCST.h"
-    INCLUDE "clesphys.h"
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                      :: itime, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
-    LOGICAL, INTENT(IN)                      :: lafin
-    REAL, INTENT(IN)                         :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
-    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
-    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
-    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
-    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
-    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)        :: ps
-    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
-
-! In/output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
-  
-
-! Local variables
-!****************************************************************************************
-    INTEGER                 :: i, j
-    INTEGER, DIMENSION(1)   :: iloc
-    LOGICAL                 :: check=.FALSE.
-    REAL, PARAMETER         :: t_grnd=271.35
-    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
-    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
-    REAL, DIMENSION(klon)   :: alb_cpl
-    REAL, DIMENSION(klon)   :: u0, v0
-    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
-    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol    
-    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
-
-! End definitions
-!****************************************************************************************
-    
-    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon 
-
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
-
-!****************************************************************************************
-! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
-!
-!****************************************************************************************
-
-    CALL cpl_receive_seaice_fields(knon, knindex, &
-         tsurf_cpl, alb_cpl, u0, v0)
-
-    alb1_new(1:knon) = alb_cpl(1:knon)
-    alb2_new(1:knon) = alb_cpl(1:knon)    
-
-    
-!****************************************************************************************
-! Calculate fluxes at surface
-!
-!****************************************************************************************
-    cal = 0.
-    dif_grnd = 0.
-    beta = 1.0
-    
-    DO i = 1, knon
-       u1_lay(i) = u1(i) - u0(i)
-       v1_lay(i) = v1(i) - v0(i)
-    END DO
-
-    CALL calcul_fluxs(knon, is_sic, dtime, &
-         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
-         precip_rain, precip_snow, snow, qsurf,  &
-         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
-         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-    do j = 1, knon
-      i = knindex(j)
-      sens_prec_liq_o(i,2) = sens_prec_liq(j)
-      sens_prec_sol_o(i,2) = sens_prec_sol(j)
-      lat_prec_liq_o(i,2) = lat_prec_liq(j)
-      lat_prec_sol_o(i,2) = lat_prec_sol(j)
-    enddo
-
-
-! - Flux calculation at first modele level for U and V
-    CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)  
-
-!****************************************************************************************
-! Calculate fder : flux derivative (sensible and latente)
-!
-!****************************************************************************************
-    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
-    
-    iloc = MAXLOC(fder_new(1:klon))
-    IF (check .AND. fder_new(iloc(1))> 0.) THEN
-       WRITE(*,*)'**** Debug fder ****'
-       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
-       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
-            dflux_s(iloc(1)), dflux_l(iloc(1))
-    ENDIF
-
-!****************************************************************************************
-! Send and cumulate fields to the coupler
-!
-!****************************************************************************************
-
-    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
-       pctsrf, lafin, rlon, rlat, &
-       swnet, lwnet, fluxlat, fluxsens, &
-       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
-       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-
- 
-
-  END SUBROUTINE ocean_cpl_ice
-!  
-!****************************************************************************************
-!
-END MODULE ocean_cpl_mod
+link ../phylmd/ocean_cpl_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/ocean_forced_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ocean_forced_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ocean_forced_mod.F90	(revision 3940)
@@ -19,8 +19,8 @@
        AcoefH, AcoefQ, BcoefH, BcoefQ, &
        AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, &
+       ps, u1, v1, gustiness, tsurf_in, &
        radsol, snow, agesno, & 
        qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l &
+       tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
 #ifdef ISO
             ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
@@ -40,4 +40,5 @@
     USE indice_sol_mod
     USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
+    use config_ocean_skin_m, only: activate_ocean_skin
 #ifdef ISO
   USE infotrac_phy, ONLY: ntraciso,niso
@@ -53,5 +54,5 @@
     INCLUDE "YOMCST.h"
     INCLUDE "clesphys.h"
-
+    INCLUDE "flux_arp.h"
 
 ! Input arguments
@@ -68,4 +69,7 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: ps
     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
+    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
+    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
+
 #ifdef ISO
     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
@@ -91,4 +95,6 @@
     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
+    REAL, intent(out):: sens_prec_liq(:) ! (knon)
+
 #ifdef ISO     
     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)    :: xtevap ! isotopes in evaporation flux
@@ -104,5 +110,5 @@
     REAL, DIMENSION(klon)       :: u1_lay, v1_lay
     LOGICAL                     :: check=.FALSE.
-    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol    
+    REAL sens_prec_sol(knon) 
     REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
 
@@ -139,9 +145,10 @@
 !!jyg    if (knon.eq.1) then ! single-column model
     if (klon_glo.eq.1) then ! single-column model
-      CALL read_tsurf1d(knon,tsurf_lim) ! new
-#ifdef ISO
-      write(*,*) 'ocean_forced_mod 143: isotopes pas prévus ici'
-      stop
-#endif
+      ! EV: now surface Tin flux_arp.h
+      !CALL read_tsurf1d(knon,tsurf_lim) ! new
+       DO i = 1, knon
+        tsurf_lim(i) = tg
+       ENDDO
+
     else ! GCM
       CALL limit_read_sst(knon,knindex,tsurf_lim &
@@ -159,10 +166,18 @@
 !****************************************************************************************
 ! Set some variables for calcul_fluxs
-    cal = 0.
-    beta = 1.
-    dif_grnd = 0.
+    !cal = 0.
+    !beta = 1.
+    !dif_grnd = 0.
+    
+    
+    ! EV: use calbeta to calculate beta
+    ! Need to initialize qsurf for calbeta but it is not modified by this routine
+    qsurf(:)=0.
+    CALL calbeta(dtime, is_oce, knon, snow, qsurf, beta, cal, dif_grnd)
+
+
     alb_neig(:) = 0.
     agesno(:) = 0.
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
+    lat_prec_liq = 0.; lat_prec_sol = 0.
 
 ! Suppose zero surface speed
@@ -174,10 +189,12 @@
 ! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
     CALL calcul_fluxs(knon, is_oce, dtime, &
-         tsurf_lim, p1lay, cal, beta, cdragh, cdragq, ps, &
+         merge(tsurf_in, tsurf_lim, activate_ocean_skin == 2), p1lay, cal, &
+         beta, cdragh, cdragq, ps, &
          precip_rain, precip_snow, snow, qsurf,  &
          radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
+         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
+    if (activate_ocean_skin == 2) tsurf_new = tsurf_lim
 
     do j = 1, knon
@@ -233,5 +250,5 @@
        radsol, snow, qsol, agesno, tsoil, &
        qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l &
+       tsurf_new, dflux_s, dflux_l, rhoa &
 #ifdef ISO
             ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
@@ -262,8 +279,9 @@
 #endif
 
-!    INCLUDE "indicesol.h"
+!   INCLUDE "indicesol.h"
     INCLUDE "dimsoil.h"
     INCLUDE "YOMCST.h"
     INCLUDE "clesphys.h"
+    INCLUDE "flux_arp.h"
 
 ! Input arguments
@@ -281,4 +299,5 @@
     REAL, DIMENSION(klon), INTENT(IN)    :: ps
     REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
+    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 #ifdef ISO
     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
@@ -323,5 +342,5 @@
     REAL, DIMENSION(klon)       :: u0, v0
     REAL, DIMENSION(klon)       :: u1_lay, v1_lay
-    REAL, DIMENSION(klon)       :: sens_prec_liq, sens_prec_sol    
+    REAL sens_prec_liq(knon), sens_prec_sol (knon)
     REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol    
 
@@ -354,5 +373,5 @@
     tsurf_tmp(:) = tsurf_in(:)
 
-! calculate the parameters cal, beta, capsol and dif_grnd
+! calculate the parameters cal, beta, capsol and dif_grnd and then recalculate cal
     CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
 
@@ -370,6 +389,6 @@
     ENDIF
 
-    beta = 1.0
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
+!    beta = 1.0
+    lat_prec_liq = 0.; lat_prec_sol = 0.
 
 ! Suppose zero surface speed
@@ -384,5 +403,5 @@
          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
+         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
     do j = 1, knon
       i = knindex(j)
@@ -489,27 +508,26 @@
 ! 1D case
 !************************************************************************
-  SUBROUTINE read_tsurf1d(knon,sst_out)
-
+!  SUBROUTINE read_tsurf1d(knon,sst_out)
+!
 ! This subroutine specifies the surface temperature to be used in 1D simulations
-
-      USE dimphy, ONLY : klon
-
-      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
-      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
-
-       INTEGER :: i
+!
+!      USE dimphy, ONLY : klon
+!
+!      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+!      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
+!
+!       INTEGER :: i
 ! COMMON defined in lmdz1d.F:
-       real ts_cur
-       common /sst_forcing/ts_cur
-
-       DO i = 1, knon
-        sst_out(i) = ts_cur
-       ENDDO
-
-      END SUBROUTINE read_tsurf1d
-
+!       real ts_cur
+!       common /sst_forcing/ts_cur
+!
+!       DO i = 1, knon
+!        sst_out(i) = ts_cur
+!       ENDDO
+!
+!      END SUBROUTINE read_tsurf1d
+!
 !
 !************************************************************************
-!
 END MODULE ocean_forced_mod
 
Index: LMDZ6/trunk/libf/phylmdiso/ocean_slab_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ocean_slab_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ocean_slab_mod.F90	(revision 3940)
@@ -1,983 +1,1 @@
-!Completed
-MODULE ocean_slab_mod
-!
-! This module is used for both surface ocean and sea-ice when using the slab ocean,
-! "ocean=slab".
-!
-
-  USE dimphy
-  USE indice_sol_mod
-  USE surface_data
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-  USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
-
-  IMPLICIT NONE
-  PRIVATE
-  PUBLIC :: ocean_slab_init, ocean_slab_frac, ocean_slab_noice, ocean_slab_ice
-
-!***********************************************************************************
-! Global saved variables
-!***********************************************************************************
-  ! number of slab vertical layers
-  INTEGER, PUBLIC, SAVE :: nslay
-  !$OMP THREADPRIVATE(nslay)
-  ! timestep for coupling (update slab temperature) in timesteps
-  INTEGER, PRIVATE, SAVE                           :: cpl_pas
-  !$OMP THREADPRIVATE(cpl_pas)
-  ! cyang = 1/heat capacity of top layer (rho.c.H)
-  REAL, PRIVATE, SAVE                              :: cyang
-  !$OMP THREADPRIVATE(cyang)
-  ! depth of slab layers (1 or 2)
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE   :: slabh
-  !$OMP THREADPRIVATE(slabh)
-  ! slab temperature
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: tslab
-  !$OMP THREADPRIVATE(tslab)
-  ! heat flux convergence due to Ekman
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: dt_ekman
-  !$OMP THREADPRIVATE(dt_ekman)
-  ! heat flux convergence due to horiz diffusion
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: dt_hdiff
-  !$OMP THREADPRIVATE(dt_hdiff)
-  ! heat flux convergence due to GM eddy advection
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: dt_gm
-  !$OMP THREADPRIVATE(dt_gm)
-  ! Heat Flux correction 
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: dt_qflux
-  !$OMP THREADPRIVATE(dt_qflux)
-  ! fraction of ocean covered by sea ice (sic / (oce+sic))
-  REAL, ALLOCATABLE, DIMENSION(:), PUBLIC, SAVE  :: fsic
-  !$OMP THREADPRIVATE(fsic)
-  ! temperature of the sea ice
-  REAL, ALLOCATABLE, DIMENSION(:), PUBLIC, SAVE  :: tice
-  !$OMP THREADPRIVATE(tice)
-  ! sea ice thickness, in kg/m2
-  REAL, ALLOCATABLE, DIMENSION(:), PUBLIC, SAVE  :: seaice
-  !$OMP THREADPRIVATE(seaice)
-  ! net surface heat flux, weighted by open ocean fraction
-  ! slab_bils accumulated over cpl_pas timesteps
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE  :: bils_cum
-  !$OMP THREADPRIVATE(bils_cum)
-  ! net heat flux into the ocean below the ice : conduction + solar radiation
-  REAL, ALLOCATABLE, DIMENSION(:), PUBLIC, SAVE  :: slab_bilg
-  !$OMP THREADPRIVATE(slab_bilg)
-  ! slab_bilg over cpl_pas timesteps
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE  :: bilg_cum
-  !$OMP THREADPRIVATE(bilg_cum)
-  ! wind stress saved over cpl_pas timesteps
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE  :: taux_cum
-  !$OMP THREADPRIVATE(taux_cum)
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE  :: tauy_cum
-  !$OMP THREADPRIVATE(tauy_cum)
-
-!***********************************************************************************
-! Parameters (could be read in def file: move to slab_init)
-!***********************************************************************************
-! snow and ice physical characteristics:
-    REAL, PARAMETER :: t_freeze=271.35 ! freezing sea water temp
-    REAL, PARAMETER :: t_melt=273.15   ! melting ice temp
-    REAL, PARAMETER :: sno_den=300. !mean snow density, kg/m3
-    REAL, PARAMETER :: ice_den=917. ! ice density
-    REAL, PARAMETER :: sea_den=1025. ! sea water density
-    REAL, PARAMETER :: ice_cond=2.17*ice_den !conductivity of ice
-    REAL, PARAMETER :: sno_cond=0.31*sno_den ! conductivity of snow
-    REAL, PARAMETER :: ice_cap=2067.   ! specific heat capacity, snow and ice
-    REAL, PARAMETER :: sea_cap=3995.   ! specific heat capacity, snow and ice
-    REAL, PARAMETER :: ice_lat=334000. ! freeze /melt latent heat snow and ice
-
-! control of snow and ice cover & freeze / melt (heights converted to kg/m2)
-    REAL, PARAMETER :: snow_min=0.05*sno_den !critical snow height 5 cm
-    REAL, PARAMETER :: snow_wfact=0.4 ! max fraction of falling snow blown into ocean
-    REAL, PARAMETER :: ice_frac_min=0.001
-    REAL, PARAMETER :: ice_frac_max=1. ! less than 1. if min leads fraction 
-    REAL, PARAMETER :: h_ice_min=0.01*ice_den ! min ice thickness 
-    REAL, PARAMETER :: h_ice_thin=0.15*ice_den ! thin ice thickness 
-    ! below ice_thin, priority is melt lateral / grow height
-    ! ice_thin is also height of new ice
-    REAL, PARAMETER :: h_ice_thick=2.5*ice_den ! thin ice thickness 
-    ! above ice_thick, priority is melt height / grow lateral
-    REAL, PARAMETER :: h_ice_new=1.*ice_den ! max height of new open ocean ice 
-    REAL, PARAMETER :: h_ice_max=10.*ice_den ! max ice height 
-
-! albedo  and radiation parameters
-    REAL, PARAMETER :: alb_sno_min=0.55 !min snow albedo
-    REAL, PARAMETER :: alb_sno_del=0.3  !max snow albedo = min + del
-    REAL, PARAMETER :: alb_ice_dry=0.75 !dry thick ice
-    REAL, PARAMETER :: alb_ice_wet=0.66 !melting thick ice
-    REAL, PARAMETER :: pen_frac=0.3 !fraction of shortwave penetrating into the
-    ! ice (no snow)
-    REAL, PARAMETER :: pen_ext=1.5 !extinction of penetrating shortwave (m-1)
-
-! horizontal transport
-   LOGICAL, PUBLIC, SAVE :: slab_hdiff
-   !$OMP THREADPRIVATE(slab_hdiff)
-   LOGICAL, PUBLIC, SAVE :: slab_gm
-   !$OMP THREADPRIVATE(slab_gm)
-   REAL, PRIVATE, SAVE    :: coef_hdiff ! coefficient for horizontal diffusion
-   !$OMP THREADPRIVATE(coef_hdiff)
-   INTEGER, PUBLIC, SAVE :: slab_ekman, slab_cadj ! Ekman, conv adjustment
-   !$OMP THREADPRIVATE(slab_ekman)
-   !$OMP THREADPRIVATE(slab_cadj)
-
-!***********************************************************************************
-
-CONTAINS
-!
-!***********************************************************************************
-!
-  SUBROUTINE ocean_slab_init(dtime, pctsrf_rst)
-  !, seaice_rst etc
-
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-    USE mod_phys_lmdz_transfert_para, ONLY : gather
-    USE slab_heat_transp_mod, ONLY : ini_slab_transp
-
-    ! Input variables
-!***********************************************************************************
-    REAL, INTENT(IN)                         :: dtime
-! Variables read from restart file
-    REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf_rst 
-    ! surface fractions from start file
-
-! Local variables
-!************************************************************************************
-    INTEGER                :: error
-    REAL, DIMENSION(klon_glo) :: zmasq_glo
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'ocean_slab_intit'
-
-!***********************************************************************************
-! Define some parameters
-!***********************************************************************************
-! Number of slab layers
-    nslay=2
-    CALL getin_p('slab_layers',nslay)
-    print *,'number of slab layers : ',nslay
-! Layer thickness
-    ALLOCATE(slabh(nslay), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation slabh'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    slabh(1)=50.
-    CALL getin_p('slab_depth',slabh(1))
-    IF (nslay.GT.1) THEN 
-        slabh(2)=150.
-    END IF
-
-! cyang = 1/heat capacity of top layer (rho.c.H)
-    cyang=1/(slabh(1)*sea_den*sea_cap)
-
-! cpl_pas  coupling period (update of tslab and ice fraction)
-! pour un calcul a chaque pas de temps, cpl_pas=1
-    cpl_pas = NINT(86400./dtime * 1.0) ! une fois par jour
-    CALL getin_p('cpl_pas',cpl_pas)
-    print *,'cpl_pas',cpl_pas
-
-! Horizontal diffusion
-    slab_hdiff=.FALSE.
-    CALL getin_p('slab_hdiff',slab_hdiff)
-    coef_hdiff=25000.
-    CALL getin_p('coef_hdiff',coef_hdiff)
-! Ekman transport
-    slab_ekman=0
-    CALL getin_p('slab_ekman',slab_ekman)
-! GM eddy advection (2-layers only)
-    slab_gm=.FALSE.
-    CALL getin_p('slab_gm',slab_gm)
-    IF (slab_ekman.LT.2) THEN
-       slab_gm=.FALSE.
-    ENDIF 
-! Convective adjustment
-    IF (nslay.EQ.1) THEN
-        slab_cadj=0
-    ELSE
-        slab_cadj=1
-    END IF
-    CALL getin_p('slab_cadj',slab_cadj)
-
-!************************************************************************************
-! Allocate surface fraction read from restart file
-!************************************************************************************
-    ALLOCATE(fsic(klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation tmp_pctsrf_slab'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    fsic(:)=0.
-    !zmasq = continent fraction
-    WHERE (1.-zmasq(:)>EPSFRA)
-        fsic(:) = pctsrf_rst(:,is_sic)/(1.-zmasq(:))
-    END WHERE
-
-!************************************************************************************
-! Allocate saved fields
-!************************************************************************************
-    ALLOCATE(tslab(klon,nslay), stat=error)
-       IF (error /= 0) CALL abort_physic &
-         (modname,'pb allocation tslab', 1)
-
-    ALLOCATE(bils_cum(klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation slab_bils_cum'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    bils_cum(:) = 0.0   
-
-    IF (version_ocean=='sicINT') THEN ! interactive sea ice
-        ALLOCATE(slab_bilg(klon), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation slab_bilg'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        slab_bilg(:) = 0.0   
-        ALLOCATE(bilg_cum(klon), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation slab_bilg_cum'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        bilg_cum(:) = 0.0   
-        ALLOCATE(tice(klon), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation slab_tice'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        ALLOCATE(seaice(klon), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation slab_seaice'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-    END IF
-
-    IF (slab_hdiff) THEN !horizontal diffusion
-        ALLOCATE(dt_hdiff(klon,nslay), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation dt_hdiff'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        dt_hdiff(:,:) = 0.0   
-    ENDIF
-
-    ALLOCATE(dt_qflux(klon,nslay), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation dt_qflux'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    dt_qflux(:,:) = 0.0   
-
-    IF (slab_gm) THEN !GM advection
-        ALLOCATE(dt_gm(klon,nslay), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation dt_gm'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        dt_gm(:,:) = 0.0   
-    ENDIF
-
-    IF (slab_ekman.GT.0) THEN ! ekman transport
-        ALLOCATE(dt_ekman(klon,nslay), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation dt_ekman'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        dt_ekman(:,:) = 0.0   
-        ALLOCATE(taux_cum(klon), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation taux_cum'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        taux_cum(:) = 0.0   
-        ALLOCATE(tauy_cum(klon), stat = error)
-        IF (error /= 0) THEN
-           abort_message='Pb allocation tauy_cum'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-        tauy_cum(:) = 0.0   
-    ENDIF
-
-! Initialize transport
-    IF (slab_hdiff.OR.(slab_ekman.GT.0)) THEN
-      CALL gather(zmasq,zmasq_glo)
-! Master thread/process only
-!$OMP MASTER  
-      IF (is_mpi_root) THEN 
-          CALL ini_slab_transp(zmasq_glo)
-      END IF
-!$OMP END MASTER
-    END IF
-
- END SUBROUTINE ocean_slab_init
-!
-!***********************************************************************************
-!
-  SUBROUTINE ocean_slab_frac(itime, dtime, jour, pctsrf_chg, is_modified)
-
-! this routine sends back the sea ice and ocean fraction to the main physics
-! routine. Called only with interactive sea ice
-
-! Arguments
-!************************************************************************************
-    INTEGER, INTENT(IN)                        :: itime   ! current timestep 
-    INTEGER, INTENT(IN)                        :: jour    !  day in year (not 
-    REAL   , INTENT(IN)                        :: dtime   ! physics timestep (s)
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf_chg  ! sub-surface fraction
-    LOGICAL, INTENT(OUT)                       :: is_modified ! true if pctsrf is 
-                                                         ! modified at this time step
-
-       pctsrf_chg(:,is_oce)=(1.-fsic(:))*(1.-zmasq(:))
-       pctsrf_chg(:,is_sic)=fsic(:)*(1.-zmasq(:))
-       is_modified=.TRUE.
-
-  END SUBROUTINE ocean_slab_frac
-!
-!************************************************************************************
-!
-  SUBROUTINE ocean_slab_noice( & 
-       itime, dtime, jour, knon, knindex, &
-       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, tsurf_in, &
-       radsol, snow, &
-       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l, slab_bils)
-    
-    USE calcul_fluxs_mod
-    USE slab_heat_transp_mod, ONLY: divgrad_phy,slab_ekman1,slab_ekman2,slab_gmdiff
-    USE mod_phys_lmdz_para
-
-    INCLUDE "clesphys.h"
-
-! This routine 
-! (1) computes surface turbulent fluxes over points with some open ocean    
-! (2) reads additional Q-flux (everywhere)
-! (3) computes horizontal transport (diffusion & Ekman)
-! (4) updates slab temperature every cpl_pas ; creates new ice if needed.
-
-! Note : 
-! klon total number of points
-! knon number of points with open ocean (varies with time)
-! knindex gives position of the knon points within klon.
-! In general, local saved variables have klon values
-! variables exchanged with PBL module have knon.
-
-! Input arguments
-!***********************************************************************************
-    INTEGER, INTENT(IN)                  :: itime ! current timestep INTEGER,
-    INTEGER, INTENT(IN)                  :: jour  ! day in year (for Q-Flux) 
-    INTEGER, INTENT(IN)                  :: knon  ! number of points 
-    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex 
-    REAL, INTENT(IN) :: dtime  ! timestep (s)
-    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay 
-    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragq, cdragm 
-    ! drag coefficients
-    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow 
-    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum ! near surface T, q
-    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ 
-    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV 
-    ! exchange coefficients for boundary layer scheme
-    REAL, DIMENSION(klon), INTENT(IN)    :: ps  ! surface pressure
-    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness ! surface wind
-    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in ! surface temperature
-    REAL, DIMENSION(klon), INTENT(INOUT) :: radsol ! net surface radiative flux
-
-! In/Output arguments
-!************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT) :: snow ! in kg/m2
-    
-! Output arguments
-!************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)   :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)   :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)   :: flux_u1, flux_v1
-    REAL, DIMENSION(klon), INTENT(OUT)   :: tsurf_new ! new surface tempearture
-    REAL, DIMENSION(klon), INTENT(OUT)   :: dflux_s, dflux_l      
-    REAL, DIMENSION(klon), INTENT(OUT)   :: slab_bils
-
-! Local variables
-!************************************************************************************
-    INTEGER               :: i,ki,k
-    REAL                  :: t_cadj
-    !  for surface heat fluxes
-    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
-    ! for Q-Flux computation: d/dt SST, d/dt ice volume (kg/m2), surf fluxes 
-    REAL, DIMENSION(klon) :: diff_sst, diff_siv
-    REAL, DIMENSION(klon,nslay) :: lmt_bils
-    ! for surface wind stress
-    REAL, DIMENSION(klon) :: u0, v0
-    REAL, DIMENSION(klon) :: u1_lay, v1_lay
-    ! for new ice creation
-    REAL                  :: e_freeze, h_new, dfsic
-    ! horizontal diffusion and Ekman local vars
-    ! dimension = global domain (klon_glo) instead of // subdomains 
-    REAL, DIMENSION(klon_glo,nslay) :: dt_hdiff_glo,dt_ekman_glo,dt_gm_glo
-    ! dt_ekman_glo saved for diagnostic, dt_ekman_tmp used for time loop
-    REAL, DIMENSION(klon_glo,nslay) :: dt_hdiff_tmp, dt_ekman_tmp
-    REAL, DIMENSION(klon_glo,nslay) :: tslab_glo
-    REAL, DIMENSION(klon_glo) :: taux_glo,tauy_glo
-
-!****************************************************************************************
-! 1) Surface fluxes calculation
-!    
-!****************************************************************************************
-    cal(:)      = 0. ! infinite thermal inertia
-    beta(:)     = 1. ! wet surface
-    dif_grnd(:) = 0. ! no diffusion into ground
-    
-! Suppose zero surface speed
-    u0(:)=0.0
-    v0(:)=0.0
-    u1_lay(:) = u1(:) - u0(:)
-    v1_lay(:) = v1(:) - v0(:)
-
-! Compute latent & sensible fluxes
-    CALL calcul_fluxs(knon, is_oce, dtime, &
-         tsurf_in, p1lay, cal, beta, cdragh, cdragq, ps, &
-         precip_rain, precip_snow, snow, qsurf,  &
-         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
-         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
-
-! save total cumulated heat fluxes locally
-! radiative + turbulent + melt of falling snow 
-    slab_bils(:)=0.
-    DO i=1,knon
-        ki=knindex(i)
-        slab_bils(ki)=(1.-fsic(ki))*(fluxlat(i)+fluxsens(i)+radsol(i) &
-                      -precip_snow(i)*ice_lat*(1.+snow_wfact*fsic(ki)))
-        bils_cum(ki)=bils_cum(ki)+slab_bils(ki)
-    END DO
-
-!  Compute surface wind stress
-    CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)  
-
-! save cumulated wind stress
-    IF (slab_ekman.GT.0) THEN 
-      DO i=1,knon
-          ki=knindex(i)
-          taux_cum(ki)=taux_cum(ki)+flux_u1(i)*(1.-fsic(ki))/cpl_pas
-          tauy_cum(ki)=tauy_cum(ki)+flux_v1(i)*(1.-fsic(ki))/cpl_pas
-      END DO
-    ENDIF
-
-!****************************************************************************************
-! 2) Q-Flux : get global variables lmt_bils, diff_sst and diff_siv from file limit_slab.nc
-!
-!****************************************************************************************
-    CALL limit_slab(itime, dtime, jour, lmt_bils, diff_sst, diff_siv) 
-    ! lmt_bils and diff_sst,siv saved by limit_slab
-    ! qflux = total QFlux correction (in W/m2)
-    dt_qflux(:,1)=lmt_bils(:,1)+diff_sst(:)/cyang/86400.-diff_siv(:)*ice_den*ice_lat/86400.
-    IF (nslay.GT.1) THEN
-       dt_qflux(:,2:nslay)=lmt_bils(:,2:nslay)
-    END IF
-
-!****************************************************************************************
-! 3) Recalculate new temperature (add Surf fluxes, Q-Flux, Ocean transport)
-!    Bring to freezing temp and make sea ice if necessary
-!  
-!***********************************************o*****************************************
-    tsurf_new=tsurf_in
-    IF (MOD(itime,cpl_pas).EQ.0) THEN ! time to update tslab & fraction
-! ***********************************
-!  Horizontal transport 
-! ***********************************
-      IF (slab_ekman.GT.0) THEN 
-          ! copy wind stress to global var
-          CALL gather(taux_cum,taux_glo)
-          CALL gather(tauy_cum,tauy_glo)
-      END IF
-
-      IF (slab_hdiff.OR.(slab_ekman.GT.0)) THEN 
-        CALL gather(tslab,tslab_glo)
-      ! Compute horiz transport on one process only
-        IF (is_mpi_root .AND. is_omp_root) THEN ! Only master processus          
-          IF (slab_hdiff) THEN 
-              dt_hdiff_glo(:,:)=0.
-          END IF
-          IF (slab_ekman.GT.0) THEN 
-              dt_ekman_glo(:,:)=0.
-          END IF
-          IF (slab_gm) THEN 
-              dt_gm_glo(:,:)=0.
-          END IF
-          DO i=1,cpl_pas ! time splitting for numerical stability
-            IF (slab_ekman.GT.0) THEN
-              SELECT CASE (slab_ekman)
-                CASE (1)
-                  CALL slab_ekman1(taux_glo,tauy_glo,tslab_glo,dt_ekman_tmp)
-                CASE (2)
-                  CALL slab_ekman2(taux_glo,tauy_glo,tslab_glo,dt_ekman_tmp,dt_hdiff_tmp,slab_gm)
-                CASE DEFAULT
-                  dt_ekman_tmp(:,:)=0.
-              END SELECT
-              dt_ekman_glo(:,:)=dt_ekman_glo(:,:)+dt_ekman_tmp(:,:)
-              ! convert dt_ekman from K.s-1.(kg.m-2) to K.s-1   
-              DO k=1,nslay
-                dt_ekman_tmp(:,k)=dt_ekman_tmp(:,k)/(slabh(k)*sea_den)
-              ENDDO
-              tslab_glo=tslab_glo+dt_ekman_tmp*dtime
-              IF (slab_gm) THEN ! Gent-McWilliams eddy advection
-                dt_gm_glo(:,:)=dt_gm_glo(:,:)+ dt_hdiff_tmp(:,:)
-                ! convert dt from K.s-1.(kg.m-2) to K.s-1   
-                DO k=1,nslay
-                  dt_hdiff_tmp(:,k)=dt_hdiff_tmp(:,k)/(slabh(k)*sea_den) 
-                END DO
-                tslab_glo=tslab_glo+dt_hdiff_tmp*dtime
-              END IF
-            ENDIF
-! GM included in Ekman_2
-!            IF (slab_gm) THEN ! Gent-McWilliams eddy advection
-!              CALL slab_gmdiff(tslab_glo,dt_hdiff_tmp)
-!              ! convert dt_gm from K.m.s-1 to K.s-1   
-!              DO k=1,nslay
-!                dt_hdiff_tmp(:,k)=dt_hdiff_tmp(:,k)/slabh(k) 
-!              END DO
-!              tslab_glo=tslab_glo+dt_hdiff_tmp*dtime
-!              dt_gm_glo(:,:)=dt_gm_glo(:,:)+ dt_hdiff_tmp(:,:)
-!            END IF
-            IF (slab_hdiff) THEN ! horizontal diffusion
-              ! laplacian of slab T
-              CALL divgrad_phy(nslay,tslab_glo,dt_hdiff_tmp)
-              ! multiply by diff coef and normalize to 50m slab equivalent
-              dt_hdiff_tmp=dt_hdiff_tmp*coef_hdiff*50./SUM(slabh)
-              dt_hdiff_glo(:,:)=dt_hdiff_glo(:,:)+ dt_hdiff_tmp(:,:)
-              tslab_glo=tslab_glo+dt_hdiff_tmp*dtime
-            END IF
-          END DO ! time splitting
-          IF (slab_hdiff) THEN
-            !dt_hdiff_glo saved in W/m2
-            DO k=1,nslay
-              dt_hdiff_glo(:,k)=dt_hdiff_glo(:,k)*slabh(k)*sea_den*sea_cap/cpl_pas
-            END DO
-          END IF
-          IF (slab_gm) THEN
-            !dt_hdiff_glo saved in W/m2
-            dt_gm_glo(:,:)=dt_gm_glo(:,:)*sea_cap/cpl_pas
-          END IF
-          IF (slab_ekman.GT.0) THEN 
-            ! dt_ekman_glo saved in W/m2
-            dt_ekman_glo(:,:)=dt_ekman_glo(:,:)*sea_cap/cpl_pas
-          END IF
-        END IF ! master process
-!$OMP BARRIER
-        ! Send new fields back to all processes
-        CALL Scatter(tslab_glo,tslab)
-        IF (slab_hdiff) THEN
-          CALL Scatter(dt_hdiff_glo,dt_hdiff)
-        END IF
-        IF (slab_gm) THEN
-          CALL Scatter(dt_gm_glo,dt_gm)
-        END IF
-        IF (slab_ekman.GT.0) THEN 
-          CALL Scatter(dt_ekman_glo,dt_ekman)
-          ! clear wind stress
-          taux_cum(:)=0.
-          tauy_cum(:)=0.
-        END IF
-      ENDIF ! transport
-
-! ***********************************
-! Other heat fluxes
-! ***********************************
-      ! Add read QFlux
-      DO k=1,nslay
-        tslab(:,k)=tslab(:,k)+dt_qflux(:,k)*cyang*dtime*cpl_pas &
-                   *slabh(1)/slabh(k) 
-      END DO
-      ! Add cumulated surface fluxes
-      tslab(:,1)=tslab(:,1)+bils_cum(:)*cyang*dtime
-      ! Convective adjustment if 2 layers 
-      IF ((nslay.GT.1).AND.(slab_cadj.GT.0)) THEN
-        DO i=1,klon
-          IF (tslab(i,2).GT.tslab(i,1)) THEN
-            ! mean (mass-weighted) temperature
-            t_cadj=SUM(tslab(i,:)*slabh(:))/SUM(slabh(:))
-            tslab(i,1)=t_cadj
-            tslab(i,2)=t_cadj
-          END IF
-        END DO
-      END IF
-! ***********************************
-! Update surface temperature and ice 
-! ***********************************
-      SELECT CASE(version_ocean)
-      CASE('sicNO') ! no sea ice even below freezing !
-          DO i=1,knon
-              ki=knindex(i)
-              tsurf_new(i)=tslab(ki,1)
-          END DO
-      CASE('sicOBS') ! "realistic" case, for prescribed sea ice
-        ! tslab cannot be below freezing, or above it if there is sea ice
-          DO i=1,knon
-              ki=knindex(i)
-              IF ((tslab(ki,1).LT.t_freeze).OR.(fsic(ki).GT.epsfra)) THEN
-                  tslab(ki,1)=t_freeze
-              END IF
-              tsurf_new(i)=tslab(ki,1)
-          END DO
-      CASE('sicINT') ! interactive sea ice
-          DO i=1,knon
-              ki=knindex(i)
-              IF (fsic(ki).LT.epsfra) THEN ! Free of ice
-                  IF (tslab(ki,1).LT.t_freeze) THEN ! create new ice
-                      ! quantity of new ice formed
-                      e_freeze=(t_freeze-tslab(ki,1))/cyang/ice_lat
-                      ! new ice
-                      tice(ki)=t_freeze
-                      fsic(ki)=MIN(ice_frac_max,e_freeze/h_ice_thin)
-                      IF (fsic(ki).GT.ice_frac_min) THEN
-                          seaice(ki)=MIN(e_freeze/fsic(ki),h_ice_max)
-                          tslab(ki,1)=t_freeze
-                      ELSE
-                          fsic(ki)=0.
-                      END IF
-                      tsurf_new(i)=t_freeze
-                  ELSE
-                      tsurf_new(i)=tslab(ki,1)
-                  END IF 
-              ELSE ! ice present
-                  tsurf_new(i)=t_freeze
-                  IF (tslab(ki,1).LT.t_freeze) THEN ! create new ice
-                      ! quantity of new ice formed over open ocean
-                      e_freeze=(t_freeze-tslab(ki,1))/cyang*(1.-fsic(ki)) &
-                               /(ice_lat+ice_cap/2.*(t_freeze-tice(ki)))
-                      ! new ice height and fraction
-                      h_new=MIN(h_ice_new,seaice(ki)) ! max new height ice_new
-                      dfsic=MIN(ice_frac_max-fsic(ki),e_freeze/h_new)
-                      h_new=MIN(e_freeze/dfsic,h_ice_max)
-                      ! update tslab to freezing over open ocean only
-                      tslab(ki,1)=tslab(ki,1)*fsic(ki)+t_freeze*(1.-fsic(ki))
-                      ! update sea ice
-                      seaice(ki)=(h_new*dfsic+seaice(ki)*fsic(ki)) &
-                                 /(dfsic+fsic(ki))
-                      fsic(ki)=fsic(ki)+dfsic
-                      ! update snow?
-                  END IF ! tslab below freezing
-              END IF ! sea ice present
-          END DO
-      END SELECT
-      bils_cum(:)=0.0! clear cumulated fluxes
-    END IF ! coupling time
-  END SUBROUTINE ocean_slab_noice
-!
-!****************************************************************************************
-
-  SUBROUTINE ocean_slab_ice(   &
-       itime, dtime, jour, knon, knindex, &
-       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, &
-       radsol, snow, qsurf, qsol, agesno, &
-       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l, swnet)
-
-   USE calcul_fluxs_mod
-
-   INCLUDE "YOMCST.h"
-   INCLUDE "clesphys.h"
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                  :: itime, jour, knon
-    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-    REAL, INTENT(IN)                     :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
-    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
-    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
-    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
-    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)    :: ps
-    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)    :: swnet
-
-! In/Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
-    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
-    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l
-
-! Local variables
-!****************************************************************************************
-    INTEGER               :: i,ki
-    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
-    REAL, DIMENSION(klon) :: u0, v0
-    REAL, DIMENSION(klon) :: u1_lay, v1_lay
-    ! intermediate heat fluxes:
-    REAL                  :: f_cond, f_swpen
-    ! for snow/ice albedo:
-    REAL                  :: alb_snow, alb_ice, alb_pond
-    REAL                  :: frac_snow, frac_ice, frac_pond
-    ! for ice melt / freeze
-    REAL                  :: e_melt, snow_evap, h_test
-    ! dhsic, dfsic change in ice mass, fraction.
-    REAL                  :: dhsic, dfsic, frac_mf
-
-!****************************************************************************************
-! 1) Flux calculation
-!****************************************************************************************
-! Suppose zero surface speed
-    u0(:)=0.0
-    v0(:)=0.0
-    u1_lay(:) = u1(:) - u0(:)
-    v1_lay(:) = v1(:) - v0(:)
-
-! set beta, cal, compute conduction fluxes inside ice/snow 
-    slab_bilg(:)=0.
-    dif_grnd(:)=0.
-    beta(:) = 1.
-    DO i=1,knon
-    ki=knindex(i)
-        IF (snow(i).GT.snow_min) THEN
-            ! snow-layer heat capacity
-            cal(i)=2.*RCPD/(snow(i)*ice_cap)
-            ! snow conductive flux
-            f_cond=sno_cond*(tice(ki)-tsurf_in(i))/snow(i)
-            ! all shortwave flux absorbed
-            f_swpen=0.
-            ! bottom flux (ice conduction)
-            slab_bilg(ki)=ice_cond*(tice(ki)-t_freeze)/seaice(ki)
-            ! update ice temperature
-            tice(ki)=tice(ki)-2./ice_cap/(snow(i)+seaice(ki)) &
-                     *(slab_bilg(ki)+f_cond)*dtime
-       ELSE ! bare ice
-            ! ice-layer heat capacity
-            cal(i)=2.*RCPD/(seaice(ki)*ice_cap)
-            ! conductive flux
-            f_cond=ice_cond*(t_freeze-tice(ki))/seaice(ki)
-            ! penetrative shortwave flux...
-            f_swpen=swnet(i)*pen_frac*exp(-pen_ext*seaice(ki)/ice_den)
-            slab_bilg(ki)=f_swpen-f_cond
-        END IF
-        radsol(i)=radsol(i)+f_cond-f_swpen
-    END DO
-    ! weight fluxes to ocean by sea ice fraction
-    slab_bilg(:)=slab_bilg(:)*fsic(:)
-
-! calcul_fluxs (sens, lat etc)
-    CALL calcul_fluxs(knon, is_sic, dtime, &
-        tsurf_in, p1lay, cal, beta, cdragh, cdragh, ps, &
-        precip_rain, precip_snow, snow, qsurf,  &
-        radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-        f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
-        tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
-    DO i=1,knon 
-        IF (snow(i).LT.snow_min) tice(knindex(i))=tsurf_new(i)
-    END DO
-
-! calcul_flux_wind
-    CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)
-
-!****************************************************************************************
-! 2) Update snow and ice surface
-!****************************************************************************************
-! snow precip
-    DO i=1,knon
-        ki=knindex(i)
-        IF (precip_snow(i) > 0.) THEN
-            snow(i) = snow(i)+precip_snow(i)*dtime*(1.-snow_wfact*(1.-fsic(ki)))
-        END IF
-! snow and ice sublimation
-        IF (evap(i) > 0.) THEN 
-           snow_evap = MIN (snow(i) / dtime, evap(i))
-           snow(i) = snow(i) - snow_evap * dtime
-           snow(i) = MAX(0.0, snow(i))
-           seaice(ki) = MAX(0.0,seaice(ki)-(evap(i)-snow_evap)*dtime)
-        ENDIF
-! Melt / Freeze snow from above if Tsurf>0
-        IF (tsurf_new(i).GT.t_melt) THEN
-            ! energy available for melting snow (in kg of melted snow /m2)
-            e_melt = MIN(MAX(snow(i)*(tsurf_new(i)-t_melt)*ice_cap/2. &
-               /(ice_lat+ice_cap/2.*(t_melt-tice(ki))),0.0),snow(i))
-            ! remove snow
-            IF (snow(i).GT.e_melt) THEN
-                snow(i)=snow(i)-e_melt
-                tsurf_new(i)=t_melt
-            ELSE ! all snow is melted
-                ! add remaining heat flux to ice
-                e_melt=e_melt-snow(i)
-                tice(ki)=tice(ki)+e_melt*ice_lat*2./(ice_cap*seaice(ki))
-                tsurf_new(i)=tice(ki)
-            END IF
-        END IF
-! melt ice from above if Tice>0
-        IF (tice(ki).GT.t_melt) THEN
-            ! quantity of ice melted (kg/m2)
-            e_melt=MAX(seaice(ki)*(tice(ki)-t_melt)*ice_cap/2. & 
-             /(ice_lat+ice_cap/2.*(t_melt-t_freeze)),0.0)
-            ! melt from above, height only
-            dhsic=MIN(seaice(ki)-h_ice_min,e_melt)
-            e_melt=e_melt-dhsic
-            IF (e_melt.GT.0) THEN
-            ! lateral melt if ice too thin
-            dfsic=MAX(fsic(ki)-ice_frac_min,e_melt/h_ice_min*fsic(ki))
-            ! if all melted add remaining heat to ocean
-            e_melt=MAX(0.,e_melt*fsic(ki)-dfsic*h_ice_min)
-            slab_bilg(ki)=slab_bilg(ki)+ e_melt*ice_lat/dtime
-            ! update height and fraction
-            fsic(ki)=fsic(ki)-dfsic
-            END IF
-            seaice(ki)=seaice(ki)-dhsic
-            ! surface temperature at melting point
-            tice(ki)=t_melt
-            tsurf_new(i)=t_melt
-        END IF
-        ! convert snow to ice if below floating line
-        h_test=(seaice(ki)+snow(i))*ice_den-seaice(ki)*sea_den
-        IF (h_test.GT.0.) THEN !snow under water
-            ! extra snow converted to ice (with added frozen sea water)
-            dhsic=h_test/(sea_den-ice_den+sno_den)
-            seaice(ki)=seaice(ki)+dhsic
-            snow(i)=snow(i)-dhsic*sno_den/ice_den
-            ! available energy (freeze sea water + bring to tice)
-            e_melt=dhsic*(1.-sno_den/ice_den)*(ice_lat+ &
-                   ice_cap/2.*(t_freeze-tice(ki)))
-            ! update ice temperature
-            tice(ki)=tice(ki)+2.*e_melt/ice_cap/(snow(i)+seaice(ki))
-        END IF
-    END DO
-
-! New albedo
-    DO i=1,knon
-        ki=knindex(i)
-       ! snow albedo: update snow age
-        IF (snow(i).GT.0.0001) THEN
-             agesno(i)=(agesno(i) + (1.-agesno(i)/50.)*dtime/86400.)&
-                         * EXP(-1.*MAX(0.0,precip_snow(i))*dtime/5.)
-        ELSE
-            agesno(i)=0.0
-        END IF
-        ! snow albedo
-        alb_snow=alb_sno_min+alb_sno_del*EXP(-agesno(i)/50.)
-        ! ice albedo (varies with ice tkickness and temp)
-        alb_ice=MAX(0.0,0.13*LOG(100.*seaice(ki)/ice_den)+0.1)
-        IF (tice(ki).GT.t_freeze-0.01) THEN
-            alb_ice=MIN(alb_ice,alb_ice_wet)
-        ELSE
-            alb_ice=MIN(alb_ice,alb_ice_dry)
-        END IF
-        ! pond albedo
-        alb_pond=0.36-0.1*(2.0+MIN(0.0,MAX(tice(ki)-t_melt,-2.0)))
-        ! pond fraction
-        frac_pond=0.2*(2.0+MIN(0.0,MAX(tice(ki)-t_melt,-2.0)))
-        ! snow fraction
-        frac_snow=MAX(0.0,MIN(1.0-frac_pond,snow(i)/snow_min))
-        ! ice fraction
-        frac_ice=MAX(0.0,1.-frac_pond-frac_snow)
-        ! total albedo
-        alb1_new(i)=alb_snow*frac_snow+alb_ice*frac_ice+alb_pond*frac_pond
-    END DO
-    alb2_new(:) = alb1_new(:)
-
-!****************************************************************************************
-! 3) Recalculate new ocean temperature (add fluxes below ice)
-!    Melt / freeze from below
-!***********************************************o*****************************************
-    !cumul fluxes
-    bilg_cum(:)=bilg_cum(:)+slab_bilg(:)
-    IF (MOD(itime,cpl_pas).EQ.0) THEN ! time to update tslab & fraction
-        ! Add cumulated surface fluxes
-        tslab(:,1)=tslab(:,1)+bilg_cum(:)*cyang*dtime
-        DO i=1,knon
-            ki=knindex(i)
-            ! split lateral/top melt-freeze
-            frac_mf=MIN(1.,MAX(0.,(seaice(ki)-h_ice_thin)/(h_ice_thick-h_ice_thin)))
-            IF (tslab(ki,1).LE.t_freeze) THEN 
-               ! ****** Form new ice from below *******
-               ! quantity of new ice
-                e_melt=(t_freeze-tslab(ki,1))/cyang & 
-                       /(ice_lat+ice_cap/2.*(t_freeze-tice(ki)))
-               ! first increase height to h_thin
-               dhsic=MAX(0.,MIN(h_ice_thin-seaice(ki),e_melt/fsic(ki)))
-               seaice(ki)=dhsic+seaice(ki)
-               e_melt=e_melt-fsic(ki)*dhsic
-               IF (e_melt.GT.0.) THEN
-               ! frac_mf fraction used for lateral increase
-               dfsic=MIN(ice_frac_max-fsic(ki),e_melt*frac_mf/seaice(ki))
-               fsic(ki)=fsic(ki)+dfsic
-               e_melt=e_melt-dfsic*seaice(ki)
-               ! rest used to increase height
-               seaice(ki)=MIN(h_ice_max,seaice(ki)+e_melt/fsic(ki))
-               END IF
-               tslab(ki,1)=t_freeze
-           ELSE ! slab temperature above freezing
-               ! ****** melt ice from below *******
-               ! quantity of melted ice
-               e_melt=(tslab(ki,1)-t_freeze)/cyang & 
-                       /(ice_lat+ice_cap/2.*(tice(ki)-t_freeze))
-               ! first decrease height to h_thick
-               dhsic=MAX(0.,MIN(seaice(ki)-h_ice_thick,e_melt/fsic(ki)))
-               seaice(ki)=seaice(ki)-dhsic
-               e_melt=e_melt-fsic(ki)*dhsic
-               IF (e_melt.GT.0) THEN
-               ! frac_mf fraction used for height decrease
-               dhsic=MAX(0.,MIN(seaice(ki)-h_ice_min,e_melt*frac_mf/fsic(ki)))
-               seaice(ki)=seaice(ki)-dhsic
-               e_melt=e_melt-fsic(ki)*dhsic
-               ! rest used to decrease fraction (up to 0!)
-               dfsic=MIN(fsic(ki),e_melt/seaice(ki))
-               ! keep remaining in ocean
-               e_melt=e_melt-dfsic*seaice(ki)
-               END IF
-               tslab(ki,1)=t_freeze+e_melt*ice_lat*cyang
-               fsic(ki)=fsic(ki)-dfsic
-           END IF
-        END DO
-        bilg_cum(:)=0.
-    END IF ! coupling time
-    
-    !tests ice fraction 
-    WHERE (fsic.LT.ice_frac_min)
-        tslab(:,1)=tslab(:,1)-fsic*seaice*ice_lat*cyang
-        tice=t_melt
-        fsic=0.
-        seaice=0.
-    END WHERE
-
-  END SUBROUTINE ocean_slab_ice
-!
-!****************************************************************************************
-!
-  SUBROUTINE ocean_slab_final
-
-!****************************************************************************************
-! Deallocate module variables
-!****************************************************************************************
-    IF (ALLOCATED(tslab)) DEALLOCATE(tslab)
-    IF (ALLOCATED(fsic)) DEALLOCATE(fsic)
-    IF (ALLOCATED(tice)) DEALLOCATE(tice)
-    IF (ALLOCATED(seaice)) DEALLOCATE(seaice)
-    IF (ALLOCATED(slab_bilg)) DEALLOCATE(slab_bilg)
-    IF (ALLOCATED(bilg_cum)) DEALLOCATE(bilg_cum)
-    IF (ALLOCATED(bils_cum)) DEALLOCATE(bils_cum)
-    IF (ALLOCATED(taux_cum)) DEALLOCATE(taux_cum)
-    IF (ALLOCATED(tauy_cum)) DEALLOCATE(tauy_cum)
-    IF (ALLOCATED(dt_ekman)) DEALLOCATE(dt_ekman)
-    IF (ALLOCATED(dt_hdiff)) DEALLOCATE(dt_hdiff)
-    IF (ALLOCATED(dt_gm)) DEALLOCATE(dt_gm)
-    IF (ALLOCATED(dt_qflux)) DEALLOCATE(dt_qflux)
-
-  END SUBROUTINE ocean_slab_final
-
-END MODULE ocean_slab_mod
+link ../phylmd/ocean_slab_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/open_climoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/open_climoz_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/open_climoz_m.F90	(revision 3940)
@@ -1,101 +1,1 @@
-! $Id$
-MODULE open_climoz_m
-
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE open_climoz(ncid, press_in_cen, press_in_edg, time_in, daily, adjust)
-!
-!-------------------------------------------------------------------------------
-  USE netcdf95, ONLY: nf95_open, nf95_close, nf95_gw_var, nf95_inq_varid
-  USE netcdf,   ONLY: nf90_nowrite
-  USE mod_phys_lmdz_mpi_data,      ONLY: is_mpi_root
-  USE mod_phys_lmdz_mpi_transfert, ONLY: bcast_mpi
-  USE phys_cal_mod,                ONLY: calend, year_len, year_cur
-!-------------------------------------------------------------------------------
-! Purpose: This procedure should be called once per "gcm" run, by a single
-!          thread of each MPI process.
-!          The root MPI process opens "climoz_LMDZ.nc", reads the pressure
-! levels and the times and broadcasts them to the other processes.
-!          We assume that, in "climoz_LMDZ.nc", the pressure levels are in hPa
-! and in strictly ascending order.
-!-------------------------------------------------------------------------------
-! Arguments (OpenMP shared):
-  INTEGER, INTENT(OUT):: ncid      !--- "climoz_LMDZ.nc" identifier
-  REAL, POINTER :: press_in_cen(:) !--- at cells centers
-  REAL, POINTER :: press_in_edg(:) !--- at the interfaces (pressure intervals)
-  REAL, POINTER :: time_in(:)      !--- records times, in days since Jan. 1st
-  LOGICAL, INTENT(IN) :: daily     !--- daily files (calendar dependent days nb)
-  LOGICAL, INTENT(IN) :: adjust    !--- tropopause adjustement required
-!   pressure levels press_in_cen/edg are in Pa a,d strictly ascending order.
-!   time_in is only used for monthly files (14 records)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: varid                 !--- NetCDF variables identifier
-  INTEGER :: nlev, ntim            !--- pressure levels and time records numbers
-  CHARACTER(LEN=80)  :: sub
-  CHARACTER(LEN=320) :: msg
-!-------------------------------------------------------------------------------
-  sub="open_climoz"
-  WRITE(lunout,*)"Entering routine "//TRIM(sub)
-
-  IF(is_mpi_root) THEN
-
-    !--- OPEN FILE, READ PRESSURE LEVELS AND TIME VECTOR
-    CALL nf95_open("climoz_LMDZ.nc", nf90_nowrite, ncid)
-    CALL nf95_inq_varid(ncid, "plev", varid)
-    CALL nf95_gw_var(ncid, varid, press_in_cen)
-    ! Convert from hPa to Pa because "paprs" and "pplay" are in Pa:
-    press_in_cen = press_in_cen * 100.
-    nlev = SIZE(press_in_cen)
-    CALL NF95_INQ_VARID(ncID, "time", varID)
-    CALL NF95_GW_VAR(ncid, varid, time_in)
-    ntim = SIZE(time_in)
-
-    !--- BUILD EDGES OF PRESSURE INTERVALS: HALFWAY IN LOGARITHMS
-    ALLOCATE(press_in_edg(nlev+1))
-    press_in_edg=[0.,SQRT(press_in_cen(1:nlev-1)*press_in_cen(2:nlev)),HUGE(0.)]
-
-    !--- CHECK RECORDS NUMBER AND DISPLAY CORRESPONDING INFORMATION
-    IF(daily.AND.ntim/=year_len) THEN
-      WRITE(msg,'(a,3(i4,a))')TRIM(sub)//': Expecting a daily ozone file with',&
-     &year_len,' records (year ',year_cur,') ; found ',ntim,' instead'
-      CALL abort_physic(sub, msg, 1)
-    ELSE IF(ALL([360,14]/=ntim)) THEN
-      WRITE(msg,'(a,i4,a)')TRIM(sub)//': Expecting an ozone file with 14 (mont'&
-     &//'hly case) or 360 (old style files) records ; found ',ntim,' instead'
-      CALL abort_physic(sub, msg, 1)
-    ELSE
-      IF(daily) THEN
-         WRITE(msg,'(a,2(i4,a))')'daily file (',ntim,' days in ',year_cur,')'
-       ELSE IF(ntim==14) THEN
-         msg='14 records monthly file'
-       ELSE
-         msg='360 records files (old convention)'
-       END IF
-      WRITE(lunout,*)TRIM(sub)//': Using a '//TRIM(msg)
-    END IF
-
-    !--- MESSAGE ABOUT OPTIONAL STRETCHING FOR TROPOPAUSES MATCHING
-    IF(adjust) THEN
-      WRITE(lunout,*)TRIM(sub)//': Adjusting O3 field to match gcm tropopause.'
-    ELSE
-      WRITE(lunout,*)TRIM(sub)//': Interpolating O3 field directly on gcm levels.'
-    END IF
-
-  END IF
-  CALL bcast_mpi(nlev)
-  IF(.NOT.is_mpi_root) ALLOCATE(press_in_cen(nlev  )); CALL bcast_mpi(press_in_cen)
-  IF(.NOT.is_mpi_root) ALLOCATE(press_in_edg(nlev+1)); CALL bcast_mpi(press_in_edg)
-  CALL bcast_mpi(ntim)
-  IF(.NOT.is_mpi_root) ALLOCATE(time_in(ntim));        CALL bcast_mpi(time_in)
-
-END SUBROUTINE open_climoz
-!
-!-------------------------------------------------------------------------------
-
-END MODULE open_climoz_m
+link ../phylmd/open_climoz_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/orbite.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/orbite.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/orbite.F90	(revision 3940)
@@ -1,294 +1,1 @@
-
-! $Header$
-
-! ======================================================================
-SUBROUTINE orbite(xjour, longi, dist)
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) (adapte du GCM du LMD) date: 19930818
-  ! Objet: pour un jour donne, calculer la longitude vraie de la terre
-  ! (par rapport au point vernal-21 mars) dans son orbite solaire
-  ! calculer aussi la distance terre-soleil (unite astronomique)
-  ! ======================================================================
-  ! Arguments:
-  ! xjour--INPUT--R- jour de l'annee a compter du 1er janvier
-  ! longi--OUTPUT-R- longitude vraie en degres par rapport au point
-  ! vernal (21 mars) en degres
-  ! dist---OUTPUT-R- distance terre-soleil (par rapport a la moyenne)
-  REAL xjour, longi, dist
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! -- Variables dynamiques locales
-  REAL pir, xl, xllp, xee, xse, xlam, dlamm, anm, ranm, anv, ranv
-
-  pir = 4.0*atan(1.0)/180.0
-  xl = r_peri + 180.0
-  xllp = xl*pir
-  xee = r_ecc*r_ecc
-  xse = sqrt(1.0-xee)
-  xlam = (r_ecc/2.0+r_ecc*xee/8.0)*(1.0+xse)*sin(xllp) - &
-    xee/4.0*(0.5+xse)*sin(2.0*xllp) + r_ecc*xee/8.0*(1.0/3.0+xse)*sin(3.0* &
-    xllp)
-  xlam = 2.0*xlam/pir
-  dlamm = xlam + (xjour-81.0)
-  anm = dlamm - xl
-  ranm = anm*pir
-  xee = xee*r_ecc
-  ranv = ranm + (2.0*r_ecc-xee/4.0)*sin(ranm) + 5.0/4.0*r_ecc*r_ecc*sin(2.0* &
-    ranm) + 13.0/12.0*xee*sin(3.0*ranm)
-
-  anv = ranv/pir
-  longi = anv + xl
-
-  dist = (1-r_ecc*r_ecc)/(1+r_ecc*cos(pir*(longi-(r_peri+180.0))))
-  RETURN
-END SUBROUTINE orbite
-! ======================================================================
-SUBROUTINE angle(longi, lati, frac, muzero)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-  ! Objet: Calculer la duree d'ensoleillement pour un jour et la hauteur
-  ! du soleil (cosinus de l'angle zinithal) moyenne sur la journee
-  ! ======================================================================
-  ! Arguments:
-  ! longi----INPUT-R- la longitude vraie de la terre dans son plan
-  ! solaire a partir de l'equinoxe de printemps (degre)
-  ! lati-----INPUT-R- la latitude d'un point sur la terre (degre)
-  ! frac-----OUTPUT-R la duree d'ensoleillement dans la journee divisee
-  ! par 24 heures (unite en fraction de 0 a 1)
-  ! muzero---OUTPUT-R la moyenne du cosinus de l'angle zinithal sur
-  ! la journee (0 a 1)
-  ! ======================================================================
-  REAL longi
-  REAL lati(klon), frac(klon), muzero(klon)
-  include "YOMCST.h"
-  REAL lat, omega, lon_sun, lat_sun
-  REAL pi_local, incl
-  INTEGER i
-
-  pi_local = 4.0*atan(1.0)
-  incl = r_incl*pi_local/180.
-
-  lon_sun = longi*pi_local/180.0
-  lat_sun = asin(sin(lon_sun)*sin(incl))
-
-  DO i = 1, klon
-    lat = lati(i)*pi_local/180.0
-
-    IF (lat>=(pi_local/2.+lat_sun) .OR. lat<=(-pi_local/2.+lat_sun)) THEN
-      omega = 0.0 ! nuit polaire
-    ELSE IF (lat>=(pi_local/2.-lat_sun) .OR. lat<=(-pi_local/2.-lat_sun)) &
-        THEN
-      omega = pi_local ! journee polaire
-    ELSE
-      omega = -tan(lat)*tan(lat_sun)
-      omega = acos(omega)
-    END IF
-
-    frac(i) = omega/pi_local
-
-    IF (omega>0.0) THEN
-      muzero(i) = sin(lat)*sin(lat_sun) + cos(lat)*cos(lat_sun)*sin(omega)/ &
-        omega
-    ELSE
-      muzero(i) = 0.0
-    END IF
-  END DO
-
-  RETURN
-END SUBROUTINE angle
-! ====================================================================
-SUBROUTINE zenang(longi, gmtime, pdtrad1, pdtrad2, lat, long, pmu0, frac)
-  USE dimphy
-  IMPLICIT NONE
-  ! =============================================================
-  ! Auteur : O. Boucher (LMD/CNRS)
-  ! d'apres les routines zenith et angle de Z.X. Li
-  ! Objet  : calculer les valeurs moyennes du cos de l'angle zenithal
-  ! et l'ensoleillement moyen entre gmtime1 et gmtime2
-  ! connaissant la declinaison, la latitude et la longitude.
-  ! Rque   : Different de la routine angle en ce sens que zenang
-  ! fournit des moyennes de pmu0 et non des valeurs
-  ! instantanees, du coup frac prend toutes les valeurs
-  ! entre 0 et 1. La routine integre entre gmtime+pdtrad1 et 
-  ! gmtime+pdtrad2 avec pdtrad1 et pdtrad2 exprimes en secondes.
-  ! Date   : premiere version le 13 decembre 1994
-  ! revu pour  GCM  le 30 septembre 1996
-  ! revu le 3 septembre 2015 pour les bornes de l'integrale
-  ! ===============================================================
-  ! longi : la longitude vraie de la terre dans son plan
-  ! solaire a partir de l'equinoxe de printemps (degre)
-  ! gmtime : temps universel en fraction de jour
-  ! pdtrad1 : borne inferieure du pas de temps du rayonnement (secondes)
-  ! pdtrad2 : borne inferieure du pas de temps du rayonnement (secondes)
-  ! pdtrad2-pdtrad1 correspond a pdtrad, le pas de temps du rayonnement (secondes)
-  ! lat------INPUT : latitude en degres
-  ! long-----INPUT : longitude en degres
-  ! pmu0-----OUTPUT: angle zenithal moyen entre gmtime+pdtrad1 et gmtime+pdtrad2
-  ! frac-----OUTPUT: ensoleillement moyen entre gmtime+pdtrad1 et gmtime+pdtrad2
-  ! ================================================================
-  include "YOMCST.h"
-  ! ================================================================
-  REAL, INTENT (IN) :: longi, gmtime, pdtrad1, pdtrad2
-  REAL lat(klon), long(klon), pmu0(klon), frac(klon)
-  ! ================================================================
-  INTEGER i
-  REAL gmtime1, gmtime2
-  REAL pi_local, deux_pi_local, incl
-  REAL omega1, omega2, omega
-  ! omega1, omega2 : temps 1 et 2 exprime en radian avec 0 a midi.
-  ! omega : heure en radian du coucher de soleil
-  ! -omega est donc l'heure en radian de lever du soleil
-  REAL omegadeb, omegafin
-  REAL zfrac1, zfrac2, z1_mu, z2_mu
-  REAL lat_sun ! declinaison en radian
-  REAL lon_sun ! longitude solaire en radian
-  REAL latr    ! latitude du pt de grille en radian
-  ! ================================================================
-
-  pi_local = 4.0*atan(1.0)
-  deux_pi_local = 2.0*pi_local
-  incl = r_incl*pi_local/180.
-
-  lon_sun = longi*pi_local/180.0
-  lat_sun = asin(sin(lon_sun)*sin(incl))
-
-  gmtime1 = gmtime*86400. + pdtrad1
-  gmtime2 = gmtime*86400. + pdtrad2
-
-  DO i = 1, klon
-
-    latr = lat(i)*pi_local/180.
-
-    omega = 0.0 !--nuit polaire
-
-    IF (latr>=(pi_local/2.-lat_sun) .OR. latr<=(-pi_local/2.-lat_sun)) THEN
-      omega = pi_local ! journee polaire
-    END IF
-
-    IF (latr<(pi_local/2.+lat_sun) .AND. latr>(-pi_local/2.+lat_sun) .AND. &
-        latr<(pi_local/2.-lat_sun) .AND. latr>(-pi_local/2.-lat_sun)) THEN
-      omega = -tan(latr)*tan(lat_sun)
-      omega = acos(omega)
-    END IF
-
-    omega1 = gmtime1 + long(i)*86400.0/360.0
-    omega1 = omega1/86400.0*deux_pi_local
-    omega1 = mod(omega1+deux_pi_local, deux_pi_local)
-    omega1 = omega1 - pi_local
-
-    omega2 = gmtime2 + long(i)*86400.0/360.0
-    omega2 = omega2/86400.0*deux_pi_local
-    omega2 = mod(omega2+deux_pi_local, deux_pi_local)
-    omega2 = omega2 - pi_local
-
-    IF (omega1<=omega2) THEN !--on est dans la meme journee locale
-
-      IF (omega2<=-omega .OR. omega1>=omega .OR. omega<1E-5) THEN !--nuit
-        frac(i) = 0.0
-        pmu0(i) = 0.0
-      ELSE !--jour+nuit/jour
-        omegadeb = max(-omega, omega1)
-        omegafin = min(omega, omega2)
-        frac(i) = (omegafin-omegadeb)/(omega2-omega1)
-        pmu0(i) = sin(latr)*sin(lat_sun) + cos(latr)*cos(lat_sun)*(sin( &
-          omegafin)-sin(omegadeb))/(omegafin-omegadeb)
-      END IF
-
-    ELSE !---omega1 GT omega2 -- a cheval sur deux journees
-
-      ! -------------------entre omega1 et pi
-      IF (omega1>=omega) THEN !--nuit
-        zfrac1 = 0.0
-        z1_mu = 0.0
-      ELSE !--jour+nuit
-        omegadeb = max(-omega, omega1)
-        omegafin = omega
-        zfrac1 = omegafin - omegadeb
-        z1_mu = sin(latr)*sin(lat_sun) + cos(latr)*cos(lat_sun)*(sin(omegafin &
-          )-sin(omegadeb))/(omegafin-omegadeb)
-      END IF
-      ! ---------------------entre -pi et omega2
-      IF (omega2<=-omega) THEN !--nuit
-        zfrac2 = 0.0
-        z2_mu = 0.0
-      ELSE !--jour+nuit
-        omegadeb = -omega
-        omegafin = min(omega, omega2)
-        zfrac2 = omegafin - omegadeb
-        z2_mu = sin(latr)*sin(lat_sun) + cos(latr)*cos(lat_sun)*(sin(omegafin &
-          )-sin(omegadeb))/(omegafin-omegadeb)
-
-      END IF
-      ! -----------------------moyenne
-      frac(i) = (zfrac1+zfrac2)/(omega2+deux_pi_local-omega1)
-      pmu0(i) = (zfrac1*z1_mu+zfrac2*z2_mu)/max(zfrac1+zfrac2, 1.E-10)
-
-    END IF !---comparaison omega1 et omega2
-
-  END DO
-
-END SUBROUTINE zenang
-! ===================================================================
-SUBROUTINE zenith(longi, gmtime, lat, long, pmu0, fract)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! Auteur(s): Z.X. Li (LMD/ENS)
-
-  ! Objet: calculer le cosinus de l'angle zenithal du soleil en
-  ! connaissant la declinaison du soleil, la latitude et la
-  ! longitude du point sur la terre, et le temps universel
-
-  ! Arguments d'entree:
-  ! longi  : declinaison du soleil (en degres)
-  ! gmtime : temps universel en second qui varie entre 0 et 86400
-  ! lat    : latitude en degres
-  ! long   : longitude en degres
-  ! Arguments de sortie:
-  ! pmu0   : cosinus de l'angle zenithal
-
-  ! ====================================================================
-  include "YOMCST.h"
-  ! ====================================================================
-  REAL longi, gmtime
-  REAL lat(klon), long(klon), pmu0(klon), fract(klon)
-  ! =====================================================================
-  INTEGER n
-  REAL zpi, zpir, omega, zgmtime
-  REAL incl, lat_sun, lon_sun
-  ! ----------------------------------------------------------------------
-  zpi = 4.0*atan(1.0)
-  zpir = zpi/180.0
-  zgmtime = gmtime*86400.
-
-  incl = r_incl*zpir
-
-  lon_sun = longi*zpir
-  lat_sun = asin(sin(lon_sun)*sin(incl))
-
-  ! --initialisation a la nuit
-
-  DO n = 1, klon
-    pmu0(n) = 0.
-    fract(n) = 0.0
-  END DO
-
-  ! 1 degre en longitude = 240 secondes en temps
-
-  DO n = 1, klon
-    omega = zgmtime + long(n)*86400.0/360.0
-    omega = omega/86400.0*2.0*zpi
-    omega = mod(omega+2.0*zpi, 2.0*zpi)
-    omega = omega - zpi
-    pmu0(n) = sin(lat(n)*zpir)*sin(lat_sun) + cos(lat(n)*zpir)*cos(lat_sun)* &
-      cos(omega)
-    pmu0(n) = max(pmu0(n), 0.0)
-    IF (pmu0(n)>1.E-6) fract(n) = 1.0
-  END DO
-
-  RETURN
-END SUBROUTINE zenith
+link ../phylmd/orbite.F90
Index: LMDZ6/trunk/libf/phylmdiso/orografi.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/orografi.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/orografi.F90	(revision 3940)
@@ -1,1681 +1,1 @@
-
-! $Id: orografi.F90 2357 2015-08-31 16:25:19Z lguez $
-
-SUBROUTINE drag_noro(nlon, nlev, dtime, paprs, pplay, pmea, pstd, psig, pgam, &
-    pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, pustr, pvstr, &
-    d_t, d_u, d_v)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201
-  ! Objet: Frottement de la montagne Interface
-  ! ======================================================================
-  ! Arguments:
-  ! dtime---input-R- pas d'integration (s)
-  ! paprs---input-R-pression pour chaque inter-couche (en Pa)
-  ! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-  ! t-------input-R-temperature (K)
-  ! u-------input-R-vitesse horizontale (m/s)
-  ! v-------input-R-vitesse horizontale (m/s)
-
-  ! d_t-----output-R-increment de la temperature
-  ! d_u-----output-R-increment de la vitesse u
-  ! d_v-----output-R-increment de la vitesse v
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! ARGUMENTS
-
-  INTEGER nlon, nlev
-  REAL dtime
-  REAL paprs(klon, klev+1)
-  REAL pplay(klon, klev)
-  REAL pmea(nlon), pstd(nlon), psig(nlon), pgam(nlon), pthe(nlon)
-  REAL ppic(nlon), pval(nlon)
-  REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)
-  REAL t(nlon, nlev), u(nlon, nlev), v(nlon, nlev)
-  REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev)
-
-  INTEGER i, k, kgwd, kdx(nlon), ktest(nlon)
-
-  ! Variables locales:
-
-  REAL zgeom(klon, klev)
-  REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev)
-  REAL pt(klon, klev), pu(klon, klev), pv(klon, klev)
-  REAL papmf(klon, klev), papmh(klon, klev+1)
-
-  ! initialiser les variables de sortie (pour securite)
-
-  DO i = 1, klon
-    pulow(i) = 0.0
-    pvlow(i) = 0.0
-    pustr(i) = 0.0
-    pvstr(i) = 0.0
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_u(i, k) = 0.0
-      d_v(i, k) = 0.0
-      pdudt(i, k) = 0.0
-      pdvdt(i, k) = 0.0
-      pdtdt(i, k) = 0.0
-    END DO
-  END DO
-
-  ! preparer les variables d'entree (attention: l'ordre des niveaux
-  ! verticaux augmente du haut vers le bas)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      pt(i, k) = t(i, klev-k+1)
-      pu(i, k) = u(i, klev-k+1)
-      pv(i, k) = v(i, klev-k+1)
-      papmf(i, k) = pplay(i, klev-k+1)
-    END DO
-  END DO
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      papmh(i, k) = paprs(i, klev-k+2)
-    END DO
-  END DO
-  DO i = 1, klon
-    zgeom(i, klev) = rd*pt(i, klev)*log(papmh(i,klev+1)/papmf(i,klev))
-  END DO
-  DO k = klev - 1, 1, -1
-    DO i = 1, klon
-      zgeom(i, k) = zgeom(i, k+1) + rd*(pt(i,k)+pt(i,k+1))/2.0*log(papmf(i,k+ &
-        1)/papmf(i,k))
-    END DO
-  END DO
-
-  ! appeler la routine principale
-
-  CALL orodrag(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, zgeom, pt, &
-    pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, pvlow, pdudt, &
-    pdvdt, pdtdt)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_u(i, klev+1-k) = dtime*pdudt(i, k)
-      d_v(i, klev+1-k) = dtime*pdvdt(i, k)
-      d_t(i, klev+1-k) = dtime*pdtdt(i, k)
-      pustr(i) = pustr(i) &        ! IM BUG  .
-                                   ! +rg*pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))
-        +pdudt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-      pvstr(i) = pvstr(i) &        ! IM BUG  .
-                                   ! +rg*pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))
-        +pdvdt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE drag_noro
-SUBROUTINE orodrag(nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, papm1, &
-    pgeom1, ptm1, pum1, pvm1, pmea, pstd, psig, pgamma, ptheta, ppic, pval &
-  ! outputs
-    , pulow, pvlow, pvom, pvol, pte)
-
-  USE dimphy
-  IMPLICIT NONE
-
-
-
-  ! **** *gwdrag* - does the gravity wave parametrization.
-
-  ! purpose.
-  ! --------
-
-  ! this routine computes the physical tendencies of the
-  ! prognostic variables u,v  and t due to  vertical transports by
-  ! subgridscale orographically excited gravity waves
-
-  ! **   interface.
-  ! ----------
-  ! called from *callpar*.
-
-  ! the routine takes its input from the long-term storage:
-  ! u,v,t and p at t-1.
-
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-  ! ==== outputs ===
-
-  ! implicit arguments :   none
-  ! --------------------
-
-  ! implicit logical (l)
-
-  ! method.
-  ! -------
-
-  ! externals.
-  ! ----------
-  INTEGER ismin, ismax
-  EXTERNAL ismin, ismax
-
-  ! reference.
-  ! ----------
-
-  ! author.
-  ! -------
-  ! m.miller + b.ritter   e.c.m.w.f.     15/06/86.
-
-  ! f.lott + m. miller    e.c.m.w.f.     22/11/94
-  ! -----------------------------------------------------------------------
-
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   arguments
-  ! ---------
-
-
-  ! ym      integer nlon, nlev, klevm1
-  INTEGER nlon, nlev
-  INTEGER kgwd, jl, ilevp1, jk, ji
-  REAL zdelp, ztemp, zforc, ztend
-  REAL rover, zb, zc, zconb, zabsv
-  REAL zzd1, ratio, zbet, zust, zvst, zdis
-  REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(klon), &
-    pvlow(klon)
-  REAL pum1(nlon, nlev), pvm1(nlon, nlev), ptm1(nlon, nlev), pmea(nlon), &
-    pstd(nlon), psig(nlon), pgamma(nlon), ptheta(nlon), ppic(nlon), &
-    pval(nlon), pgeom1(nlon, nlev), papm1(nlon, nlev), paphm1(nlon, nlev+1)
-
-  INTEGER kdx(nlon), ktest(nlon)
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-  ! ------------
-  INTEGER isect(klon), icrit(klon), ikcrith(klon), ikenvh(klon), iknu(klon), &
-    iknu2(klon), ikcrit(klon), ikhlim(klon)
-
-  REAL ztau(klon, klev+1), ztauf(klon, klev+1), zstab(klon, klev+1), &
-    zvph(klon, klev+1), zrho(klon, klev+1), zri(klon, klev+1), &
-    zpsi(klon, klev+1), zzdep(klon, klev)
-  REAL zdudt(klon), zdvdt(klon), zdtdt(klon), zdedt(klon), zvidis(klon), &
-    znu(klon), zd1(klon), zd2(klon), zdmod(klon)
-  REAL ztmst, ptsphy, zrtmst
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.    initialization
-  ! --------------
-
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.1   computational constants
-  ! -----------------------
-
-
-  ! ztmst=twodt
-  ! if(nstep.eq.nstart) ztmst=0.5*twodt
-  ! ym      klevm1=klev-1
-  ztmst = ptsphy
-  zrtmst = 1./ztmst
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.3   check whether row contains point for printing
-  ! ---------------------------------------------
-
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.     precompute basic state variables.
-  ! *                ---------- ----- ----- ----------
-  ! *                define low level wind, project winds in plane of
-  ! *                low level wind, determine sector in which to take
-  ! *                the variance and set indicator for critical levels.
-
-
-
-
-  CALL orosetup(nlon, ktest, ikcrit, ikcrith, icrit, ikenvh, iknu, iknu2, &
-    paphm1, papm1, pum1, pvm1, ptm1, pgeom1, pstd, zrho, zri, zstab, ztau, &
-    zvph, zpsi, zzdep, pulow, pvlow, ptheta, pgamma, pmea, ppic, pval, znu, &
-    zd1, zd2, zdmod)
-
-  ! ***********************************************************
-
-
-  ! *         3.      compute low level stresses using subcritical and
-  ! *                 supercritical forms.computes anisotropy coefficient
-  ! *                 as measure of orographic twodimensionality.
-
-
-  CALL gwstress(nlon, nlev, ktest, icrit, ikenvh, iknu, zrho, zstab, zvph, &
-    pstd, psig, pmea, ppic, ztau, pgeom1, zdmod)
-
-  ! *         4.      compute stress profile.
-  ! *                 ------- ------ --------
-
-
-
-  CALL gwprofil(nlon, nlev, kgwd, kdx, ktest, ikcrith, icrit, paphm1, zrho, &
-    zstab, zvph, zri, ztau, zdmod, psig, pstd)
-
-  ! *         5.      compute tendencies.
-  ! *                 -------------------
-
-
-  ! explicit solution at all levels for the gravity wave
-  ! implicit solution for the blocked levels
-
-  DO jl = kidia, kfdia
-    zvidis(jl) = 0.0
-    zdudt(jl) = 0.0
-    zdvdt(jl) = 0.0
-    zdtdt(jl) = 0.0
-  END DO
-
-  ilevp1 = klev + 1
-
-
-  DO jk = 1, klev
-
-
-    ! do 523 jl=1,kgwd
-    ! ji=kdx(jl)
-    ! Modif vectorisation 02/04/2004
-    DO ji = kidia, kfdia
-      IF (ktest(ji)==1) THEN
-
-        zdelp = paphm1(ji, jk+1) - paphm1(ji, jk)
-        ztemp = -rg*(ztau(ji,jk+1)-ztau(ji,jk))/(zvph(ji,ilevp1)*zdelp)
-        zdudt(ji) = (pulow(ji)*zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
-        zdvdt(ji) = (pvlow(ji)*zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
-
-        ! controle des overshoots:
-
-        zforc = sqrt(zdudt(ji)**2+zdvdt(ji)**2) + 1.E-12
-        ztend = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/ztmst + 1.E-12
-        rover = 0.25
-        IF (zforc>=rover*ztend) THEN
-          zdudt(ji) = rover*ztend/zforc*zdudt(ji)
-          zdvdt(ji) = rover*ztend/zforc*zdvdt(ji)
-        END IF
-
-        ! fin du controle des overshoots
-
-        IF (jk>=ikenvh(ji)) THEN
-          zb = 1.0 - 0.18*pgamma(ji) - 0.04*pgamma(ji)**2
-          zc = 0.48*pgamma(ji) + 0.3*pgamma(ji)**2
-          zconb = 2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji))
-          zabsv = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
-          zzd1 = zb*cos(zpsi(ji,jk))**2 + zc*sin(zpsi(ji,jk))**2
-          ratio = (cos(zpsi(ji,jk))**2+pgamma(ji)*sin(zpsi(ji, &
-            jk))**2)/(pgamma(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
-          zbet = max(0., 2.-1./ratio)*zconb*zzdep(ji, jk)*zzd1*zabsv
-
-          ! simplement oppose au vent
-
-          zdudt(ji) = -pum1(ji, jk)/ztmst
-          zdvdt(ji) = -pvm1(ji, jk)/ztmst
-
-          ! projection dans la direction de l'axe principal de l'orographie
-          ! mod     zdudt(ji)=-(pum1(ji,jk)*cos(ptheta(ji)*rpi/180.)
-          ! mod *              +pvm1(ji,jk)*sin(ptheta(ji)*rpi/180.))
-          ! mod *              *cos(ptheta(ji)*rpi/180.)/ztmst
-          ! mod     zdvdt(ji)=-(pum1(ji,jk)*cos(ptheta(ji)*rpi/180.)
-          ! mod *              +pvm1(ji,jk)*sin(ptheta(ji)*rpi/180.))
-          ! mod *              *sin(ptheta(ji)*rpi/180.)/ztmst
-          zdudt(ji) = zdudt(ji)*(zbet/(1.+zbet))
-          zdvdt(ji) = zdvdt(ji)*(zbet/(1.+zbet))
-        END IF
-        pvom(ji, jk) = zdudt(ji)
-        pvol(ji, jk) = zdvdt(ji)
-        zust = pum1(ji, jk) + ztmst*zdudt(ji)
-        zvst = pvm1(ji, jk) + ztmst*zdvdt(ji)
-        zdis = 0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)
-        zdedt(ji) = zdis/ztmst
-        zvidis(ji) = zvidis(ji) + zdis*zdelp
-        zdtdt(ji) = zdedt(ji)/rcpd
-        ! pte(ji,jk)=zdtdt(ji)
-
-        ! ENCORE UN TRUC POUR EVITER LES EXPLOSIONS
-
-        pte(ji, jk) = 0.0
-
-      END IF
-    END DO
-
-  END DO
-
-
-  RETURN
-END SUBROUTINE orodrag
-SUBROUTINE orosetup(nlon, ktest, kkcrit, kkcrith, kcrit, kkenvh, kknu, kknu2, &
-    paphm1, papm1, pum1, pvm1, ptm1, pgeom1, pstd, prho, pri, pstab, ptau, &
-    pvph, ppsi, pzdep, pulow, pvlow, ptheta, pgamma, pmea, ppic, pval, pnu, &
-    pd1, pd2, pdmod)
-
-  ! **** *gwsetup*
-
-  ! purpose.
-  ! --------
-
-  ! **   interface.
-  ! ----------
-  ! from *orodrag*
-
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-  ! ==== outputs ===
-
-  ! implicit arguments :   none
-  ! --------------------
-
-  ! method.
-  ! -------
-
-
-  ! externals.
-  ! ----------
-
-
-  ! reference.
-  ! ----------
-
-  ! see ecmwf research department documentation of the "i.f.s."
-
-  ! author.
-  ! -------
-
-  ! modifications.
-  ! --------------
-  ! f.lott  for the new-gwdrag scheme november 1993
-
-  ! -----------------------------------------------------------------------
-  USE dimphy
-  IMPLICIT NONE
-
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   arguments
-  ! ---------
-
-  INTEGER nlon
-  INTEGER jl, jk
-  REAL zdelp
-
-  INTEGER kkcrit(nlon), kkcrith(nlon), kcrit(nlon), ktest(nlon), kkenvh(nlon)
-
-
-  REAL paphm1(nlon, klev+1), papm1(nlon, klev), pum1(nlon, klev), &
-    pvm1(nlon, klev), ptm1(nlon, klev), pgeom1(nlon, klev), &
-    prho(nlon, klev+1), pri(nlon, klev+1), pstab(nlon, klev+1), &
-    ptau(nlon, klev+1), pvph(nlon, klev+1), ppsi(nlon, klev+1), &
-    pzdep(nlon, klev)
-  REAL pulow(nlon), pvlow(nlon), ptheta(nlon), pgamma(nlon), pnu(nlon), &
-    pd1(nlon), pd2(nlon), pdmod(nlon)
-  REAL pstd(nlon), pmea(nlon), ppic(nlon), pval(nlon)
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-  ! ------------
-
-
-  INTEGER ilevm1, ilevm2, ilevh
-  REAL zcons1, zcons2, zcons3, zhgeo
-  REAL zu, zphi, zvt1, zvt2, zst, zvar, zdwind, zwind
-  REAL zstabm, zstabp, zrhom, zrhop, alpha
-  REAL zggeenv, zggeom1, zgvar
-  LOGICAL lo
-  LOGICAL ll1(klon, klev+1)
-  INTEGER kknu(klon), kknu2(klon), kknub(klon), kknul(klon), kentp(klon), &
-    ncount(klon)
-
-  REAL zhcrit(klon, klev), zvpf(klon, klev), zdp(klon, klev)
-  REAL znorm(klon), zb(klon), zc(klon), zulow(klon), zvlow(klon), znup(klon), &
-    znum(klon)
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.    initialization
-  ! --------------
-
-  ! print *,' entree gwsetup'
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.1   computational constants
-  ! -----------------------
-
-
-  ilevm1 = klev - 1
-  ilevm2 = klev - 2
-  ilevh = klev/3
-
-  zcons1 = 1./rd
-  ! old  zcons2=g**2/cpd
-  zcons2 = rg**2/rcpd
-  ! old  zcons3=1.5*api
-  zcons3 = 1.5*rpi
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.
-  ! --------------
-
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.1     define low level wind, project winds in plane of
-  ! *                 low level wind, determine sector in which to take
-  ! *                 the variance and set indicator for critical levels.
-
-
-
-  DO jl = kidia, kfdia
-    kknu(jl) = klev
-    kknu2(jl) = klev
-    kknub(jl) = klev
-    kknul(jl) = klev
-    pgamma(jl) = max(pgamma(jl), gtsec)
-    ll1(jl, klev+1) = .FALSE.
-  END DO
-
-  ! Ajouter une initialisation (L. Li, le 23fev99):
-
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      ll1(jl, jk) = .FALSE.
-    END DO
-  END DO
-
-  ! *      define top of low level flow
-  ! ----------------------------
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      lo = (paphm1(jl,jk)/paphm1(jl,klev+1)) >= gsigcr
-      IF (lo) THEN
-        kkcrit(jl) = jk
-      END IF
-      zhcrit(jl, jk) = ppic(jl)
-      zhgeo = pgeom1(jl, jk)/rg
-      ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-      IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-        kknu(jl) = jk
-      END IF
-      IF (.NOT. ll1(jl,ilevh)) kknu(jl) = ilevh
-    END DO
-  END DO
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      zhcrit(jl, jk) = ppic(jl) - pval(jl)
-      zhgeo = pgeom1(jl, jk)/rg
-      ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-      IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-        kknu2(jl) = jk
-      END IF
-      IF (.NOT. ll1(jl,ilevh)) kknu2(jl) = ilevh
-    END DO
-  END DO
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      zhcrit(jl, jk) = amax1(ppic(jl)-pmea(jl), pmea(jl)-pval(jl))
-      zhgeo = pgeom1(jl, jk)/rg
-      ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-      IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-        kknub(jl) = jk
-      END IF
-      IF (.NOT. ll1(jl,ilevh)) kknub(jl) = ilevh
-    END DO
-  END DO
-
-  DO jl = kidia, kfdia
-    kknu(jl) = min(kknu(jl), nktopg)
-    kknu2(jl) = min(kknu2(jl), nktopg)
-    kknub(jl) = min(kknub(jl), nktopg)
-    kknul(jl) = klev
-  END DO
-
-  ! c*     initialize various arrays
-
-  DO jl = kidia, kfdia
-    prho(jl, klev+1) = 0.0
-    pstab(jl, klev+1) = 0.0
-    pstab(jl, 1) = 0.0
-    pri(jl, klev+1) = 9999.0
-    ppsi(jl, klev+1) = 0.0
-    pri(jl, 1) = 0.0
-    pvph(jl, 1) = 0.0
-    pulow(jl) = 0.0
-    pvlow(jl) = 0.0
-    zulow(jl) = 0.0
-    zvlow(jl) = 0.0
-    kkcrith(jl) = klev
-    kkenvh(jl) = klev
-    kentp(jl) = klev
-    kcrit(jl) = 1
-    ncount(jl) = 0
-    ll1(jl, klev+1) = .FALSE.
-  END DO
-
-  ! *     define low-level flow
-  ! ---------------------
-
-  DO jk = klev, 2, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zdp(jl, jk) = papm1(jl, jk) - papm1(jl, jk-1)
-        prho(jl, jk) = 2.*paphm1(jl, jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
-        pstab(jl, jk) = 2.*zcons2/(ptm1(jl,jk)+ptm1(jl,jk-1))* &
-          (1.-rcpd*prho(jl,jk)*(ptm1(jl,jk)-ptm1(jl,jk-1))/zdp(jl,jk))
-        pstab(jl, jk) = max(pstab(jl,jk), gssec)
-      END IF
-    END DO
-  END DO
-
-  ! ********************************************************************
-
-  ! *     define blocked flow
-  ! -------------------
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      IF (jk>=kknub(jl) .AND. jk<=kknul(jl)) THEN
-        pulow(jl) = pulow(jl) + pum1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
-        pvlow(jl) = pvlow(jl) + pvm1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
-      END IF
-    END DO
-  END DO
-  DO jl = kidia, kfdia
-    pulow(jl) = pulow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknub(jl)))
-    pvlow(jl) = pvlow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknub(jl)))
-    znorm(jl) = max(sqrt(pulow(jl)**2+pvlow(jl)**2), gvsec)
-    pvph(jl, klev+1) = znorm(jl)
-  END DO
-
-  ! *******  setup orography axes and define plane of profiles  *******
-
-  DO jl = kidia, kfdia
-    lo = (pulow(jl)<gvsec) .AND. (pulow(jl)>=-gvsec)
-    IF (lo) THEN
-      zu = pulow(jl) + 2.*gvsec
-    ELSE
-      zu = pulow(jl)
-    END IF
-    zphi = atan(pvlow(jl)/zu)
-    ppsi(jl, klev+1) = ptheta(jl)*rpi/180. - zphi
-    zb(jl) = 1. - 0.18*pgamma(jl) - 0.04*pgamma(jl)**2
-    zc(jl) = 0.48*pgamma(jl) + 0.3*pgamma(jl)**2
-    pd1(jl) = zb(jl) - (zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
-    pd2(jl) = (zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))*cos(ppsi(jl,klev+1))
-    pdmod(jl) = sqrt(pd1(jl)**2+pd2(jl)**2)
-  END DO
-
-  ! ************ define flow in plane of lowlevel stress *************
-
-  DO jk = 1, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zvt1 = pulow(jl)*pum1(jl, jk) + pvlow(jl)*pvm1(jl, jk)
-        zvt2 = -pvlow(jl)*pum1(jl, jk) + pulow(jl)*pvm1(jl, jk)
-        zvpf(jl, jk) = (zvt1*pd1(jl)+zvt2*pd2(jl))/(znorm(jl)*pdmod(jl))
-      END IF
-      ptau(jl, jk) = 0.0
-      pzdep(jl, jk) = 0.0
-      ppsi(jl, jk) = 0.0
-      ll1(jl, jk) = .FALSE.
-    END DO
-  END DO
-  DO jk = 2, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zdp(jl, jk) = papm1(jl, jk) - papm1(jl, jk-1)
-        pvph(jl, jk) = ((paphm1(jl,jk)-papm1(jl,jk-1))*zvpf(jl,jk)+(papm1(jl, &
-          jk)-paphm1(jl,jk))*zvpf(jl,jk-1))/zdp(jl, jk)
-        IF (pvph(jl,jk)<gvsec) THEN
-          pvph(jl, jk) = gvsec
-          kcrit(jl) = jk
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! *         2.2     brunt-vaisala frequency and density at half levels.
-
-
-  DO jk = ilevh, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk>=(kknub(jl)+1) .AND. jk<=kknul(jl)) THEN
-          zst = zcons2/ptm1(jl, jk)*(1.-rcpd*prho(jl,jk)*(ptm1(jl, &
-            jk)-ptm1(jl,jk-1))/zdp(jl,jk))
-          pstab(jl, klev+1) = pstab(jl, klev+1) + zst*zdp(jl, jk)
-          pstab(jl, klev+1) = max(pstab(jl,klev+1), gssec)
-          prho(jl, klev+1) = prho(jl, klev+1) + paphm1(jl, jk)*2.*zdp(jl, jk) &
-            *zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  DO jl = kidia, kfdia
-    pstab(jl, klev+1) = pstab(jl, klev+1)/(papm1(jl,kknul(jl))-papm1(jl,kknub &
-      (jl)))
-    prho(jl, klev+1) = prho(jl, klev+1)/(papm1(jl,kknul(jl))-papm1(jl,kknub( &
-      jl)))
-    zvar = pstd(jl)
-  END DO
-
-  ! *         2.3     mean flow richardson number.
-  ! *                 and critical height for froude layer
-
-
-  DO jk = 2, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zdwind = max(abs(zvpf(jl,jk)-zvpf(jl,jk-1)), gvsec)
-        pri(jl, jk) = pstab(jl, jk)*(zdp(jl,jk)/(rg*prho(jl,jk)*zdwind))**2
-        pri(jl, jk) = max(pri(jl,jk), grcrit)
-      END IF
-    END DO
-  END DO
-
-
-
-  ! *      define top of 'envelope' layer
-  ! ----------------------------
-
-  DO jl = kidia, kfdia
-    pnu(jl) = 0.0
-    znum(jl) = 0.0
-  END DO
-
-  DO jk = 2, klev - 1
-    DO jl = kidia, kfdia
-
-      IF (ktest(jl)==1) THEN
-
-        IF (jk>=kknub(jl)) THEN
-
-          znum(jl) = pnu(jl)
-          zwind = (pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/ &
-            max(sqrt(pulow(jl)**2+pvlow(jl)**2), gvsec)
-          zwind = max(sqrt(zwind**2), gvsec)
-          zdelp = paphm1(jl, jk+1) - paphm1(jl, jk)
-          zstabm = sqrt(max(pstab(jl,jk),gssec))
-          zstabp = sqrt(max(pstab(jl,jk+1),gssec))
-          zrhom = prho(jl, jk)
-          zrhop = prho(jl, jk+1)
-          pnu(jl) = pnu(jl) + (zdelp/rg)*((zstabp/zrhop+zstabm/zrhom)/2.)/ &
-            zwind
-          IF ((znum(jl)<=gfrcrit) .AND. (pnu(jl)>gfrcrit) .AND. (kkenvh( &
-            jl)==klev)) kkenvh(jl) = jk
-
-        END IF
-
-      END IF
-
-    END DO
-  END DO
-
-  ! calculation of a dynamical mixing height for the breaking
-  ! of gravity waves:
-
-
-  DO jl = kidia, kfdia
-    znup(jl) = 0.0
-    znum(jl) = 0.0
-  END DO
-
-  DO jk = klev - 1, 2, -1
-    DO jl = kidia, kfdia
-
-      IF (ktest(jl)==1) THEN
-
-        znum(jl) = znup(jl)
-        zwind = (pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/ &
-          max(sqrt(pulow(jl)**2+pvlow(jl)**2), gvsec)
-        zwind = max(sqrt(zwind**2), gvsec)
-        zdelp = paphm1(jl, jk+1) - paphm1(jl, jk)
-        zstabm = sqrt(max(pstab(jl,jk),gssec))
-        zstabp = sqrt(max(pstab(jl,jk+1),gssec))
-        zrhom = prho(jl, jk)
-        zrhop = prho(jl, jk+1)
-        znup(jl) = znup(jl) + (zdelp/rg)*((zstabp/zrhop+zstabm/zrhom)/2.)/ &
-          zwind
-        IF ((znum(jl)<=rpi/2.) .AND. (znup(jl)>rpi/2.) .AND. (kkcrith( &
-          jl)==klev)) kkcrith(jl) = jk
-
-      END IF
-
-    END DO
-  END DO
-
-  DO jl = kidia, kfdia
-    kkcrith(jl) = min0(kkcrith(jl), kknu2(jl))
-    kkcrith(jl) = max0(kkcrith(jl), ilevh*2)
-  END DO
-
-  ! directional info for flow blocking *************************
-
-  DO jk = ilevh, klev
-    DO jl = kidia, kfdia
-      IF (jk>=kkenvh(jl)) THEN
-        lo = (pum1(jl,jk)<gvsec) .AND. (pum1(jl,jk)>=-gvsec)
-        IF (lo) THEN
-          zu = pum1(jl, jk) + 2.*gvsec
-        ELSE
-          zu = pum1(jl, jk)
-        END IF
-        zphi = atan(pvm1(jl,jk)/zu)
-        ppsi(jl, jk) = ptheta(jl)*rpi/180. - zphi
-      END IF
-    END DO
-  END DO
-  ! forms the vertical 'leakiness' **************************
-
-  alpha = 3.
-
-  DO jk = ilevh, klev
-    DO jl = kidia, kfdia
-      IF (jk>=kkenvh(jl)) THEN
-        zggeenv = amax1(1., (pgeom1(jl,kkenvh(jl))+pgeom1(jl, &
-          kkenvh(jl)-1))/2.)
-        zggeom1 = amax1(pgeom1(jl,jk), 1.)
-        zgvar = amax1(pstd(jl)*rg, 1.)
-        ! mod    pzdep(jl,jk)=sqrt((zggeenv-zggeom1)/(zggeom1+zgvar))
-        pzdep(jl, jk) = (pgeom1(jl,kkenvh(jl)-1)-pgeom1(jl,jk))/ &
-          (pgeom1(jl,kkenvh(jl)-1)-pgeom1(jl,klev))
-      END IF
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE orosetup
-SUBROUTINE gwstress(nlon, nlev, ktest, kcrit, kkenvh, kknu, prho, pstab, &
-    pvph, pstd, psig, pmea, ppic, ptau, pgeom1, pdmod)
-
-  ! **** *gwstress*
-
-  ! purpose.
-  ! --------
-
-  ! **   interface.
-  ! ----------
-  ! call *gwstress*  from *gwdrag*
-
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-  ! ==== outputs ===
-
-  ! implicit arguments :   none
-  ! --------------------
-
-  ! method.
-  ! -------
-
-
-  ! externals.
-  ! ----------
-
-
-  ! reference.
-  ! ----------
-
-  ! see ecmwf research department documentation of the "i.f.s."
-
-  ! author.
-  ! -------
-
-  ! modifications.
-  ! --------------
-  ! f. lott put the new gwd on ifs      22/11/93
-
-  ! -----------------------------------------------------------------------
-  USE dimphy
-  IMPLICIT NONE
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   arguments
-  ! ---------
-
-  INTEGER nlon, nlev
-  INTEGER kcrit(nlon), ktest(nlon), kkenvh(nlon), kknu(nlon)
-
-  REAL prho(nlon, nlev+1), pstab(nlon, nlev+1), ptau(nlon, nlev+1), &
-    pvph(nlon, nlev+1), pgeom1(nlon, nlev), pstd(nlon)
-
-  REAL psig(nlon)
-  REAL pmea(nlon), ppic(nlon)
-  REAL pdmod(nlon)
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-  ! ------------
-  INTEGER jl
-  REAL zblock, zvar, zeff
-  LOGICAL lo
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.3   functions
-  ! ---------
-  ! ------------------------------------------------------------------
-
-  ! *         1.    initialization
-  ! --------------
-
-
-  ! *         3.1     gravity wave stress.
-
-
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-
-      ! effective mountain height above the blocked flow
-
-      IF (kkenvh(jl)==klev) THEN
-        zblock = 0.0
-      ELSE
-        zblock = (pgeom1(jl,kkenvh(jl))+pgeom1(jl,kkenvh(jl)+1))/2./rg
-      END IF
-
-      zvar = ppic(jl) - pmea(jl)
-      zeff = amax1(0., zvar-zblock)
-
-      ptau(jl, klev+1) = prho(jl, klev+1)*gkdrag*psig(jl)*zeff**2/4./ &
-        pstd(jl)*pvph(jl, klev+1)*pdmod(jl)*sqrt(pstab(jl,klev+1))
-
-      ! too small value of stress or  low level flow include critical level
-      ! or low level flow:  gravity wave stress nul.
-
-      lo = (ptau(jl,klev+1)<gtsec) .OR. (kcrit(jl)>=kknu(jl)) .OR. &
-        (pvph(jl,klev+1)<gvcrit)
-      ! if(lo) ptau(jl,klev+1)=0.0
-
-    ELSE
-
-      ptau(jl, klev+1) = 0.0
-
-    END IF
-
-  END DO
-
-  RETURN
-END SUBROUTINE gwstress
-SUBROUTINE gwprofil(nlon, nlev, kgwd, kdx, ktest, kkcrith, kcrit, paphm1, &
-    prho, pstab, pvph, pri, ptau, pdmod, psig, pvar)
-
-  ! **** *GWPROFIL*
-
-  ! PURPOSE.
-  ! --------
-
-  ! **   INTERFACE.
-  ! ----------
-  ! FROM *GWDRAG*
-
-  ! EXPLICIT ARGUMENTS :
-  ! --------------------
-  ! ==== INPUTS ===
-  ! ==== OUTPUTS ===
-
-  ! IMPLICIT ARGUMENTS :   NONE
-  ! --------------------
-
-  ! METHOD:
-  ! -------
-  ! THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS:
-  ! IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND
-  ! AND THE TOP OF THE BLOCKED LAYER (KKENVH).
-  ! IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE
-  ! BLOCKED LAYER TO 3*VAROR (kKNU), TO SIMULATES LEE WAVES OR
-  ! NONLINEAR GRAVITY WAVE BREAKING.
-  ! ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL
-  ! LEVEL (KCRIT) OR WHEN IT BREAKS.
-
-
-
-  ! EXTERNALS.
-  ! ----------
-
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
-
-  ! AUTHOR.
-  ! -------
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93)
-  ! -----------------------------------------------------------------------
-  USE dimphy
-  IMPLICIT NONE
-
-
-
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   ARGUMENTS
-  ! ---------
-
-  INTEGER nlon, nlev
-  INTEGER kkcrith(nlon), kcrit(nlon), kdx(nlon), ktest(nlon)
-
-
-  REAL paphm1(nlon, nlev+1), pstab(nlon, nlev+1), prho(nlon, nlev+1), &
-    pvph(nlon, nlev+1), pri(nlon, nlev+1), ptau(nlon, nlev+1)
-
-  REAL pdmod(nlon), psig(nlon), pvar(nlon)
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   LOCAL ARRAYS
-  ! ------------
-
-  INTEGER ilevh, ji, kgwd, jl, jk
-  REAL zsqr, zalfa, zriw, zdel, zb, zalpha, zdz2n
-  REAL zdelp, zdelpt
-  REAL zdz2(klon, klev), znorm(klon), zoro(klon)
-  REAL ztau(klon, klev+1)
-
-  ! -----------------------------------------------------------------------
-
-  ! *         1.    INITIALIZATION
-  ! --------------
-
-  ! print *,' entree gwprofil'
-
-
-  ! *    COMPUTATIONAL CONSTANTS.
-  ! ------------- ----------
-
-  ilevh = klev/3
-
-  ! DO 400 ji=1,kgwd
-  ! jl=kdx(ji)
-  ! Modif vectorisation 02/04/2004
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      zoro(jl) = psig(jl)*pdmod(jl)/4./max(pvar(jl), 1.0)
-      ztau(jl, klev+1) = ptau(jl, klev+1)
-    END IF
-  END DO
-
-
-  DO jk = klev, 2, -1
-
-    ! *         4.1    CONSTANT WAVE STRESS UNTIL TOP OF THE
-    ! BLOCKING LAYER.
-
-    ! DO 411 ji=1,kgwd
-    ! jl=kdx(ji)
-    ! Modif vectorisation 02/04/2004
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk>kkcrith(jl)) THEN
-          ptau(jl, jk) = ztau(jl, klev+1)
-          ! ENDIF
-          ! IF(JK.EQ.KKCRITH(JL)) THEN
-        ELSE
-          ptau(jl, jk) = grahilo*ztau(jl, klev+1)
-        END IF
-      END IF
-    END DO
-
-    ! *         4.15   CONSTANT SHEAR STRESS UNTIL THE TOP OF THE
-    ! LOW LEVEL FLOW LAYER.
-
-
-    ! *         4.2    WAVE DISPLACEMENT AT NEXT LEVEL.
-
-
-    ! DO 421 ji=1,kgwd
-    ! jl=kdx(ji)
-    ! Modif vectorisation 02/04/2004
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk<kkcrith(jl)) THEN
-          znorm(jl) = gkdrag*prho(jl, jk)*sqrt(pstab(jl,jk))*pvph(jl, jk)* &
-            zoro(jl)
-          zdz2(jl, jk) = ptau(jl, jk+1)/max(znorm(jl), gssec)
-        END IF
-      END IF
-    END DO
-
-    ! *         4.3    WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT
-    ! *                AND STRESS:  BREAKING EVALUATION AND CRITICAL
-    ! LEVEL
-
-
-    ! DO 431 ji=1,kgwd
-    ! jl=Kdx(ji)
-    ! Modif vectorisation 02/04/2004
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-
-        IF (jk<kkcrith(jl)) THEN
-          IF ((ptau(jl,jk+1)<gtsec) .OR. (jk<=kcrit(jl))) THEN
-            ptau(jl, jk) = 0.0
-          ELSE
-            zsqr = sqrt(pri(jl,jk))
-            zalfa = sqrt(pstab(jl,jk)*zdz2(jl,jk))/pvph(jl, jk)
-            zriw = pri(jl, jk)*(1.-zalfa)/(1+zalfa*zsqr)**2
-            IF (zriw<grcrit) THEN
-              zdel = 4./zsqr/grcrit + 1./grcrit**2 + 4./grcrit
-              zb = 1./grcrit + 2./zsqr
-              zalpha = 0.5*(-zb+sqrt(zdel))
-              zdz2n = (pvph(jl,jk)*zalpha)**2/pstab(jl, jk)
-              ptau(jl, jk) = znorm(jl)*zdz2n
-            ELSE
-              ptau(jl, jk) = znorm(jl)*zdz2(jl, jk)
-            END IF
-            ptau(jl, jk) = min(ptau(jl,jk), ptau(jl,jk+1))
-          END IF
-        END IF
-      END IF
-    END DO
-
-  END DO
-
-  ! REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL
-
-  ! DO 530 ji=1,kgwd
-  ! jl=kdx(ji)
-  ! Modif vectorisation 02/04/2004
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      ztau(jl, kkcrith(jl)) = ptau(jl, kkcrith(jl))
-      ztau(jl, nstra) = ptau(jl, nstra)
-    END IF
-  END DO
-
-  DO jk = 1, klev
-
-    ! DO 532 ji=1,kgwd
-    ! jl=kdx(ji)
-    ! Modif vectorisation 02/04/2004
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-
-
-        IF (jk>kkcrith(jl)) THEN
-
-          zdelp = paphm1(jl, jk) - paphm1(jl, klev+1)
-          zdelpt = paphm1(jl, kkcrith(jl)) - paphm1(jl, klev+1)
-          ptau(jl, jk) = ztau(jl, klev+1) + (ztau(jl,kkcrith(jl))-ztau(jl, &
-            klev+1))*zdelp/zdelpt
-
-        END IF
-
-      END IF
-    END DO
-
-    ! REORGANISATION IN THE STRATOSPHERE
-
-    ! DO 533 ji=1,kgwd
-    ! jl=kdx(ji)
-    ! Modif vectorisation 02/04/2004
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-
-
-        IF (jk<nstra) THEN
-
-          zdelp = paphm1(jl, nstra)
-          zdelpt = paphm1(jl, jk)
-          ptau(jl, jk) = ztau(jl, nstra)*zdelpt/zdelp
-
-        END IF
-
-      END IF
-    END DO
-
-    ! REORGANISATION IN THE TROPOSPHERE
-
-    ! DO 534 ji=1,kgwd
-    ! jl=kdx(ji)
-    ! Modif vectorisation 02/04/2004
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-
-
-        IF (jk<kkcrith(jl) .AND. jk>nstra) THEN
-
-          zdelp = paphm1(jl, jk) - paphm1(jl, kkcrith(jl))
-          zdelpt = paphm1(jl, nstra) - paphm1(jl, kkcrith(jl))
-          ptau(jl, jk) = ztau(jl, kkcrith(jl)) + (ztau(jl,nstra)-ztau(jl, &
-            kkcrith(jl)))*zdelp/zdelpt
-
-        END IF
-      END IF
-    END DO
-
-
-  END DO
-
-
-  RETURN
-END SUBROUTINE gwprofil
-SUBROUTINE lift_noro(nlon, nlev, dtime, paprs, pplay, plat, pmea, pstd, ppic, &
-    ktest, t, u, v, pulow, pvlow, pustr, pvstr, d_t, d_u, d_v)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201
-  ! Objet: Frottement de la montagne Interface
-  ! ======================================================================
-  ! Arguments:
-  ! dtime---input-R- pas d'integration (s)
-  ! paprs---input-R-pression pour chaque inter-couche (en Pa)
-  ! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-  ! t-------input-R-temperature (K)
-  ! u-------input-R-vitesse horizontale (m/s)
-  ! v-------input-R-vitesse horizontale (m/s)
-
-  ! d_t-----output-R-increment de la temperature
-  ! d_u-----output-R-increment de la vitesse u
-  ! d_v-----output-R-increment de la vitesse v
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! ARGUMENTS
-
-  INTEGER nlon, nlev
-  REAL dtime
-  REAL paprs(klon, klev+1)
-  REAL pplay(klon, klev)
-  REAL plat(nlon), pmea(nlon)
-  REAL pstd(nlon)
-  REAL ppic(nlon)
-  REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)
-  REAL t(nlon, nlev), u(nlon, nlev), v(nlon, nlev)
-  REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev)
-
-  INTEGER i, k, ktest(nlon)
-
-  ! Variables locales:
-
-  REAL zgeom(klon, klev)
-  REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev)
-  REAL pt(klon, klev), pu(klon, klev), pv(klon, klev)
-  REAL papmf(klon, klev), papmh(klon, klev+1)
-
-  ! initialiser les variables de sortie (pour securite)
-
-  DO i = 1, klon
-    pulow(i) = 0.0
-    pvlow(i) = 0.0
-    pustr(i) = 0.0
-    pvstr(i) = 0.0
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_u(i, k) = 0.0
-      d_v(i, k) = 0.0
-      pdudt(i, k) = 0.0
-      pdvdt(i, k) = 0.0
-      pdtdt(i, k) = 0.0
-    END DO
-  END DO
-
-  ! preparer les variables d'entree (attention: l'ordre des niveaux
-  ! verticaux augmente du haut vers le bas)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      pt(i, k) = t(i, klev-k+1)
-      pu(i, k) = u(i, klev-k+1)
-      pv(i, k) = v(i, klev-k+1)
-      papmf(i, k) = pplay(i, klev-k+1)
-    END DO
-  END DO
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      papmh(i, k) = paprs(i, klev-k+2)
-    END DO
-  END DO
-  DO i = 1, klon
-    zgeom(i, klev) = rd*pt(i, klev)*log(papmh(i,klev+1)/papmf(i,klev))
-  END DO
-  DO k = klev - 1, 1, -1
-    DO i = 1, klon
-      zgeom(i, k) = zgeom(i, k+1) + rd*(pt(i,k)+pt(i,k+1))/2.0*log(papmf(i,k+ &
-        1)/papmf(i,k))
-    END DO
-  END DO
-
-  ! appeler la routine principale
-
-  CALL orolift(klon, klev, ktest, dtime, papmh, zgeom, pt, pu, pv, plat, &
-    pmea, pstd, ppic, pulow, pvlow, pdudt, pdvdt, pdtdt)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_u(i, klev+1-k) = dtime*pdudt(i, k)
-      d_v(i, klev+1-k) = dtime*pdvdt(i, k)
-      d_t(i, klev+1-k) = dtime*pdtdt(i, k)
-      pustr(i) = pustr(i) &        ! IM BUG .
-                                   ! +RG*pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))
-        +pdudt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-      pvstr(i) = pvstr(i) &        ! IM BUG .
-                                   ! +RG*pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))
-        +pdvdt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE lift_noro
-SUBROUTINE orolift(nlon, nlev, ktest, ptsphy, paphm1, pgeom1, ptm1, pum1, &
-    pvm1, plat, pmea, pvaror, ppic & ! OUTPUTS
-    , pulow, pvlow, pvom, pvol, pte)
-
-
-  ! **** *OROLIFT: SIMULATE THE GEOSTROPHIC LIFT.
-
-  ! PURPOSE.
-  ! --------
-
-  ! **   INTERFACE.
-  ! ----------
-  ! CALLED FROM *lift_noro
-  ! ----------
-
-  ! AUTHOR.
-  ! -------
-  ! F.LOTT  LMD 22/11/95
-
-  USE dimphy
-  IMPLICIT NONE
-
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   ARGUMENTS
-  ! ---------
-
-
-  INTEGER nlon, nlev
-  REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), &
-    pvlow(nlon)
-  REAL pum1(nlon, nlev), pvm1(nlon, nlev), ptm1(nlon, nlev), plat(nlon), &
-    pmea(nlon), pvaror(nlon), ppic(nlon), pgeom1(nlon, nlev), &
-    paphm1(nlon, nlev+1)
-
-  INTEGER ktest(nlon)
-  REAL ptsphy
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   LOCAL ARRAYS
-  ! ------------
-  LOGICAL lifthigh
-  ! ym      integer klevm1, jl, ilevh, jk
-  INTEGER jl, ilevh, jk
-  REAL zcons1, ztmst, zrtmst, zpi, zhgeo
-  REAL zdelp, zslow, zsqua, zscav, zbet
-  INTEGER iknub(klon), iknul(klon)
-  LOGICAL ll1(klon, klev+1)
-
-  REAL ztau(klon, klev+1), ztav(klon, klev+1), zrho(klon, klev+1)
-  REAL zdudt(klon), zdvdt(klon)
-  REAL zhcrit(klon, klev)
-  CHARACTER (LEN=20) :: modname = 'orografi'
-  CHARACTER (LEN=80) :: abort_message
-  ! -----------------------------------------------------------------------
-
-  ! *         1.1  INITIALIZATIONS
-  ! ---------------
-
-  lifthigh = .FALSE.
-
-  IF (nlon/=klon .OR. nlev/=klev) THEN
-    abort_message = 'pb dimension'
-    CALL abort_physic(modname, abort_message, 1)
-  END IF
-  zcons1 = 1./rd
-  ! ym      KLEVM1=KLEV-1
-  ztmst = ptsphy
-  zrtmst = 1./ztmst
-  zpi = acos(-1.)
-
-  DO jl = kidia, kfdia
-    zrho(jl, klev+1) = 0.0
-    pulow(jl) = 0.0
-    pvlow(jl) = 0.0
-    iknub(jl) = klev
-    iknul(jl) = klev
-    ilevh = klev/3
-    ll1(jl, klev+1) = .FALSE.
-    DO jk = 1, klev
-      pvom(jl, jk) = 0.0
-      pvol(jl, jk) = 0.0
-      pte(jl, jk) = 0.0
-    END DO
-  END DO
-
-
-  ! *         2.1     DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
-  ! *                 LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
-  ! *                 THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
-
-
-
-  DO jk = klev, 1, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zhcrit(jl, jk) = amax1(ppic(jl)-pmea(jl), 100.)
-        zhgeo = pgeom1(jl, jk)/rg
-        ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-        IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-          iknub(jl) = jk
-        END IF
-      END IF
-    END DO
-  END DO
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      iknub(jl) = max(iknub(jl), klev/2)
-      iknul(jl) = max(iknul(jl), 2*klev/3)
-      IF (iknub(jl)>nktopg) iknub(jl) = nktopg
-      IF (iknub(jl)==nktopg) iknul(jl) = klev
-      IF (iknub(jl)==iknul(jl)) iknub(jl) = iknul(jl) - 1
-    END IF
-  END DO
-
-  ! do 2011 jl=kidia,kfdia
-  ! IF(KTEST(JL).EQ.1) THEN
-  ! print *,' iknul= ',iknul(jl),'  iknub=',iknub(jl)
-  ! ENDIF
-  ! 2011 continue
-
-  ! PRINT *,'  DANS OROLIFT: 2010'
-
-  DO jk = klev, 2, -1
-    DO jl = kidia, kfdia
-      zrho(jl, jk) = 2.*paphm1(jl, jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
-    END DO
-  END DO
-  ! PRINT *,'  DANS OROLIFT: 223'
-
-  ! ********************************************************************
-
-  ! *     DEFINE LOW LEVEL FLOW
-  ! -------------------
-  DO jk = klev, 1, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk>=iknub(jl) .AND. jk<=iknul(jl)) THEN
-          pulow(jl) = pulow(jl) + pum1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk) &
-            )
-          pvlow(jl) = pvlow(jl) + pvm1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk) &
-            )
-          zrho(jl, klev+1) = zrho(jl, klev+1) + zrho(jl, jk)*(paphm1(jl,jk+1) &
-            -paphm1(jl,jk))
-        END IF
-      END IF
-    END DO
-  END DO
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      pulow(jl) = pulow(jl)/(paphm1(jl,iknul(jl)+1)-paphm1(jl,iknub(jl)))
-      pvlow(jl) = pvlow(jl)/(paphm1(jl,iknul(jl)+1)-paphm1(jl,iknub(jl)))
-      zrho(jl, klev+1) = zrho(jl, klev+1)/(paphm1(jl,iknul(jl)+1)-paphm1(jl, &
-        iknub(jl)))
-    END IF
-  END DO
-
-  ! ***********************************************************
-
-  ! *         3.      COMPUTE MOUNTAIN LIFT
-
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      ztau(jl, klev+1) = -gklift*zrho(jl, klev+1)*2.*romega* & ! *
-                                                               ! (2*PVAROR(JL)+PMEA(JL))*
-        2*pvaror(jl)*sin(zpi/180.*plat(jl))*pvlow(jl)
-      ztav(jl, klev+1) = gklift*zrho(jl, klev+1)*2.*romega* & ! *
-                                                              ! (2*PVAROR(JL)+PMEA(JL))*
-        2*pvaror(jl)*sin(zpi/180.*plat(jl))*pulow(jl)
-    ELSE
-      ztau(jl, klev+1) = 0.0
-      ztav(jl, klev+1) = 0.0
-    END IF
-  END DO
-
-  ! *         4.      COMPUTE LIFT PROFILE
-  ! *                 --------------------
-
-
-
-  DO jk = 1, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        ztau(jl, jk) = ztau(jl, klev+1)*paphm1(jl, jk)/paphm1(jl, klev+1)
-        ztav(jl, jk) = ztav(jl, klev+1)*paphm1(jl, jk)/paphm1(jl, klev+1)
-      ELSE
-        ztau(jl, jk) = 0.0
-        ztav(jl, jk) = 0.0
-      END IF
-    END DO
-  END DO
-
-
-  ! *         5.      COMPUTE TENDENCIES.
-  ! *                 -------------------
-  IF (lifthigh) THEN
-    ! PRINT *,'  DANS OROLIFT: 500'
-
-    ! EXPLICIT SOLUTION AT ALL LEVELS
-
-    DO jk = 1, klev
-      DO jl = kidia, kfdia
-        IF (ktest(jl)==1) THEN
-          zdelp = paphm1(jl, jk+1) - paphm1(jl, jk)
-          zdudt(jl) = -rg*(ztau(jl,jk+1)-ztau(jl,jk))/zdelp
-          zdvdt(jl) = -rg*(ztav(jl,jk+1)-ztav(jl,jk))/zdelp
-        END IF
-      END DO
-    END DO
-
-    ! PROJECT PERPENDICULARLY TO U NOT TO DESTROY ENERGY
-
-    DO jk = 1, klev
-      DO jl = kidia, kfdia
-        IF (ktest(jl)==1) THEN
-
-          zslow = sqrt(pulow(jl)**2+pvlow(jl)**2)
-          zsqua = amax1(sqrt(pum1(jl,jk)**2+pvm1(jl,jk)**2), gvsec)
-          zscav = -zdudt(jl)*pvm1(jl, jk) + zdvdt(jl)*pum1(jl, jk)
-          IF (zsqua>gvsec) THEN
-            pvom(jl, jk) = -zscav*pvm1(jl, jk)/zsqua**2
-            pvol(jl, jk) = zscav*pum1(jl, jk)/zsqua**2
-          ELSE
-            pvom(jl, jk) = 0.0
-            pvol(jl, jk) = 0.0
-          END IF
-          zsqua = sqrt(pum1(jl,jk)**2+pum1(jl,jk)**2)
-          IF (zsqua<zslow) THEN
-            pvom(jl, jk) = zsqua/zslow*pvom(jl, jk)
-            pvol(jl, jk) = zsqua/zslow*pvol(jl, jk)
-          END IF
-
-        END IF
-      END DO
-    END DO
-
-    ! 6.  LOW LEVEL LIFT, SEMI IMPLICIT:
-    ! ----------------------------------
-
-  ELSE
-
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        DO jk = klev, iknub(jl), -1
-          zbet = gklift*2.*romega*sin(zpi/180.*plat(jl))*ztmst* &
-            (pgeom1(jl,iknub(jl)-1)-pgeom1(jl,jk))/ &
-            (pgeom1(jl,iknub(jl)-1)-pgeom1(jl,klev))
-          zdudt(jl) = -pum1(jl, jk)/ztmst/(1+zbet**2)
-          zdvdt(jl) = -pvm1(jl, jk)/ztmst/(1+zbet**2)
-          pvom(jl, jk) = zbet**2*zdudt(jl) - zbet*zdvdt(jl)
-          pvol(jl, jk) = zbet*zdudt(jl) + zbet**2*zdvdt(jl)
-        END DO
-      END IF
-    END DO
-
-  END IF
-
-  RETURN
-END SUBROUTINE orolift
-
-
-SUBROUTINE sugwd(nlon, nlev, paprs, pplay)
-  USE dimphy
-  USE mod_phys_lmdz_para
-  USE mod_grid_phy_lmdz
-  ! USE parallel
-
-  ! **** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
-
-  ! PURPOSE.
-  ! --------
-  ! INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
-  ! GRAVITY WAVE DRAG PARAMETRIZATION.
-
-  ! **   INTERFACE.
-  ! ----------
-  ! CALL *SUGWD* FROM *SUPHEC*
-  ! -----        ------
-
-  ! EXPLICIT ARGUMENTS :
-  ! --------------------
-  ! PSIG        : VERTICAL COORDINATE TABLE
-  ! NLEV        : NUMBER OF MODEL LEVELS
-
-  ! IMPLICIT ARGUMENTS :
-  ! --------------------
-  ! COMMON YOEGWD
-
-  ! METHOD.
-  ! -------
-  ! SEE DOCUMENTATION
-
-  ! EXTERNALS.
-  ! ----------
-  ! NONE
-
-  ! REFERENCE.
-  ! ----------
-  ! ECMWF Research Department documentation of the IFS
-
-  ! AUTHOR.
-  ! -------
-  ! MARTIN MILLER             *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 90-01-01
-  ! ------------------------------------------------------------------
-  IMPLICIT NONE
-
-  ! -----------------------------------------------------------------
-  include "YOEGWD.h"
-  ! ----------------------------------------------------------------
-
-  INTEGER nlon, nlev, jk
-  REAL paprs(nlon, nlev+1)
-  REAL pplay(nlon, nlev)
-  REAL zpr, zstra, zsigt, zpm1r
-  REAL :: pplay_glo(klon_glo, nlev)
-  REAL :: paprs_glo(klon_glo, nlev+1)
-
-  ! *       1.    SET THE VALUES OF THE PARAMETERS
-  ! --------------------------------
-
-
-  PRINT *, ' DANS SUGWD NLEV=', nlev
-  ghmax = 10000.
-
-  zpr = 100000.
-  zstra = 0.1
-  zsigt = 0.94
-  ! old  ZPR=80000.
-  ! old  ZSIGT=0.85
-
-
-  CALL gather(pplay, pplay_glo)
-  CALL bcast(pplay_glo)
-  CALL gather(paprs, paprs_glo)
-  CALL bcast(paprs_glo)
-
-
-  DO jk = 1, nlev
-    zpm1r = pplay_glo((klon_glo/2)+1, jk)/paprs_glo((klon_glo/2)+1, 1)
-    IF (zpm1r>=zsigt) THEN
-      nktopg = jk
-    END IF
-    zpm1r = pplay_glo((klon_glo/2)+1, jk)/paprs_glo((klon_glo/2)+1, 1)
-    IF (zpm1r>=zstra) THEN
-      nstra = jk
-    END IF
-  END DO
-
-
-
-  ! inversion car dans orodrag on compte les niveaux a l'envers
-  nktopg = nlev - nktopg + 1
-  nstra = nlev - nstra
-  PRINT *, ' DANS SUGWD nktopg=', nktopg
-  PRINT *, ' DANS SUGWD nstra=', nstra
-
-  gsigcr = 0.80
-
-!  Values now specified in run.def, or conf_phys_m.F90
-!  gkdrag = 0.2
-!  grahilo = 1.
-!  grcrit = 0.01
-!  gfrcrit = 1.0
-!  gkwake = 0.50
-! gklift = 0.50
-  gvcrit = 0.0
-
-  ! ----------------------------------------------------------------
-
-  ! *       2.    SET VALUES OF SECURITY PARAMETERS
-  ! ---------------------------------
-
-
-  gvsec = 0.10
-  gssec = 1.E-12
-
-  gtsec = 1.E-07
-
-  ! ----------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE sugwd
+link ../phylmd/orografi.F90
Index: LMDZ6/trunk/libf/phylmdiso/orografi_strato.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/orografi_strato.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/orografi_strato.F90	(revision 3940)
@@ -1,1938 +1,1 @@
-SUBROUTINE drag_noro_strato(partdrag, nlon, nlev, dtime, paprs, pplay, pmea, pstd, &
-    psig, pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, &
-    pustr, pvstr, d_t, d_u, d_v)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201
-  ! Object: Mountain drag interface. Made necessary because:
-  ! 1. in the LMD-GCM Layers are from bottom to top,
-  ! contrary to most European GCM.
-  ! 2. the altitude above ground of each model layers
-  ! needs to be known (variable zgeom)
-  ! ======================================================================
-  ! Explicit Arguments:
-  ! ==================
-  ! partdrag-input-I-control which part of the drag we consider (total part or GW part)
-  ! nlon----input-I-Total number of horizontal points that get into physics
-  ! nlev----input-I-Number of vertical levels
-  ! dtime---input-R-Time-step (s)
-  ! paprs---input-R-Pressure in semi layers    (Pa)
-  ! pplay---input-R-Pressure model-layers      (Pa)
-  ! t-------input-R-temperature (K)
-  ! u-------input-R-Horizontal wind (m/s)
-  ! v-------input-R-Meridional wind (m/s)
-  ! pmea----input-R-Mean Orography (m)
-  ! pstd----input-R-SSO standard deviation (m)
-  ! psig----input-R-SSO slope
-  ! pgam----input-R-SSO Anisotropy
-  ! pthe----input-R-SSO Angle
-  ! ppic----input-R-SSO Peacks elevation (m)
-  ! pval----input-R-SSO Valleys elevation (m)
-
-  ! kgwd- -input-I: Total nb of points where the orography schemes are active
-  ! ktest--input-I: Flags to indicate active points
-  ! kdx----input-I: Locate the physical location of an active point.
-
-  ! pulow, pvlow -output-R: Low-level wind
-  ! pustr, pvstr -output-R: Surface stress due to SSO drag      (Pa)
-
-  ! d_t-----output-R: T increment
-  ! d_u-----output-R: U increment
-  ! d_v-----output-R: V increment
-
-  ! Implicit Arguments:
-  ! ===================
-
-  ! iim--common-I: Number of longitude intervals
-  ! jjm--common-I: Number of latitude intervals
-  ! klon-common-I: Number of points seen by the physics
-  ! (iim+1)*(jjm+1) for instance
-  ! klev-common-I: Number of vertical layers
-  ! ======================================================================
-  ! Local Variables:
-  ! ================
-
-  ! zgeom-----R: Altitude of layer above ground
-  ! pt, pu, pv --R: t u v from top to bottom
-  ! pdtdt, pdudt, pdvdt --R: t u v tendencies (from top to bottom)
-  ! papmf: pressure at model layer (from top to bottom)
-  ! papmh: pressure at model 1/2 layer (from top to bottom)
-
-  ! ======================================================================
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! ARGUMENTS
-
-  INTEGER partdrag,nlon, nlev
-  REAL dtime
-  REAL paprs(nlon, nlev+1)
-  REAL pplay(nlon, nlev)
-  REAL pmea(nlon), pstd(nlon), psig(nlon), pgam(nlon), pthe(nlon)
-  REAL ppic(nlon), pval(nlon)
-  REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)
-  REAL t(nlon, nlev), u(nlon, nlev), v(nlon, nlev)
-  REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev)
-
-  INTEGER i, k, kgwd, kdx(nlon), ktest(nlon)
-
-  ! LOCAL VARIABLES:
-
-  REAL zgeom(klon, klev)
-  REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev)
-  REAL pt(klon, klev), pu(klon, klev), pv(klon, klev)
-  REAL papmf(klon, klev), papmh(klon, klev+1)
-  CHARACTER (LEN=20) :: modname = 'orografi_strato'
-  CHARACTER (LEN=80) :: abort_message
-
-  ! INITIALIZE OUTPUT VARIABLES
-
-  DO i = 1, klon
-    pulow(i) = 0.0
-    pvlow(i) = 0.0
-    pustr(i) = 0.0
-    pvstr(i) = 0.0
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_u(i, k) = 0.0
-      d_v(i, k) = 0.0
-      pdudt(i, k) = 0.0
-      pdvdt(i, k) = 0.0
-      pdtdt(i, k) = 0.0
-    END DO
-  END DO
-
-  ! PREPARE INPUT VARIABLES FOR ORODRAG (i.e., ORDERED FROM TOP TO BOTTOM)
-  ! CALCULATE LAYERS HEIGHT ABOVE GROUND)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      pt(i, k) = t(i, klev-k+1)
-      pu(i, k) = u(i, klev-k+1)
-      pv(i, k) = v(i, klev-k+1)
-      papmf(i, k) = pplay(i, klev-k+1)
-    END DO
-  END DO
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      papmh(i, k) = paprs(i, klev-k+2)
-    END DO
-  END DO
-  DO i = 1, klon
-    zgeom(i, klev) = rd*pt(i, klev)*log(papmh(i,klev+1)/papmf(i,klev))
-  END DO
-  DO k = klev - 1, 1, -1
-    DO i = 1, klon
-      zgeom(i, k) = zgeom(i, k+1) + rd*(pt(i,k)+pt(i,k+1))/2.0*log(papmf(i,k+ &
-        1)/papmf(i,k))
-    END DO
-  END DO
-
-  ! CALL SSO DRAG ROUTINES
-
-  CALL orodrag_strato(partdrag,klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, &
-    zgeom, pt, pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, &
-    pvlow, pdudt, pdvdt, pdtdt)
-
-  ! COMPUTE INCREMENTS AND STRESS FROM TENDENCIES
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_u(i, klev+1-k) = dtime*pdudt(i, k)
-      d_v(i, klev+1-k) = dtime*pdvdt(i, k)
-      d_t(i, klev+1-k) = dtime*pdtdt(i, k)
-      pustr(i) = pustr(i) + pdudt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-      pvstr(i) = pvstr(i) + pdvdt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE drag_noro_strato
-
-SUBROUTINE orodrag_strato(partdrag,nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, &
-    papm1, pgeom1, ptm1, pum1, pvm1, pmea, pstd, psig, pgam, pthe, ppic, pval &
-  ! outputs
-    , pulow, pvlow, pvom, pvol, pte)
-
-  USE dimphy
-  IMPLICIT NONE
-
-
-  ! **** *orodrag* - does the SSO drag  parametrization.
-
-  ! purpose.
-  ! --------
-
-  ! this routine computes the physical tendencies of the
-  ! prognostic variables u,v  and t due to  vertical transports by
-  ! subgridscale orographically excited gravity waves, and to
-  ! low level blocked flow drag.
-
-  ! **   interface.
-  ! ----------
-  ! called from *drag_noro*.
-
-  ! the routine takes its input from the long-term storage:
-  ! u,v,t and p at t-1.
-
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-  ! partdrag-input-I-control which part of the drag we consider (total part or GW part)
-  ! nlon----input-I-Total number of horizontal points that get into physics
-  ! nlev----input-I-Number of vertical levels
-
-  ! kgwd- -input-I: Total nb of points where the orography schemes are active
-  ! ktest--input-I: Flags to indicate active points
-  ! kdx----input-I: Locate the physical location of an active point.
-  ! ptsphy--input-R-Time-step (s)
-  ! paphm1--input-R: pressure at model 1/2 layer
-  ! papm1---input-R: pressure at model layer
-  ! pgeom1--input-R: Altitude of layer above ground
-  ! ptm1, pum1, pvm1--R-: t, u and v
-  ! pmea----input-R-Mean Orography (m)
-  ! pstd----input-R-SSO standard deviation (m)
-  ! psig----input-R-SSO slope
-  ! pgam----input-R-SSO Anisotropy
-  ! pthe----input-R-SSO Angle
-  ! ppic----input-R-SSO Peacks elevation (m)
-  ! pval----input-R-SSO Valleys elevation (m)
-
-  INTEGER  nlon, nlev, kgwd
-  REAL ptsphy
-
-  ! ==== outputs ===
-  ! pulow, pvlow -output-R: Low-level wind
-
-  ! pte -----output-R: T tendency
-  ! pvom-----output-R: U tendency
-  ! pvol-----output-R: V tendency
-
-
-  ! Implicit Arguments:
-  ! ===================
-
-  ! klon-common-I: Number of points seen by the physics
-  ! klev-common-I: Number of vertical layers
-
-  ! method.
-  ! -------
-
-  ! externals.
-  ! ----------
-  INTEGER ismin, ismax
-  EXTERNAL ismin, ismax
-
-  ! reference.
-  ! ----------
-
-  ! author.
-  ! -------
-  ! m.miller + b.ritter   e.c.m.w.f.     15/06/86.
-
-  ! f.lott + m. miller    e.c.m.w.f.     22/11/94
-  ! -----------------------------------------------------------------------
-
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   arguments
-  ! ---------
-
-  INTEGER partdrag
-  REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), &
-    pvlow(nlon)
-  REAL pum1(nlon, nlev), pvm1(nlon, nlev), ptm1(nlon, nlev), pmea(nlon), &
-    pstd(nlon), psig(nlon), pgam(nlon), pthe(nlon), ppic(nlon), pval(nlon), &
-    pgeom1(nlon, nlev), papm1(nlon, nlev), paphm1(nlon, nlev+1)
-
-  INTEGER kdx(nlon), ktest(nlon)
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-  ! ------------
-  INTEGER isect(klon), icrit(klon), ikcrith(klon), ikenvh(klon), iknu(klon), &
-    iknu2(klon), ikcrit(klon), ikhlim(klon)
-
-  REAL ztau(klon, klev+1), zstab(klon, klev+1), zvph(klon, klev+1), &
-    zrho(klon, klev+1), zri(klon, klev+1), zpsi(klon, klev+1), &
-    zzdep(klon, klev)
-  REAL zdudt(klon), zdvdt(klon), zdtdt(klon), zdedt(klon), zvidis(klon), &
-    ztfr(klon), znu(klon), zd1(klon), zd2(klon), zdmod(klon)
-
-
-  ! local quantities:
-
-  INTEGER jl, jk, ji
-  REAL ztmst, zdelp, ztemp, zforc, ztend, rover, facpart
-  REAL zb, zc, zconb, zabsv, zzd1, ratio, zbet, zust, zvst, zdis
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.    initialization
-  ! --------------
-
-  ! print *,' in orodrag'
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.1   computational constants
-  ! -----------------------
-
-
-  ! ztmst=twodt
-  ! if(nstep.eq.nstart) ztmst=0.5*twodt
-  ztmst = ptsphy
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.3   check whether row contains point for printing
-  ! ---------------------------------------------
-
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.     precompute basic state variables.
-  ! *                ---------- ----- ----- ----------
-  ! *                define low level wind, project winds in plane of
-  ! *                low level wind, determine sector in which to take
-  ! *                the variance and set indicator for critical levels.
-
-
-
-
-
-  CALL orosetup_strato(nlon, nlev, ktest, ikcrit, ikcrith, icrit, isect, &
-    ikhlim, ikenvh, iknu, iknu2, paphm1, papm1, pum1, pvm1, ptm1, pgeom1, &
-    pstd, zrho, zri, zstab, ztau, zvph, zpsi, zzdep, pulow, pvlow, pthe, &
-    pgam, pmea, ppic, pval, znu, zd1, zd2, zdmod)
-
-  ! ***********************************************************
-
-
-  ! *         3.      compute low level stresses using subcritical and
-  ! *                 supercritical forms.computes anisotropy coefficient
-  ! *                 as measure of orographic twodimensionality.
-
-
-  CALL gwstress_strato(nlon, nlev, ikcrit, isect, ikhlim, ktest, ikcrith, &
-    icrit, ikenvh, iknu, zrho, zstab, zvph, pstd, psig, pmea, ppic, pval, &
-    ztfr, ztau, pgeom1, pgam, zd1, zd2, zdmod, znu)
-
-  ! *         4.      compute stress profile including
-  ! trapped waves, wave breaking,
-  ! linear decay in stratosphere.
-
-
-
-
-  CALL gwprofil_strato(nlon, nlev, kgwd, kdx, ktest, ikcrit, ikcrith, icrit, &
-    ikenvh, iknu, iknu2, paphm1, zrho, zstab, ztfr, zvph, zri, ztau &
-    , zdmod, znu, psig, pgam, pstd, ppic, pval)
-
-  ! *         5.      Compute tendencies from waves stress profile.
-  ! Compute low level blocked flow drag.
-  ! *                 --------------------------------------------
-
-
-
-
-  ! explicit solution at all levels for the gravity wave
-  ! implicit solution for the blocked levels
-
-  DO jl = kidia, kfdia
-    zvidis(jl) = 0.0
-    zdudt(jl) = 0.0
-    zdvdt(jl) = 0.0
-    zdtdt(jl) = 0.0
-  END DO
-
-
-  DO jk = 1, klev
-
-
-    ! WAVE STRESS
-    ! -------------
-
-
-    DO ji = kidia, kfdia
-
-      IF (ktest(ji)==1) THEN
-
-        zdelp = paphm1(ji, jk+1) - paphm1(ji, jk)
-        ztemp = -rg*(ztau(ji,jk+1)-ztau(ji,jk))/(zvph(ji,klev+1)*zdelp)
-
-        zdudt(ji) = (pulow(ji)*zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
-        zdvdt(ji) = (pvlow(ji)*zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
-
-        ! Control Overshoots
-
-
-        IF (jk>=nstra) THEN
-          rover = 0.10
-          IF (abs(zdudt(ji))>rover*abs(pum1(ji,jk))/ztmst) zdudt(ji) = rover* &
-            abs(pum1(ji,jk))/ztmst*zdudt(ji)/(abs(zdudt(ji))+1.E-10)
-          IF (abs(zdvdt(ji))>rover*abs(pvm1(ji,jk))/ztmst) zdvdt(ji) = rover* &
-            abs(pvm1(ji,jk))/ztmst*zdvdt(ji)/(abs(zdvdt(ji))+1.E-10)
-        END IF
-
-        rover = 0.25
-        zforc = sqrt(zdudt(ji)**2+zdvdt(ji)**2)
-        ztend = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/ztmst
-
-        IF (zforc>=rover*ztend) THEN
-          zdudt(ji) = rover*ztend/zforc*zdudt(ji)
-          zdvdt(ji) = rover*ztend/zforc*zdvdt(ji)
-        END IF
-
-        ! BLOCKED FLOW DRAG:
-        ! -----------------
-
-        IF (partdrag .GE. 2) THEN
-        facpart=0.
-        ELSE
-        facpart=gkwake
-        ENDIF
-
-
-        IF (jk>ikenvh(ji)) THEN
-          zb = 1.0 - 0.18*pgam(ji) - 0.04*pgam(ji)**2
-          zc = 0.48*pgam(ji) + 0.3*pgam(ji)**2
-          zconb = 2.*ztmst*facpart*psig(ji)/(4.*pstd(ji))
-          zabsv = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
-          zzd1 = zb*cos(zpsi(ji,jk))**2 + zc*sin(zpsi(ji,jk))**2
-          ratio = (cos(zpsi(ji,jk))**2+pgam(ji)*sin(zpsi(ji, &
-            jk))**2)/(pgam(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
-          zbet = max(0., 2.-1./ratio)*zconb*zzdep(ji, jk)*zzd1*zabsv
-
-          ! OPPOSED TO THE WIND
-
-          zdudt(ji) = -pum1(ji, jk)/ztmst
-          zdvdt(ji) = -pvm1(ji, jk)/ztmst
-
-          ! PERPENDICULAR TO THE SSO MAIN AXIS:
-
-          ! mod     zdudt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
-          ! mod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
-          ! mod *              *cos(pthe(ji)*rpi/180.)/ztmst
-          ! mod     zdvdt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
-          ! mod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
-          ! mod *              *sin(pthe(ji)*rpi/180.)/ztmst
-
-          zdudt(ji) = zdudt(ji)*(zbet/(1.+zbet))
-          zdvdt(ji) = zdvdt(ji)*(zbet/(1.+zbet))
-        END IF
-        pvom(ji, jk) = zdudt(ji)
-        pvol(ji, jk) = zdvdt(ji)
-        zust = pum1(ji, jk) + ztmst*zdudt(ji)
-        zvst = pvm1(ji, jk) + ztmst*zdvdt(ji)
-        zdis = 0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)
-        zdedt(ji) = zdis/ztmst
-        zvidis(ji) = zvidis(ji) + zdis*zdelp
-        zdtdt(ji) = zdedt(ji)/rcpd
-
-        ! NO TENDENCIES ON TEMPERATURE .....
-
-        ! Instead of, pte(ji,jk)=zdtdt(ji), due to mechanical dissipation
-
-        pte(ji, jk) = 0.0
-
-      END IF
-
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE orodrag_strato
-SUBROUTINE orosetup_strato(nlon, nlev, ktest, kkcrit, kkcrith, kcrit, ksect, &
-    kkhlim, kkenvh, kknu, kknu2, paphm1, papm1, pum1, pvm1, ptm1, pgeom1, &
-    pstd, prho, pri, pstab, ptau, pvph, ppsi, pzdep, pulow, pvlow, ptheta, &
-    pgam, pmea, ppic, pval, pnu, pd1, pd2, pdmod)
-
-  ! **** *gwsetup*
-
-  ! purpose.
-  ! --------
-  ! SET-UP THE ESSENTIAL PARAMETERS OF THE SSO DRAG SCHEME:
-  ! DEPTH OF LOW WBLOCKED LAYER, LOW-LEVEL FLOW, BACKGROUND
-  ! STRATIFICATION.....
-
-  ! **   interface.
-  ! ----------
-  ! from *orodrag*
-
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-
-  ! nlon----input-I-Total number of horizontal points that get into physics
-  ! nlev----input-I-Number of vertical levels
-  ! ktest--input-I: Flags to indicate active points
-
-  ! ptsphy--input-R-Time-step (s)
-  ! paphm1--input-R: pressure at model 1/2 layer
-  ! papm1---input-R: pressure at model layer
-  ! pgeom1--input-R: Altitude of layer above ground
-  ! ptm1, pum1, pvm1--R-: t, u and v
-  ! pmea----input-R-Mean Orography (m)
-  ! pstd----input-R-SSO standard deviation (m)
-  ! psig----input-R-SSO slope
-  ! pgam----input-R-SSO Anisotropy
-  ! pthe----input-R-SSO Angle
-  ! ppic----input-R-SSO Peacks elevation (m)
-  ! pval----input-R-SSO Valleys elevation (m)
-
-  ! ==== outputs ===
-  ! pulow, pvlow -output-R: Low-level wind
-  ! kkcrit----I-: Security value for top of low level flow
-  ! kcrit-----I-: Critical level
-  ! ksect-----I-: Not used
-  ! kkhlim----I-: Not used
-  ! kkenvh----I-: Top of blocked flow layer
-  ! kknu------I-: Layer that sees mountain peacks
-  ! kknu2-----I-: Layer that sees mountain peacks above mountain mean
-  ! kknub-----I-: Layer that sees mountain mean above valleys
-  ! prho------R-: Density at 1/2 layers
-  ! pri-------R-: Background Richardson Number, Wind shear measured along GW
-  ! stress
-  ! pstab-----R-: Brunt-Vaisala freq. at 1/2 layers
-  ! pvph------R-: Wind in  plan of GW stress, Half levels.
-  ! ppsi------R-: Angle between low level wind and SS0 main axis.
-  ! pd1-------R-| Compared the ratio of the stress
-  ! pd2-------R-| that is along the wind to that Normal to it.
-  ! pdi define the plane of low level stress
-  ! compared to the low level wind.
-  ! see p. 108 Lott & Miller (1997).
-  ! pdmod-----R-: Norme of pdi
-
-  ! === local arrays ===
-
-  ! zvpf------R-: Wind projected in the plan of the low-level stress.
-
-  ! ==== outputs ===
-
-  ! implicit arguments :   none
-  ! --------------------
-
-  ! method.
-  ! -------
-
-
-  ! externals.
-  ! ----------
-
-
-  ! reference.
-  ! ----------
-
-  ! see ecmwf research department documentation of the "i.f.s."
-
-  ! author.
-  ! -------
-
-  ! modifications.
-  ! --------------
-  ! f.lott  for the new-gwdrag scheme november 1993
-
-  ! -----------------------------------------------------------------------
-  USE dimphy
-  IMPLICIT NONE
-
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   arguments
-  ! ---------
-
-  INTEGER nlon, nlev
-  INTEGER kkcrit(nlon), kkcrith(nlon), kcrit(nlon), ksect(nlon), &
-    kkhlim(nlon), ktest(nlon), kkenvh(nlon)
-
-
-  REAL paphm1(nlon, klev+1), papm1(nlon, klev), pum1(nlon, klev), &
-    pvm1(nlon, klev), ptm1(nlon, klev), pgeom1(nlon, klev), &
-    prho(nlon, klev+1), pri(nlon, klev+1), pstab(nlon, klev+1), &
-    ptau(nlon, klev+1), pvph(nlon, klev+1), ppsi(nlon, klev+1), &
-    pzdep(nlon, klev)
-  REAL pulow(nlon), pvlow(nlon), ptheta(nlon), pgam(nlon), pnu(nlon), &
-    pd1(nlon), pd2(nlon), pdmod(nlon)
-  REAL pstd(nlon), pmea(nlon), ppic(nlon), pval(nlon)
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-  ! ------------
-
-
-  INTEGER ilevh, jl, jk
-  REAL zcons1, zcons2, zhgeo, zu, zphi
-  REAL zvt1, zvt2, zdwind, zwind, zdelp
-  REAL zstabm, zstabp, zrhom, zrhop
-  LOGICAL lo
-  LOGICAL ll1(klon, klev+1)
-  INTEGER kknu(klon), kknu2(klon), kknub(klon), kknul(klon), kentp(klon), &
-    ncount(klon)
-
-  REAL zhcrit(klon, klev), zvpf(klon, klev), zdp(klon, klev)
-  REAL znorm(klon), zb(klon), zc(klon), zulow(klon), zvlow(klon), znup(klon), &
-    znum(klon)
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.    initialization
-  ! --------------
-
-  ! PRINT *,' in orosetup'
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.1   computational constants
-  ! -----------------------
-
-
-  ilevh = klev/3
-
-  zcons1 = 1./rd
-  zcons2 = rg**2/rcpd
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.
-  ! --------------
-
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.1     define low level wind, project winds in plane of
-  ! *                 low level wind, determine sector in which to take
-  ! *                 the variance and set indicator for critical levels.
-
-
-
-  DO jl = kidia, kfdia
-    kknu(jl) = klev
-    kknu2(jl) = klev
-    kknub(jl) = klev
-    kknul(jl) = klev
-    pgam(jl) = max(pgam(jl), gtsec)
-    ll1(jl, klev+1) = .FALSE.
-  END DO
-
-  ! Ajouter une initialisation (L. Li, le 23fev99):
-
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      ll1(jl, jk) = .FALSE.
-    END DO
-  END DO
-
-  ! *      define top of low level flow
-  ! ----------------------------
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        lo = (paphm1(jl,jk)/paphm1(jl,klev+1)) >= gsigcr
-        IF (lo) THEN
-          kkcrit(jl) = jk
-        END IF
-        zhcrit(jl, jk) = ppic(jl) - pval(jl)
-        zhgeo = pgeom1(jl, jk)/rg
-        ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-        IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-          kknu(jl) = jk
-        END IF
-        IF (.NOT. ll1(jl,ilevh)) kknu(jl) = ilevh
-      END IF
-    END DO
-  END DO
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zhcrit(jl, jk) = ppic(jl) - pmea(jl)
-        zhgeo = pgeom1(jl, jk)/rg
-        ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-        IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-          kknu2(jl) = jk
-        END IF
-        IF (.NOT. ll1(jl,ilevh)) kknu2(jl) = ilevh
-      END IF
-    END DO
-  END DO
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zhcrit(jl, jk) = amin1(ppic(jl)-pmea(jl), pmea(jl)-pval(jl))
-        zhgeo = pgeom1(jl, jk)/rg
-        ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-        IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-          kknub(jl) = jk
-        END IF
-        IF (.NOT. ll1(jl,ilevh)) kknub(jl) = ilevh
-      END IF
-    END DO
-  END DO
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      kknu(jl) = min(kknu(jl), nktopg)
-      kknu2(jl) = min(kknu2(jl), nktopg)
-      kknub(jl) = min(kknub(jl), nktopg)
-      kknul(jl) = klev
-    END IF
-  END DO
-
-  ! c*     initialize various arrays
-
-  DO jl = kidia, kfdia
-    prho(jl, klev+1) = 0.0
-    ! ym correction en attendant mieux
-    prho(jl, 1) = 0.0
-    pstab(jl, klev+1) = 0.0
-    pstab(jl, 1) = 0.0
-    pri(jl, klev+1) = 9999.0
-    ppsi(jl, klev+1) = 0.0
-    pri(jl, 1) = 0.0
-    pvph(jl, 1) = 0.0
-    pvph(jl, klev+1) = 0.0
-    ! ym correction en attendant mieux
-    ! ym      pvph(jl,klev)    =0.0
-    pulow(jl) = 0.0
-    pvlow(jl) = 0.0
-    zulow(jl) = 0.0
-    zvlow(jl) = 0.0
-    kkcrith(jl) = klev
-    kkenvh(jl) = klev
-    kentp(jl) = klev
-    kcrit(jl) = 1
-    ncount(jl) = 0
-    ll1(jl, klev+1) = .FALSE.
-  END DO
-
-  ! *     define flow density and stratification (rho and N2)
-  ! at semi layers.
-  ! -------------------------------------------------------
-
-  DO jk = klev, 2, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zdp(jl, jk) = papm1(jl, jk) - papm1(jl, jk-1)
-        prho(jl, jk) = 2.*paphm1(jl, jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
-        pstab(jl, jk) = 2.*zcons2/(ptm1(jl,jk)+ptm1(jl,jk-1))* &
-          (1.-rcpd*prho(jl,jk)*(ptm1(jl,jk)-ptm1(jl,jk-1))/zdp(jl,jk))
-        pstab(jl, jk) = max(pstab(jl,jk), gssec)
-      END IF
-    END DO
-  END DO
-
-  ! ********************************************************************
-
-  ! *     define Low level flow (between ground and peacks-valleys)
-  ! ---------------------------------------------------------
-  DO jk = klev, ilevh, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk>=kknu2(jl) .AND. jk<=kknul(jl)) THEN
-          pulow(jl) = pulow(jl) + pum1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk) &
-            )
-          pvlow(jl) = pvlow(jl) + pvm1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk) &
-            )
-          pstab(jl, klev+1) = pstab(jl, klev+1) + pstab(jl, jk)*(paphm1(jl,jk &
-            +1)-paphm1(jl,jk))
-          prho(jl, klev+1) = prho(jl, klev+1) + prho(jl, jk)*(paphm1(jl,jk+1) &
-            -paphm1(jl,jk))
-        END IF
-      END IF
-    END DO
-  END DO
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      pulow(jl) = pulow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
-      pvlow(jl) = pvlow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
-      znorm(jl) = max(sqrt(pulow(jl)**2+pvlow(jl)**2), gvsec)
-      pvph(jl, klev+1) = znorm(jl)
-      pstab(jl, klev+1) = pstab(jl, klev+1)/(paphm1(jl,kknul(jl)+1)-paphm1(jl &
-        ,kknu2(jl)))
-      prho(jl, klev+1) = prho(jl, klev+1)/(paphm1(jl,kknul(jl)+1)-paphm1(jl, &
-        kknu2(jl)))
-    END IF
-  END DO
-
-
-  ! *******  setup orography orientation relative to the low level
-  ! wind and define parameters of the Anisotropic wave stress.
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      lo = (pulow(jl)<gvsec) .AND. (pulow(jl)>=-gvsec)
-      IF (lo) THEN
-        zu = pulow(jl) + 2.*gvsec
-      ELSE
-        zu = pulow(jl)
-      END IF
-      zphi = atan(pvlow(jl)/zu)
-      ppsi(jl, klev+1) = ptheta(jl)*rpi/180. - zphi
-      zb(jl) = 1. - 0.18*pgam(jl) - 0.04*pgam(jl)**2
-      zc(jl) = 0.48*pgam(jl) + 0.3*pgam(jl)**2
-      pd1(jl) = zb(jl) - (zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
-      pd2(jl) = (zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))*cos(ppsi(jl,klev+1))
-      pdmod(jl) = sqrt(pd1(jl)**2+pd2(jl)**2)
-    END IF
-  END DO
-
-  ! ************ projet flow in plane of lowlevel stress *************
-  ! ************ Find critical levels...                 *************
-
-  DO jk = 1, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zvt1 = pulow(jl)*pum1(jl, jk) + pvlow(jl)*pvm1(jl, jk)
-        zvt2 = -pvlow(jl)*pum1(jl, jk) + pulow(jl)*pvm1(jl, jk)
-        zvpf(jl, jk) = (zvt1*pd1(jl)+zvt2*pd2(jl))/(znorm(jl)*pdmod(jl))
-      END IF
-      ptau(jl, jk) = 0.0
-      pzdep(jl, jk) = 0.0
-      ppsi(jl, jk) = 0.0
-      ll1(jl, jk) = .FALSE.
-    END DO
-  END DO
-  DO jk = 2, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zdp(jl, jk) = papm1(jl, jk) - papm1(jl, jk-1)
-        pvph(jl, jk) = ((paphm1(jl,jk)-papm1(jl,jk-1))*zvpf(jl,jk)+(papm1(jl, &
-          jk)-paphm1(jl,jk))*zvpf(jl,jk-1))/zdp(jl, jk)
-        IF (pvph(jl,jk)<gvsec) THEN
-          pvph(jl, jk) = gvsec
-          kcrit(jl) = jk
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! *         2.3     mean flow richardson number.
-
-
-  DO jk = 2, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zdwind = max(abs(zvpf(jl,jk)-zvpf(jl,jk-1)), gvsec)
-        pri(jl, jk) = pstab(jl, jk)*(zdp(jl,jk)/(rg*prho(jl,jk)*zdwind))**2
-        pri(jl, jk) = max(pri(jl,jk), grcrit)
-      END IF
-    END DO
-  END DO
-
-
-
-  ! *      define top of 'envelope' layer
-  ! ----------------------------
-
-  DO jl = kidia, kfdia
-    pnu(jl) = 0.0
-    znum(jl) = 0.0
-  END DO
-
-  DO jk = 2, klev - 1
-    DO jl = kidia, kfdia
-
-      IF (ktest(jl)==1) THEN
-
-        IF (jk>=kknu2(jl)) THEN
-
-          znum(jl) = pnu(jl)
-          zwind = (pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/ &
-            max(sqrt(pulow(jl)**2+pvlow(jl)**2), gvsec)
-          zwind = max(sqrt(zwind**2), gvsec)
-          zdelp = paphm1(jl, jk+1) - paphm1(jl, jk)
-          zstabm = sqrt(max(pstab(jl,jk),gssec))
-          zstabp = sqrt(max(pstab(jl,jk+1),gssec))
-          zrhom = prho(jl, jk)
-          zrhop = prho(jl, jk+1)
-          pnu(jl) = pnu(jl) + (zdelp/rg)*((zstabp/zrhop+zstabm/zrhom)/2.)/ &
-            zwind
-          IF ((znum(jl)<=gfrcrit) .AND. (pnu(jl)>gfrcrit) .AND. (kkenvh( &
-            jl)==klev)) kkenvh(jl) = jk
-
-        END IF
-
-      END IF
-
-    END DO
-  END DO
-
-  ! calculation of a dynamical mixing height for when the waves
-  ! BREAK AT LOW LEVEL: The drag will be repartited over
-  ! a depths that depends on waves vertical wavelength,
-  ! not just between two adjacent model layers.
-  ! of gravity waves:
-
-  DO jl = kidia, kfdia
-    znup(jl) = 0.0
-    znum(jl) = 0.0
-  END DO
-
-  DO jk = klev - 1, 2, -1
-    DO jl = kidia, kfdia
-
-      IF (ktest(jl)==1) THEN
-
-        znum(jl) = znup(jl)
-        zwind = (pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/ &
-          max(sqrt(pulow(jl)**2+pvlow(jl)**2), gvsec)
-        zwind = max(sqrt(zwind**2), gvsec)
-        zdelp = paphm1(jl, jk+1) - paphm1(jl, jk)
-        zstabm = sqrt(max(pstab(jl,jk),gssec))
-        zstabp = sqrt(max(pstab(jl,jk+1),gssec))
-        zrhom = prho(jl, jk)
-        zrhop = prho(jl, jk+1)
-        znup(jl) = znup(jl) + (zdelp/rg)*((zstabp/zrhop+zstabm/zrhom)/2.)/ &
-          zwind
-        IF ((znum(jl)<=rpi/4.) .AND. (znup(jl)>rpi/4.) .AND. (kkcrith( &
-          jl)==klev)) kkcrith(jl) = jk
-
-      END IF
-
-    END DO
-  END DO
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      kkcrith(jl) = max0(kkcrith(jl), ilevh*2)
-      kkcrith(jl) = max0(kkcrith(jl), kknu(jl))
-      IF (kcrit(jl)>=kkcrith(jl)) kcrit(jl) = 1
-    END IF
-  END DO
-
-  ! directional info for flow blocking *************************
-
-  DO jk = 1, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        lo = (pum1(jl,jk)<gvsec) .AND. (pum1(jl,jk)>=-gvsec)
-        IF (lo) THEN
-          zu = pum1(jl, jk) + 2.*gvsec
-        ELSE
-          zu = pum1(jl, jk)
-        END IF
-        zphi = atan(pvm1(jl,jk)/zu)
-        ppsi(jl, jk) = ptheta(jl)*rpi/180. - zphi
-      END IF
-    END DO
-  END DO
-
-  ! forms the vertical 'leakiness' **************************
-
-  DO jk = ilevh, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        pzdep(jl, jk) = 0
-        IF (jk>=kkenvh(jl) .AND. kkenvh(jl)/=klev) THEN
-          pzdep(jl, jk) = (pgeom1(jl,kkenvh(jl))-pgeom1(jl,jk))/ &
-            (pgeom1(jl,kkenvh(jl))-pgeom1(jl,klev))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE orosetup_strato
-SUBROUTINE gwstress_strato(nlon, nlev, kkcrit, ksect, kkhlim, ktest, kkcrith, &
-    kcrit, kkenvh, kknu, prho, pstab, pvph, pstd, psig, pmea, ppic, pval, &
-    ptfr, ptau, pgeom1, pgamma, pd1, pd2, pdmod, pnu)
-
-  ! **** *gwstress*
-
-  ! purpose.
-  ! --------
-  ! Compute the surface stress due to Gravity Waves, according
-  ! to the Phillips (1979) theory of 3-D flow above
-  ! anisotropic elliptic ridges.
-
-  ! The stress is reduced two account for cut-off flow over
-  ! hill.  The flow only see that part of the ridge located
-  ! above the blocked layer (see zeff).
-
-  ! **   interface.
-  ! ----------
-  ! call *gwstress*  from *gwdrag*
-
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-  ! ==== outputs ===
-
-  ! implicit arguments :   none
-  ! --------------------
-
-  ! method.
-  ! -------
-
-
-  ! externals.
-  ! ----------
-
-
-  ! reference.
-  ! ----------
-
-  ! LOTT and MILLER (1997)  &  LOTT (1999)
-
-  ! author.
-  ! -------
-
-  ! modifications.
-  ! --------------
-  ! f. lott put the new gwd on ifs      22/11/93
-
-  ! -----------------------------------------------------------------------
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   arguments
-  ! ---------
-
-  INTEGER nlon, nlev
-  INTEGER kkcrit(nlon), kkcrith(nlon), kcrit(nlon), ksect(nlon), &
-    kkhlim(nlon), ktest(nlon), kkenvh(nlon), kknu(nlon)
-
-  REAL prho(nlon, nlev+1), pstab(nlon, nlev+1), ptau(nlon, nlev+1), &
-    pvph(nlon, nlev+1), ptfr(nlon), pgeom1(nlon, nlev), pstd(nlon)
-
-  REAL pd1(nlon), pd2(nlon), pnu(nlon), psig(nlon), pgamma(nlon)
-  REAL pmea(nlon), ppic(nlon), pval(nlon)
-  REAL pdmod(nlon)
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-  ! ------------
-  ! zeff--real: effective height seen by the flow when there is blocking
-
-  INTEGER jl
-  REAL zeff
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.3   functions
-  ! ---------
-  ! ------------------------------------------------------------------
-
-  ! *         1.    initialization
-  ! --------------
-
-  ! PRINT *,' in gwstress'
-
-  ! *         3.1     gravity wave stress.
-
-
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-
-      ! effective mountain height above the blocked flow
-
-      zeff = ppic(jl) - pval(jl)
-      IF (kkenvh(jl)<klev) THEN
-        zeff = amin1(gfrcrit*pvph(jl,klev+1)/sqrt(pstab(jl,klev+1)), zeff)
-      END IF
-
-
-      ptau(jl, klev+1) = gkdrag*prho(jl, klev+1)*psig(jl)*pdmod(jl)/4./ &
-        pstd(jl)*pvph(jl, klev+1)*sqrt(pstab(jl,klev+1))*zeff**2
-
-
-      ! too small value of stress or  low level flow include critical level
-      ! or low level flow:  gravity wave stress nul.
-
-      ! lo=(ptau(jl,klev+1).lt.gtsec).or.(kcrit(jl).ge.kknu(jl))
-      ! *      .or.(pvph(jl,klev+1).lt.gvcrit)
-      ! if(lo) ptau(jl,klev+1)=0.0
-
-      ! print *,jl,ptau(jl,klev+1)
-
-    ELSE
-
-      ptau(jl, klev+1) = 0.0
-
-    END IF
-
-  END DO
-
-  ! write(21)(ptau(jl,klev+1),jl=kidia,kfdia)
-
-  RETURN
-END SUBROUTINE gwstress_strato
-
-SUBROUTINE gwprofil_strato(nlon, nlev, kgwd, kdx, ktest, kkcrit, kkcrith, &
-    kcrit, kkenvh, kknu, kknu2, paphm1, prho, pstab, ptfr, pvph, pri, ptau, &
-    pdmod, pnu, psig, pgamma, pstd, ppic, pval)
-
-  ! **** *gwprofil*
-
-  ! purpose.
-  ! --------
-
-  ! **   interface.
-  ! ----------
-  ! from *gwdrag*
-
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-
-  ! ==== outputs ===
-
-  ! implicit arguments :   none
-  ! --------------------
-
-  ! method:
-  ! -------
-  ! the stress profile for gravity waves is computed as follows:
-  ! it decreases linearly with heights from the ground
-  ! to the low-level indicated by kkcrith,
-  ! to simulates lee waves or
-  ! low-level gravity wave breaking.
-  ! above it is constant, except when the waves encounter a critical
-  ! level (kcrit) or when they break.
-  ! The stress is also uniformly distributed above the level
-  ! nstra.
-
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   ARGUMENTS
-  ! ---------
-
-  INTEGER nlon, nlev, kgwd
-  INTEGER kkcrit(nlon), kkcrith(nlon), kcrit(nlon), kdx(nlon), ktest(nlon), &
-    kkenvh(nlon), kknu(nlon), kknu2(nlon)
-
-  REAL paphm1(nlon, nlev+1), pstab(nlon, nlev+1), prho(nlon, nlev+1), &
-    pvph(nlon, nlev+1), pri(nlon, nlev+1), ptfr(nlon), ptau(nlon, nlev+1)
-
-  REAL pdmod(nlon), pnu(nlon), psig(nlon), pgamma(nlon), pstd(nlon), &
-    ppic(nlon), pval(nlon)
-
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-  ! ------------
-
-  INTEGER jl, jk
-  REAL zsqr, zalfa, zriw, zdel, zb, zalpha, zdz2n, zdelp, zdelpt
-
-  REAL zdz2(klon, klev), znorm(klon), zoro(klon)
-  REAL ztau(klon, klev+1)
-
-  ! -----------------------------------------------------------------------
-
-  ! *         1.    INITIALIZATION
-  ! --------------
-
-  ! print *,' entree gwprofil'
-
-
-  ! *    COMPUTATIONAL CONSTANTS.
-  ! ------------- ----------
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      zoro(jl) = psig(jl)*pdmod(jl)/4./pstd(jl)
-      ztau(jl, klev+1) = ptau(jl, klev+1)
-      ! print *,jl,ptau(jl,klev+1)
-      ztau(jl, kkcrith(jl)) = grahilo*ptau(jl, klev+1)
-    END IF
-  END DO
-
-
-  DO jk = klev + 1, 1, -1
-    ! *         4.1    constant shear stress until top of the
-    ! low-level breaking/trapped layer
-
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk>kkcrith(jl)) THEN
-          zdelp = paphm1(jl, jk) - paphm1(jl, klev+1)
-          zdelpt = paphm1(jl, kkcrith(jl)) - paphm1(jl, klev+1)
-          ptau(jl, jk) = ztau(jl, klev+1) + zdelp/zdelpt*(ztau(jl,kkcrith(jl) &
-            )-ztau(jl,klev+1))
-        ELSE
-          ptau(jl, jk) = ztau(jl, kkcrith(jl))
-        END IF
-      END IF
-    END DO
-
-    ! *         4.15   constant shear stress until the top of the
-    ! low level flow layer.
-
-
-    ! *         4.2    wave displacement at next level.
-
-
-  END DO
-
-
-  ! *         4.4    wave richardson number, new wave displacement
-  ! *                and stress:  breaking evaluation and critical
-  ! level
-
-
-  DO jk = klev, 1, -1
-
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        znorm(jl) = prho(jl, jk)*sqrt(pstab(jl,jk))*pvph(jl, jk)
-        zdz2(jl, jk) = ptau(jl, jk)/amax1(znorm(jl), gssec)/zoro(jl)
-      END IF
-    END DO
-
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk<kkcrith(jl)) THEN
-          IF ((ptau(jl,jk+1)<gtsec) .OR. (jk<=kcrit(jl))) THEN
-            ptau(jl, jk) = 0.0
-          ELSE
-            zsqr = sqrt(pri(jl,jk))
-            zalfa = sqrt(pstab(jl,jk)*zdz2(jl,jk))/pvph(jl, jk)
-            zriw = pri(jl, jk)*(1.-zalfa)/(1+zalfa*zsqr)**2
-            IF (zriw<grcrit) THEN
-              ! print *,' breaking!!!',ptau(jl,jk)
-              zdel = 4./zsqr/grcrit + 1./grcrit**2 + 4./grcrit
-              zb = 1./grcrit + 2./zsqr
-              zalpha = 0.5*(-zb+sqrt(zdel))
-              zdz2n = (pvph(jl,jk)*zalpha)**2/pstab(jl, jk)
-              ptau(jl, jk) = znorm(jl)*zdz2n*zoro(jl)
-            END IF
-
-            ptau(jl, jk) = amin1(ptau(jl,jk), ptau(jl,jk+1))
-
-          END IF
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      ztau(jl, kkcrith(jl)-1) = ptau(jl, kkcrith(jl)-1)
-      ztau(jl, nstra) = ptau(jl, nstra)
-    END IF
-  END DO
-
-  DO jk = 1, klev
-
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-
-        IF (jk>kkcrith(jl)-1) THEN
-
-          zdelp = paphm1(jl, jk) - paphm1(jl, klev+1)
-          zdelpt = paphm1(jl, kkcrith(jl)-1) - paphm1(jl, klev+1)
-          ptau(jl, jk) = ztau(jl, klev+1) + (ztau(jl,kkcrith(jl)-1)-ztau(jl, &
-            klev+1))*zdelp/zdelpt
-
-        END IF
-      END IF
-
-    END DO
-
-    ! REORGANISATION AT THE MODEL TOP....
-
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-
-        IF (jk<nstra) THEN
-
-          zdelp = paphm1(jl, nstra)
-          zdelpt = paphm1(jl, jk)
-          ptau(jl, jk) = ztau(jl, nstra)*zdelpt/zdelp
-          ! ptau(jl,jk)=ztau(jl,nstra)
-
-        END IF
-
-      END IF
-
-    END DO
-
-
-  END DO
-
-
-123 FORMAT (I4, 1X, 20(F6.3,1X))
-
-
-  RETURN
-END SUBROUTINE gwprofil_strato
-SUBROUTINE lift_noro_strato(nlon, nlev, dtime, paprs, pplay, plat, pmea, &
-    pstd, psig, pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, &
-    pvlow, pustr, pvstr, d_t, d_u, d_v)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201
-  ! Object: Mountain lift interface (enhanced vortex stretching).
-  ! Made necessary because:
-  ! 1. in the LMD-GCM Layers are from bottom to top,
-  ! contrary to most European GCM.
-  ! 2. the altitude above ground of each model layers
-  ! needs to be known (variable zgeom)
-  ! ======================================================================
-  ! Explicit Arguments:
-  ! ==================
-  ! nlon----input-I-Total number of horizontal points that get into physics
-  ! nlev----input-I-Number of vertical levels
-  ! dtime---input-R-Time-step (s)
-  ! paprs---input-R-Pressure in semi layers    (Pa)
-  ! pplay---input-R-Pressure model-layers      (Pa)
-  ! t-------input-R-temperature (K)
-  ! u-------input-R-Horizontal wind (m/s)
-  ! v-------input-R-Meridional wind (m/s)
-  ! pmea----input-R-Mean Orography (m)
-  ! pstd----input-R-SSO standard deviation (m)
-  ! psig----input-R-SSO slope
-  ! pgam----input-R-SSO Anisotropy
-  ! pthe----input-R-SSO Angle
-  ! ppic----input-R-SSO Peacks elevation (m)
-  ! pval----input-R-SSO Valleys elevation (m)
-
-  ! kgwd- -input-I: Total nb of points where the orography schemes are active
-  ! ktest--input-I: Flags to indicate active points
-  ! kdx----input-I: Locate the physical location of an active point.
-
-  ! pulow, pvlow -output-R: Low-level wind
-  ! pustr, pvstr -output-R: Surface stress due to SSO drag      (Pa)
-
-  ! d_t-----output-R: T increment
-  ! d_u-----output-R: U increment
-  ! d_v-----output-R: V increment
-
-  ! Implicit Arguments:
-  ! ===================
-
-  ! iim--common-I: Number of longitude intervals
-  ! jjm--common-I: Number of latitude intervals
-  ! klon-common-I: Number of points seen by the physics
-  ! (iim+1)*(jjm+1) for instance
-  ! klev-common-I: Number of vertical layers
-  ! ======================================================================
-  ! Local Variables:
-  ! ================
-
-  ! zgeom-----R: Altitude of layer above ground
-  ! pt, pu, pv --R: t u v from top to bottom
-  ! pdtdt, pdudt, pdvdt --R: t u v tendencies (from top to bottom)
-  ! papmf: pressure at model layer (from top to bottom)
-  ! papmh: pressure at model 1/2 layer (from top to bottom)
-
-  ! ======================================================================
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-
-  ! ARGUMENTS
-
-  INTEGER nlon, nlev
-  REAL dtime
-  REAL paprs(klon, klev+1)
-  REAL pplay(klon, klev)
-  REAL plat(nlon), pmea(nlon)
-  REAL pstd(nlon), psig(nlon), pgam(nlon), pthe(nlon)
-  REAL ppic(nlon), pval(nlon)
-  REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)
-  REAL t(nlon, nlev), u(nlon, nlev), v(nlon, nlev)
-  REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev)
-
-  INTEGER i, k, kgwd, kdx(nlon), ktest(nlon)
-
-  ! Variables locales:
-
-  REAL zgeom(klon, klev)
-  REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev)
-  REAL pt(klon, klev), pu(klon, klev), pv(klon, klev)
-  REAL papmf(klon, klev), papmh(klon, klev+1)
-
-  ! initialiser les variables de sortie (pour securite)
-
-
-  ! print *,'in lift_noro'
-  DO i = 1, klon
-    pulow(i) = 0.0
-    pvlow(i) = 0.0
-    pustr(i) = 0.0
-    pvstr(i) = 0.0
-  END DO
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = 0.0
-      d_u(i, k) = 0.0
-      d_v(i, k) = 0.0
-      pdudt(i, k) = 0.0
-      pdvdt(i, k) = 0.0
-      pdtdt(i, k) = 0.0
-    END DO
-  END DO
-
-  ! preparer les variables d'entree (attention: l'ordre des niveaux
-  ! verticaux augmente du haut vers le bas)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      pt(i, k) = t(i, klev-k+1)
-      pu(i, k) = u(i, klev-k+1)
-      pv(i, k) = v(i, klev-k+1)
-      papmf(i, k) = pplay(i, klev-k+1)
-    END DO
-  END DO
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      papmh(i, k) = paprs(i, klev-k+2)
-    END DO
-  END DO
-  DO i = 1, klon
-    zgeom(i, klev) = rd*pt(i, klev)*log(papmh(i,klev+1)/papmf(i,klev))
-  END DO
-  DO k = klev - 1, 1, -1
-    DO i = 1, klon
-      zgeom(i, k) = zgeom(i, k+1) + rd*(pt(i,k)+pt(i,k+1))/2.0*log(papmf(i,k+ &
-        1)/papmf(i,k))
-    END DO
-  END DO
-
-  ! appeler la routine principale
-
-
-  CALL orolift_strato(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, &
-    zgeom, pt, pu, pv, plat, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, &
-    pvlow, pdudt, pdvdt, pdtdt)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_u(i, klev+1-k) = dtime*pdudt(i, k)
-      d_v(i, klev+1-k) = dtime*pdvdt(i, k)
-      d_t(i, klev+1-k) = dtime*pdtdt(i, k)
-      pustr(i) = pustr(i) + pdudt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-      pvstr(i) = pvstr(i) + pdvdt(i, k)*(papmh(i,k+1)-papmh(i,k))/rg
-    END DO
-  END DO
-
-  ! print *,' out lift_noro'
-
-  RETURN
-END SUBROUTINE lift_noro_strato
-SUBROUTINE orolift_strato(nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, &
-    papm1, pgeom1, ptm1, pum1, pvm1, plat, pmea, pstd, psig, pgam, pthe, &
-    ppic, pval &                   ! OUTPUTS
-    , pulow, pvlow, pvom, pvol, pte)
-
-
-  ! **** *OROLIFT: SIMULATE THE GEOSTROPHIC LIFT.
-
-  ! PURPOSE.
-  ! --------
-  ! this routine computes the physical tendencies of the
-  ! prognostic variables u,v  when enhanced vortex stretching
-  ! is needed.
-
-  ! **   INTERFACE.
-  ! ----------
-  ! CALLED FROM *lift_noro
-  ! explicit arguments :
-  ! --------------------
-  ! ==== inputs ===
-  ! nlon----input-I-Total number of horizontal points that get into physics
-  ! nlev----input-I-Number of vertical levels
-
-  ! kgwd- -input-I: Total nb of points where the orography schemes are active
-  ! ktest--input-I: Flags to indicate active points
-  ! kdx----input-I: Locate the physical location of an active point.
-  ! ptsphy--input-R-Time-step (s)
-  ! paphm1--input-R: pressure at model 1/2 layer
-  ! papm1---input-R: pressure at model layer
-  ! pgeom1--input-R: Altitude of layer above ground
-  ! ptm1, pum1, pvm1--R-: t, u and v
-  ! pmea----input-R-Mean Orography (m)
-  ! pstd----input-R-SSO standard deviation (m)
-  ! psig----input-R-SSO slope
-  ! pgam----input-R-SSO Anisotropy
-  ! pthe----input-R-SSO Angle
-  ! ppic----input-R-SSO Peacks elevation (m)
-  ! pval----input-R-SSO Valleys elevation (m)
-  ! plat----input-R-Latitude (degree)
-
-  ! ==== outputs ===
-  ! pulow, pvlow -output-R: Low-level wind
-
-  ! pte -----output-R: T tendency
-  ! pvom-----output-R: U tendency
-  ! pvol-----output-R: V tendency
-
-
-  ! Implicit Arguments:
-  ! ===================
-
-  ! klon-common-I: Number of points seen by the physics
-  ! klev-common-I: Number of vertical layers
-
-
-  ! ----------
-
-  ! AUTHOR.
-  ! -------
-  ! F.LOTT  LMD 22/11/95
-
-  USE dimphy
-  IMPLICIT NONE
-
-
-  include "YOMCST.h"
-  include "YOEGWD.h"
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   ARGUMENTS
-  ! ---------
-
-
-  INTEGER nlon, nlev, kgwd
-  REAL ptsphy
-  REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), &
-    pvlow(nlon)
-  REAL pum1(nlon, nlev), pvm1(nlon, nlev), ptm1(nlon, nlev), plat(nlon), &
-    pmea(nlon), pstd(nlon), psig(nlon), pgam(nlon), pthe(nlon), ppic(nlon), &
-    pval(nlon), pgeom1(nlon, nlev), papm1(nlon, nlev), paphm1(nlon, nlev+1)
-
-  INTEGER kdx(nlon), ktest(nlon)
-  ! -----------------------------------------------------------------------
-
-  ! *       0.2   local arrays
-
-  INTEGER jl, ilevh, jk
-  REAL zhgeo, zdelp, zslow, zsqua, zscav, zbet
-  ! ------------
-  INTEGER iknub(klon), iknul(klon)
-  LOGICAL ll1(klon, klev+1)
-
-  REAL ztau(klon, klev+1), ztav(klon, klev+1), zrho(klon, klev+1)
-  REAL zdudt(klon), zdvdt(klon)
-  REAL zhcrit(klon, klev)
-
-  LOGICAL lifthigh
-  REAL zcons1, ztmst
-  CHARACTER (LEN=20) :: modname = 'orolift_strato'
-  CHARACTER (LEN=80) :: abort_message
-
-
-  ! -----------------------------------------------------------------------
-
-  ! *         1.1  initialisations
-  ! ---------------
-
-  lifthigh = .FALSE.
-
-  IF (nlon/=klon .OR. nlev/=klev) THEN
-    abort_message = 'pb dimension'
-    CALL abort_physic(modname, abort_message, 1)
-  END IF
-  zcons1 = 1./rd
-  ztmst = ptsphy
-
-  DO jl = kidia, kfdia
-    zrho(jl, klev+1) = 0.0
-    pulow(jl) = 0.0
-    pvlow(jl) = 0.0
-    iknub(jl) = klev
-    iknul(jl) = klev
-    ilevh = klev/3
-    ll1(jl, klev+1) = .FALSE.
-    DO jk = 1, klev
-      pvom(jl, jk) = 0.0
-      pvol(jl, jk) = 0.0
-      pte(jl, jk) = 0.0
-    END DO
-  END DO
-
-
-  ! *         2.1     DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
-  ! *                 LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
-  ! *                 THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
-
-
-
-  DO jk = klev, 1, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        zhcrit(jl, jk) = amax1(ppic(jl)-pval(jl), 100.)
-        zhgeo = pgeom1(jl, jk)/rg
-        ll1(jl, jk) = (zhgeo>zhcrit(jl,jk))
-        IF (ll1(jl,jk) .NEQV. ll1(jl,jk+1)) THEN
-          iknub(jl) = jk
-        END IF
-      END IF
-    END DO
-  END DO
-
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      iknub(jl) = max(iknub(jl), klev/2)
-      iknul(jl) = max(iknul(jl), 2*klev/3)
-      IF (iknub(jl)>nktopg) iknub(jl) = nktopg
-      IF (iknub(jl)==nktopg) iknul(jl) = klev
-      IF (iknub(jl)==iknul(jl)) iknub(jl) = iknul(jl) - 1
-    END IF
-  END DO
-
-  DO jk = klev, 2, -1
-    DO jl = kidia, kfdia
-      zrho(jl, jk) = 2.*paphm1(jl, jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
-    END DO
-  END DO
-  ! print *,'  dans orolift: 223'
-
-  ! ********************************************************************
-
-  ! *     define low level flow
-  ! -------------------
-  DO jk = klev, 1, -1
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        IF (jk>=iknub(jl) .AND. jk<=iknul(jl)) THEN
-          pulow(jl) = pulow(jl) + pum1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk) &
-            )
-          pvlow(jl) = pvlow(jl) + pvm1(jl, jk)*(paphm1(jl,jk+1)-paphm1(jl,jk) &
-            )
-          zrho(jl, klev+1) = zrho(jl, klev+1) + zrho(jl, jk)*(paphm1(jl,jk+1) &
-            -paphm1(jl,jk))
-        END IF
-      END IF
-    END DO
-  END DO
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      pulow(jl) = pulow(jl)/(paphm1(jl,iknul(jl)+1)-paphm1(jl,iknub(jl)))
-      pvlow(jl) = pvlow(jl)/(paphm1(jl,iknul(jl)+1)-paphm1(jl,iknub(jl)))
-      zrho(jl, klev+1) = zrho(jl, klev+1)/(paphm1(jl,iknul(jl)+1)-paphm1(jl, &
-        iknub(jl)))
-    END IF
-  END DO
-
-  ! ***********************************************************
-
-  ! *         3.      COMPUTE MOUNTAIN LIFT
-
-
-  DO jl = kidia, kfdia
-    IF (ktest(jl)==1) THEN
-      ztau(jl, klev+1) = -gklift*zrho(jl, klev+1)*2.*romega* & ! *
-                                                               ! (2*pstd(jl)+pmea(jl))*
-        2*pstd(jl)*sin(rpi/180.*plat(jl))*pvlow(jl)
-      ztav(jl, klev+1) = gklift*zrho(jl, klev+1)*2.*romega* & ! *
-                                                              ! (2*pstd(jl)+pmea(jl))*
-        2*pstd(jl)*sin(rpi/180.*plat(jl))*pulow(jl)
-    ELSE
-      ztau(jl, klev+1) = 0.0
-      ztav(jl, klev+1) = 0.0
-    END IF
-  END DO
-
-  ! *         4.      COMPUTE LIFT PROFILE
-  ! *                 --------------------
-
-
-
-  DO jk = 1, klev
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        ztau(jl, jk) = ztau(jl, klev+1)*paphm1(jl, jk)/paphm1(jl, klev+1)
-        ztav(jl, jk) = ztav(jl, klev+1)*paphm1(jl, jk)/paphm1(jl, klev+1)
-      ELSE
-        ztau(jl, jk) = 0.0
-        ztav(jl, jk) = 0.0
-      END IF
-    END DO
-  END DO
-
-
-  ! *         5.      COMPUTE TENDENCIES.
-  ! *                 -------------------
-  IF (lifthigh) THEN
-    ! EXPLICIT SOLUTION AT ALL LEVELS
-
-    DO jk = 1, klev
-      DO jl = kidia, kfdia
-        IF (ktest(jl)==1) THEN
-          zdelp = paphm1(jl, jk+1) - paphm1(jl, jk)
-          zdudt(jl) = -rg*(ztau(jl,jk+1)-ztau(jl,jk))/zdelp
-          zdvdt(jl) = -rg*(ztav(jl,jk+1)-ztav(jl,jk))/zdelp
-        END IF
-      END DO
-    END DO
-
-    ! PROJECT PERPENDICULARLY TO U NOT TO DESTROY ENERGY
-
-    DO jk = 1, klev
-      DO jl = kidia, kfdia
-        IF (ktest(jl)==1) THEN
-
-          zslow = sqrt(pulow(jl)**2+pvlow(jl)**2)
-          zsqua = amax1(sqrt(pum1(jl,jk)**2+pvm1(jl,jk)**2), gvsec)
-          zscav = -zdudt(jl)*pvm1(jl, jk) + zdvdt(jl)*pum1(jl, jk)
-          IF (zsqua>gvsec) THEN
-            pvom(jl, jk) = -zscav*pvm1(jl, jk)/zsqua**2
-            pvol(jl, jk) = zscav*pum1(jl, jk)/zsqua**2
-          ELSE
-            pvom(jl, jk) = 0.0
-            pvol(jl, jk) = 0.0
-          END IF
-          zsqua = sqrt(pum1(jl,jk)**2+pum1(jl,jk)**2)
-          IF (zsqua<zslow) THEN
-            pvom(jl, jk) = zsqua/zslow*pvom(jl, jk)
-            pvol(jl, jk) = zsqua/zslow*pvol(jl, jk)
-          END IF
-
-        END IF
-      END DO
-    END DO
-
-    ! 6.  LOW LEVEL LIFT, SEMI IMPLICIT:
-    ! ----------------------------------
-
-  ELSE
-
-    DO jl = kidia, kfdia
-      IF (ktest(jl)==1) THEN
-        DO jk = klev, iknub(jl), -1
-          zbet = gklift*2.*romega*sin(rpi/180.*plat(jl))*ztmst* &
-            (pgeom1(jl,iknub(jl)-1)-pgeom1(jl,jk))/ &
-            (pgeom1(jl,iknub(jl)-1)-pgeom1(jl,klev))
-          zdudt(jl) = -pum1(jl, jk)/ztmst/(1+zbet**2)
-          zdvdt(jl) = -pvm1(jl, jk)/ztmst/(1+zbet**2)
-          pvom(jl, jk) = zbet**2*zdudt(jl) - zbet*zdvdt(jl)
-          pvol(jl, jk) = zbet*zdudt(jl) + zbet**2*zdvdt(jl)
-        END DO
-      END IF
-    END DO
-
-  END IF
-
-  ! print *,' out orolift'
-
-  RETURN
-END SUBROUTINE orolift_strato
-SUBROUTINE sugwd_strato(nlon, nlev, paprs, pplay)
-
-
-  ! **** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
-
-  ! PURPOSE.
-  ! --------
-  ! INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
-  ! GRAVITY WAVE DRAG PARAMETRIZATION.
-  ! VERY IMPORTANT:
-  ! ______________
-  ! THIS ROUTINE SET_UP THE "TUNABLE PARAMETERS" OF THE
-  ! VARIOUS SSO SCHEMES
-
-  ! **   INTERFACE.
-  ! ----------
-  ! CALL *SUGWD* FROM *SUPHEC*
-  ! -----        ------
-
-  ! EXPLICIT ARGUMENTS :
-  ! --------------------
-  ! PAPRS,PPLAY : Pressure at semi and full model levels
-  ! NLEV        : number of model levels
-  ! NLON        : number of points treated in the physics
-
-  ! IMPLICIT ARGUMENTS :
-  ! --------------------
-  ! COMMON YOEGWD
-  ! -GFRCRIT-R:  Critical Non-dimensional mountain Height
-  ! (HNC in (1),    LOTT 1999)
-  ! -GKWAKE--R:  Bluff-body drag coefficient for low level wake
-  ! (Cd in (2),     LOTT 1999)
-  ! -GRCRIT--R:  Critical Richardson Number
-  ! (Ric, End of first column p791 of LOTT 1999)
-  ! -GKDRAG--R:  Gravity wave drag coefficient
-  ! (G in (3),      LOTT 1999)
-  ! -GKLIFT--R:  Mountain Lift coefficient
-  ! (Cl in (4),     LOTT 1999)
-  ! -GHMAX---R:  Not used
-  ! -GRAHILO-R:  Set-up the trapped waves fraction
-  ! (Beta , End of first column,  LOTT 1999)
-
-  ! -GSIGCR--R:  Security value for blocked flow depth
-  ! -NKTOPG--I:  Security value for blocked flow level
-  ! -nstra----I:  An estimate to qualify the upper levels of
-  ! the model where one wants to impose strees
-  ! profiles
-  ! -GSSECC--R:  Security min value for low-level B-V frequency
-  ! -GTSEC---R:  Security min value for anisotropy and GW stress.
-  ! -GVSEC---R:  Security min value for ulow
-
-
-  ! METHOD.
-  ! -------
-  ! SEE DOCUMENTATION
-
-  ! EXTERNALS.
-  ! ----------
-  ! NONE
-
-  ! REFERENCE.
-  ! ----------
-  ! Lott, 1999: Alleviation of stationary biases in a GCM through...
-  ! Monthly Weather Review, 127, pp 788-801.
-
-  ! AUTHOR.
-  ! -------
-  ! FRANCOIS LOTT        *LMD*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 90-01-01 (MARTIN MILLER, ECMWF)
-  ! LAST:  99-07-09     (FRANCOIS LOTT,LMD)
-  ! ------------------------------------------------------------------
-  USE dimphy
-  USE mod_phys_lmdz_para
-  USE mod_grid_phy_lmdz
-  USE geometry_mod
-  IMPLICIT NONE
-
-  ! -----------------------------------------------------------------
-  include "YOEGWD.h"
-  ! ----------------------------------------------------------------
-
-  ! ARGUMENTS
-  INTEGER nlon, nlev
-  REAL paprs(nlon, nlev+1)
-  REAL pplay(nlon, nlev)
-
-  INTEGER jk
-  REAL zpr, ztop, zsigt, zpm1r
-  INTEGER :: cell,ij,nstra_tmp,nktopg_tmp
-  REAL :: current_dist, dist_min,dist_min_glo
-
-  ! *       1.    SET THE VALUES OF THE PARAMETERS
-  ! --------------------------------
-
-
-  PRINT *, ' DANS SUGWD NLEV=', nlev
-  ghmax = 10000.
-
-  zpr = 100000.
-  ZTOP=0.00005
-  zsigt = 0.94
-  ! old  ZPR=80000.
-  ! old  ZSIGT=0.85
-
-
-!ym Take the point at equator close to (0,0) coordinates.
-  dist_min=360
-  dist_min_glo=360.
-  cell=-1
-  DO ij=1,klon
-    current_dist=sqrt(longitude_deg(ij)**2+latitude_deg(ij)**2)
-    current_dist=current_dist*(1+(1e-10*ind_cell_glo(ij))/klon_glo) ! For point unicity
-    IF (dist_min>current_dist) THEN
-      dist_min=current_dist
-      cell=ij    
-    ENDIF  
-  ENDDO
-  
-  !PRINT *, 'SUGWD distmin cell=', dist_min,cell
-  CALL reduce_min(dist_min,dist_min_glo)
-  CALL bcast(dist_min_glo)
-  IF (dist_min/=dist_min_glo) cell=-1
-!ym in future find the point at equator close to (0,0) coordinates.
-  PRINT *, 'SUGWD distmin dist_min_glo cell=', dist_min,dist_min_glo,cell
-
-  nktopg_tmp=nktopg
-  nstra_tmp=nstra
-  
-  IF (cell/=-1) THEN
-
-    !print*,'SUGWD shape ',shape(pplay),cell+1
-
-    DO jk = 1, nlev
-      !zpm1r = pplay(cell+1, jk)/paprs(cell+1, 1)
-      zpm1r = pplay(cell, jk)/paprs(cell, 1)
-      IF (zpm1r>=zsigt) THEN
-        nktopg_tmp = jk
-      END IF
-      IF (zpm1r>=ztop) THEN
-        nstra_tmp = jk
-      END IF
-    END DO
-  ELSE
-    nktopg_tmp=0
-    nstra_tmp=0
-  ENDIF
-  
-  CALL reduce_sum(nktopg_tmp,nktopg)
-  CALL bcast(nktopg)
-  CALL reduce_sum(nstra_tmp,nstra)
-  CALL bcast(nstra)
-  
-  ! inversion car dans orodrag on compte les niveaux a l'envers
-  nktopg = nlev - nktopg + 1
-  nstra = nlev - nstra
-  PRINT *, ' DANS SUGWD nktopg=', nktopg
-  PRINT *, ' DANS SUGWD nstra=', nstra
-  if (nstra == 0) call abort_physic("sugwd_strato", "no level in stratosphere", 1)
-
-!  Valeurs lues dans les .def, ou attribues dans conf_phys
-  !gkdrag = 0.2   
-  !grahilo = 0.1
-  !grcrit = 1.00
-  !gfrcrit = 0.70
-  !gkwake = 0.40
-  !gklift = 0.25
-
-  gsigcr = 0.80 ! Top of low level flow
-  gvcrit = 0.1
-
-  WRITE (UNIT=6, FMT='('' *** SSO essential constants ***'')')
-  WRITE (UNIT=6, FMT='('' *** SPECIFIED IN SUGWD ***'')')
-  WRITE (UNIT=6, FMT='('' Gravity wave ct '',E13.7,'' '')') gkdrag
-  WRITE (UNIT=6, FMT='('' Trapped/total wave dag '',E13.7,'' '')') grahilo
-  WRITE (UNIT=6, FMT='('' Critical Richardson   = '',E13.7,'' '')') grcrit
-  WRITE (UNIT=6, FMT='('' Critical Froude'',e13.7)') gfrcrit
-  WRITE (UNIT=6, FMT='('' Low level Wake bluff cte'',e13.7)') gkwake
-  WRITE (UNIT=6, FMT='('' Low level lift  cte'',e13.7)') gklift
-
-  ! ----------------------------------------------------------------
-
-  ! *       2.    SET VALUES OF SECURITY PARAMETERS
-  ! ---------------------------------
-
-
-  gvsec = 0.10
-  gssec = 0.0001
-
-  gtsec = 0.00001
-
-  RETURN
-END SUBROUTINE sugwd_strato
+link ../phylmd/orografi_strato.F90
Index: LMDZ6/trunk/libf/phylmdiso/ozonecm_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ozonecm_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ozonecm_m.F90	(revision 3940)
@@ -1,97 +1,1 @@
-! $Header$
-module ozonecm_m
-
-  IMPLICIT NONE
-
-contains
-
-  function ozonecm(rlat, paprs,read_climoz, rjour)
-
-    ! The ozone climatology is based on an analytic formula which fits the
-    ! Krueger and Mintzner (1976) profile, as well as the variations with
-    ! altitude and latitude of the maximum ozone concentrations and the total
-    ! column ozone concentration of Keating and Young (1986). The analytic
-    ! formula have been established by J.-F. Royer (CRNM, Meteo France), who
-    ! also provided us the code.
-
-    ! A. J. Krueger and R. A. Minzner, A Mid-Latitude Ozone Model for the
-    ! 1976 U.S. Standard Atmosphere, J. Geophys. Res., 81, 4477, (1976).
-
-    ! Keating, G. M. and D. F. Young, 1985: Interim reference models for the
-    ! middle atmosphere, Handbook for MAP, vol. 16, 205-229.
-
-    USE dimphy, only: klon, klev
-    use assert_m, only: assert
-
-    REAL, INTENT (IN) :: rlat(:) ! (klon)
-    REAL, INTENT (IN) :: paprs(:, :) ! (klon,klev+1)
-    REAL, INTENT (IN) :: rjour
-    INTEGER, INTENT (IN) :: read_climoz
-
-    REAL ozonecm(klon,klev)
-    ! "ozonecm(j, k)" is the column-density of ozone in cell "(j, k)", that is
-    ! between interface "k" and interface "k + 1", in kDU.
-
-    ! Variables local to the procedure:
-
-    REAL tozon ! equivalent pressure of ozone above interface "k", in Pa
-    real pi, pl
-    INTEGER i, k
-
-    REAL field(klon,klev+1)
-    ! "field(:, k)" is the column-density of ozone between interface
-    ! "k" and the top of the atmosphere (interface "llm + 1"), in kDU.
-
-    real, PARAMETER:: ps=101325.
-    REAL, parameter:: an = 360., zo3q3 = 4E-8
-    REAL, parameter:: dobson_unit = 2.1415E-5 ! in kg m-2
-    REAL gms, zslat,zslat2, zsint, zcost, z, ppm, qpm, a
-    REAL asec, bsec, aprim, zo3a3
-
-    !----------------------------------------------------------
-
-    call assert((/size(rlat), size(paprs, 1)/) == klon, "ozonecm klon")
-    call assert(size(paprs, 2) == klev + 1, "ozonecm klev")
-
-    pi = 4. * atan(1.)
-    DO k = 1, klev
-       DO i = 1, klon
-          zslat = sin(pi / 180. * rlat(i))
-          zslat2=zslat*zslat
-          IF (read_climoz==-1) zslat=0. ! Imposing hemispheric symetry
-          zsint = sin(2 * pi * (rjour + 15.) / an)
-          zcost = cos(2 * pi * (rjour + 15.) / an)
-          z = 0.0531 + zsint * (-0.001595+0.009443*zslat) &
-               + zcost * (-0.001344-0.00346*zslat) &
-               + zslat2 * (.056222 + zslat2 &
-               * (-.037609+.012248*zsint+.00521*zcost+.008890*zslat))
-          zo3a3 = zo3q3/ps/2.
-          z = z - zo3q3*ps
-          gms = z
-          ppm = 800. - 500.*zslat2 - 150.*zcost*zslat
-          qpm = 1.74E-5 - 7.5E-6*zslat2 - 1.7E-6*zcost*zslat
-          bsec = 2650. + 5000.*zslat2
-          a = 4.0*(bsec)**(3./2.)*(ppm)**(3./2.)*(1.0+(bsec/ps)**(3./2.))
-          a = a/(bsec**(3./2.)+ppm**(3./2.))**2
-          aprim = (2.666666*qpm*ppm-a*gms)/(1.0-a)
-          aprim = amax1(0., aprim)
-          asec = (gms-aprim)*(1.0+(bsec/ps)**(3./2.))
-          asec = amax1(0.0, asec)
-          aprim = gms - asec/(1.+(bsec/ps)**(3./2.))
-          pl = paprs(i, k)
-          tozon = aprim / (1. + 3. * (ppm / pl)**2) &
-               + asec / (1. + (bsec / pl)**(3./2.)) + zo3a3 * pl * pl
-          ! Convert from Pa to kDU:
-          field(i, k) = tozon / 9.81 / dobson_unit / 1e3
-       END DO
-    END DO
-
-    field(:,klev+1) = 0.
-    forall (k = 1: klev) ozonecm(:,k) = field(:,k) - field(:,k+1)
-    ozonecm = max(ozonecm, 1e-12)
-
-!    print*,'ozonecm Version2'
-
-  END function ozonecm
-
-end module ozonecm_m
+link ../phylmd/ozonecm_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/paramlmdz_phy_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/paramlmdz_phy_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/paramlmdz_phy_mod.F90	(revision 3940)
@@ -1,237 +1,1 @@
-MODULE paramLMDZ_phy_mod 
-
-! Olivier 13/07/2016
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-CONTAINS
-
-  SUBROUTINE ini_paramLMDZ_phy(dtime,nid_ctesGCM)
-
-    USE iophy 
-    USE dimphy
-    USE ioipsl, only: histbeg, histvert, histdef, histend, ymds2ju
-    USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
-    USE geometry_mod, ONLY: longitude_deg, latitude_deg
-    USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
-    USE time_phylmdz_mod, ONLY: annee_ref, day_ref, itau_phy, pdtphys
-    USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast
-
-    IMPLICIT NONE
-
-    include "clesphys.h"
-    include "YOMCST.h"
-
-    REAL, INTENT(OUT)    :: dtime
-    INTEGER, INTENT(OUT) :: nid_ctesGCM
-
-    REAL,DIMENSION(klon_glo)        :: rlat_glo
-    REAL,DIMENSION(klon_glo)        :: rlon_glo
-    INTEGER i, idayref, ISW, itau_w
-    REAL zstophy, zout
-    REAL zx_lon(nbp_lon,nbp_lat)
-    REAL zx_lat(nbp_lon,nbp_lat)
-
-    CHARACTER*1 ch1
-    INTEGER nhori
-    INTEGER, PARAMETER :: np=1
-
-    REAL zjulian
-    SAVE zjulian
-!$OMP THREADPRIVATE(zjulian)
-
-!IM    Implemente en modes sequentiel et parallele
-
-       CALL gather(latitude_deg,rlat_glo)
-       CALL bcast(rlat_glo)
-       CALL gather(longitude_deg,rlon_glo)
-       CALL bcast(rlon_glo)
-
-!$OMP MASTER
-      IF (is_mpi_root) THEN
-!
-!       zstophy = pdtphys
-!       zout = -1
-!--OB modified for daily output
-       zstophy = 86400.
-       zout = 86400.
-!
-       idayref = day_ref
-       CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-!
-       CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon_glo,zx_lon)
-       IF (nbp_lon.GT.1) THEN
-       DO i = 1, nbp_lon
-         zx_lon(i,1) = rlon_glo(i+1)
-         zx_lon(i,nbp_lat) = rlon_glo(i+1)
-       ENDDO
-       ENDIF
-!
-       CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat_glo,zx_lat)
-!
-       CALL histbeg("paramLMDZ_phy.nc",  &
-                       np,zx_lon(np:np,1), np,zx_lat(1,np:np), &
-                       1,1,1,1, &
-                       itau_phy, zjulian, dtime, &
-                       nhori, nid_ctesGCM)
-!
-       CALL histdef(nid_ctesGCM, "R_ecc",  &
-                      "Excentricite","-", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histdef(nid_ctesGCM, "R_peri",  &
-                      "Equinoxe","-", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histdef(nid_ctesGCM, "R_incl",  &
-                      "Inclinaison","deg", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histdef(nid_ctesGCM, "solaire",  &
-                      "Constante solaire","W/m2", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-#ifdef CPP_RRTM
-       IF (iflag_rrtm.EQ.1) THEN
-         DO ISW=1, NSW
-           WRITE(ch1,'(i1)') ISW
-           CALL histdef(nid_ctesGCM, "rsun"//ch1,  &
-                      "Fraction constante solaire bande "//ch1,"W/m2", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-         ENDDO
-       ENDIF
-#endif
-!
-       CALL histdef(nid_ctesGCM, "co2_ppm",  &
-                      "Concentration du CO2", "ppm", &
-                      1,1,nhori, 1,1,1, -99, 32,  &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histdef(nid_ctesGCM, "CH4_ppb",  &
-                      "Concentration du CH4", "ppb", &
-                      1,1,nhori, 1,1,1, -99, 32,  &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histdef(nid_ctesGCM, "N2O_ppb", &
-                      "Concentration du N2O", "ppb", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histdef(nid_ctesGCM, "CFC11_ppt", &
-                      "Concentration du CFC11", "ppt", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histdef(nid_ctesGCM, "CFC12_ppt", &
-                      "Concentration du CFC12", "ppt", &
-                      1,1,nhori, 1,1,1, -99, 32, &
-                      "ave(X)", zstophy,zout)
-!
-       CALL histend(nid_ctesGCM)
-       
-       ENDIF !(is_mpi_root)
-!$OMP END MASTER
-
-  END SUBROUTINE ini_paramLMDZ_phy
-
-!=================================================================
-
-  SUBROUTINE write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
-
-    USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
-    USE time_phylmdz_mod, ONLY: day_step_phy, annee_ref, itau_phy, start_time
-    USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
-
-    USE iophy
-    USE ioipsl, ONLY: histwrite, histsync
-
-#ifdef CPP_RRTM
-    USE YOESW, ONLY : RSUN
-#endif
-
-    IMPLICIT NONE
-
-    include "clesphys.h"
-    include "YOMCST.h"
-
-    INTEGER, INTENT(IN) :: itap, nid_ctesGCM
-    LOGICAL, INTENT(IN) :: ok_sync
-
-    INTEGER itau_w, ISW
-    INTEGER ndex2d(nbp_lon*nbp_lat)
-    REAL :: zx_tmp_0d(1,1)
-    INTEGER, PARAMETER :: np=1
-
-    CHARACTER*1 ch1
-
-!$OMP MASTER
-      IF (is_mpi_root) THEN      
-!
-      ndex2d = 0
-      itau_w = itau_phy + itap + int(start_time * day_step_phy)
-!
-! Variables globales
-!
-      zx_tmp_0d=R_ecc
-      CALL histwrite(nid_ctesGCM,"R_ecc",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-      zx_tmp_0d=R_peri
-      CALL histwrite(nid_ctesGCM,"R_peri",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-      zx_tmp_0d=R_incl
-      CALL histwrite(nid_ctesGCM,"R_incl",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-      zx_tmp_0d=solaire
-      CALL histwrite(nid_ctesGCM,"solaire",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-#ifdef CPP_RRTM
-      IF (iflag_rrtm.EQ.1) THEN
-        DO ISW=1, NSW
-          WRITE(ch1,'(i1)') ISW
-          zx_tmp_0d=RSUN(ISW)
-          CALL histwrite(nid_ctesGCM,"rsun"//ch1,itau_w, &
-                         zx_tmp_0d,np,ndex2d)
-        ENDDO 
-      ENDIF
-#endif
-!
-      zx_tmp_0d=co2_ppm
-      CALL histwrite(nid_ctesGCM,"co2_ppm",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-      zx_tmp_0d=CH4_ppb
-      CALL histwrite(nid_ctesGCM,"CH4_ppb",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-      zx_tmp_0d=N2O_ppb
-      CALL histwrite(nid_ctesGCM,"N2O_ppb",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-      zx_tmp_0d=CFC11_ppt
-      CALL histwrite(nid_ctesGCM,"CFC11_ppt",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-      zx_tmp_0d=CFC12_ppt
-      CALL histwrite(nid_ctesGCM,"CFC12_ppt",itau_w, &
-                     zx_tmp_0d,np,ndex2d)
-!
-!=================================================================
-!
-      IF (ok_sync) THEN
-        call histsync(nid_ctesGCM)
-      ENDIF
-
-      ENDIF !(is_mpi_root) then      
-!$OMP END MASTER
-
-  END SUBROUTINE write_paramLMDZ_phy
-
-END MODULE paramLMDZ_phy_mod
+link ../phylmd/paramlmdz_phy_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/pbl_surface_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/pbl_surface_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/pbl_surface_mod.F90	(revision 3940)
@@ -1,4 +1,4 @@
 !
-! $Id: pbl_surface_mod.F90 3435 2019-01-22 15:21:59Z fairhead $
+! $Id: pbl_surface_mod.F90 3906 2021-05-19 10:35:18Z jyg $
 !
 MODULE pbl_surface_mod
@@ -23,8 +23,12 @@
   USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
   USE coef_diff_turb_mod,  ONLY : coef_diff_turb
-  USE wx_pbl_mod,          ONLY : wx_pbl_init, wx_pbl_final, &
-!!                                  wx_pbl_fuse_no_dts, wx_pbl_split_no_dts, &
-!!                                  wx_pbl_fuse, wx_pbl_split
-                                  wx_pbl0_fuse, wx_pbl0_split
+  USE ioipsl_getin_p_mod,  ONLY : getin_p
+  USE cdrag_mod
+  USE stdlevvar_mod
+  USE wx_pbl_var_mod,      ONLY : wx_pbl_init, wx_pbl_final, &
+                                  wx_pbl_prelim_0, wx_pbl_prelim_beta
+  USE wx_pbl_mod,          ONLY : wx_pbl0_merge, wx_pbl_split, wx_pbl_dts_merge, &
+                                  wx_pbl_check, wx_pbl_dts_check, wx_evappot
+  use config_ocean_skin_m, only: activate_ocean_skin
 
   IMPLICIT NONE
@@ -33,10 +37,13 @@
   REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: fder   ! flux drift
   !$OMP THREADPRIVATE(fder)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: snow   ! snow at surface
+  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE    :: snow   ! snow at surface
   !$OMP THREADPRIVATE(snow)
   REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: qsurf  ! humidity at surface
   !$OMP THREADPRIVATE(qsurf)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ftsoil ! soil temperature
+  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE          :: ftsoil ! soil temperature
   !$OMP THREADPRIVATE(ftsoil)
+  REAL, ALLOCATABLE, DIMENSION(:), SAVE              :: ydTs0, ydqs0  
+                                                     ! nul forced temperature and humidity differences
+  !$OMP THREADPRIVATE(ydTs0, ydqs0)
 
 #ifdef ISO
@@ -51,4 +58,7 @@
   INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
   !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
+  INTEGER, SAVE :: iflag_new_t2mq2m
+  !$OMP THREADPRIVATE(iflag_new_t2mq2m)
+
 !FC
 !  integer, save :: iflag_frein
@@ -78,5 +88,4 @@
     REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: qsurf_rst
     REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(IN) :: ftsoil_rst
-
   
 ! Local variables
@@ -102,9 +111,16 @@
     IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
 
+    ALLOCATE(ydTs0(klon), stat=ierr)
+    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(ydqs0(klon), stat=ierr)
+    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
+
     fder(:)       = fder_rst(:)
     snow(:,:)     = snow_rst(:,:)
     qsurf(:,:)    = qsurf_rst(:,:)
     ftsoil(:,:,:) = ftsoil_rst(:,:,:)
-
+    ydTs0(:) = 0.
+    ydqs0(:) = 0.
 
 !****************************************************************************************
@@ -152,4 +168,5 @@
     iflag_pbl_surface_t2m_bug=0
     CALL getin_p('iflag_pbl_surface_t2m_bug',iflag_pbl_surface_t2m_bug)
+    WRITE(lunout,*) 'iflag_pbl_surface_t2m_bug=',iflag_pbl_surface_t2m_bug
 !FC
 !    iflag_frein = 0
@@ -240,6 +257,6 @@
        debut,     lafin,                              &
        rlon,      rlat,      rugoro,   rmu0,          &
-       zsig,      lwdown_m,  pphi,     cldt,          &
-       rain_f,    snow_f,    solsw_m,  sollw_m,       &
+       lwdown_m,  cldt,          &
+       rain_f,    snow_f,    solsw_m,  solswfdiff_m, sollw_m,       &
        gustiness,                                     &
        t,         q,         u,        v,             &
@@ -252,7 +269,10 @@
        ts,SFRWL,   alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
        cdragh,    cdragm,   zu1,    zv1,              &
+!jyg<   (26/09/2019)
+       beta, &
+!>jyg
        alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
        alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
-       zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
+       zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout, &
        d_t,       d_q,       d_u,      d_v, d_t_diss, & 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -275,5 +295,6 @@
        s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
        zustar,zu10m,  zv10m,    fder_print,    &
-       zxqsurf,   rh2m,      zxfluxu,  zxfluxv,       &
+       zxqsurf, delta_qsurf,                       &
+       rh2m,      zxfluxu,  zxfluxv,               &
        z0m, z0h,   agesno,  sollw,    solsw,         &
        d_ts,      evap,    fluxlat,  t2m,           &
@@ -283,5 +304,5 @@
 !jyg<
 !!       zxfluxt,   zxfluxq,   q2m,      flux_q, tke,   &
-       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,   &
+       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,  &
 !>jyg
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -338,7 +359,5 @@
 ! z0m, z0h ----input-R- longeur de rugosite (en m)
 ! Martin
-! zsig-----input-R- slope
 ! cldt-----input-R- total cloud fraction
-! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
 ! Martin
 !
@@ -370,4 +389,5 @@
     USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm 
     USE carbon_cycle_mod,   ONLY : co2_send, nbcf_out, fields_out, yfields_out, cfname_out
+    use hbtm_mod, only: hbtm
     USE indice_sol_mod
     USE time_phylmdz_mod,   ONLY : day_ini,annee_ref,itau_phy
@@ -385,4 +405,14 @@
 #endif
     USE ioipsl_getin_p_mod, ONLY : getin_p
+    use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, zsig, zmea
+    use phys_output_var_mod, only: dter, dser, tkt, tks, taur, sss
+#ifdef CPP_XIOS
+    USE wxios, ONLY: missing_val
+#else
+    use netcdf, only: missing_val => nf90_fill_real
+#endif
+
+     
+
 
     IMPLICIT NONE
@@ -412,4 +442,5 @@
     REAL, DIMENSION(klon),        INTENT(IN)        :: snow_f  ! snow fall
     REAL, DIMENSION(klon),        INTENT(IN)        :: solsw_m ! net shortwave radiation at mean surface
+    REAL, DIMENSION(klon),        INTENT(IN)        :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
     REAL, DIMENSION(klon),        INTENT(IN)        :: sollw_m ! net longwave radiation at mean surface
     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t       ! temperature (K)
@@ -421,11 +452,8 @@
     REAL, DIMENSION(klon, nbsrf), INTENT(IN)        :: pctsrf  ! sub-surface fraction
 ! Martin
-    REAL, DIMENSION(klon),        INTENT(IN)        :: zsig    ! slope
     REAL, DIMENSION(klon),        INTENT(IN)        :: lwdown_m ! downward longwave radiation at mean s    
     REAL, DIMENSION(klon),        INTENT(IN)        :: gustiness ! gustiness
 
     REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud fraction
-    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: pphi    ! geopotential (m2/s2)
-! Martin
 
 #ifdef ISO
@@ -451,4 +479,7 @@
 ! Input/Output variables
 !****************************************************************************************
+!jyg<
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: beta    ! Aridity factor
+!>jyg
     REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ts      ! temperature at surface (K)
     REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: delta_tsurf !surface temperature difference between
@@ -496,4 +527,5 @@
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
+    INTEGER, DIMENSION(klon, 6),  INTENT(OUT)       :: zn2mout    ! number of times the 2m temperature is out of the [tsol,temp]
     REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature 
@@ -560,13 +592,14 @@
     REAL, DIMENSION(klon),        INTENT(OUT)       :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxqsurf    ! humidity at surface, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: delta_qsurf! humidity difference at surface, mean for each grid point
     REAL, DIMENSION(klon),        INTENT(OUT)       :: rh2m       ! relative humidity at 2m
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxv    ! v wind tension, mean for each grid point
-    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)     :: z0m,z0h      ! rugosity length (m)
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: agesno   ! age of snow at surface
+    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)   :: z0m,z0h      ! rugosity length (m)
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: agesno   ! age of snow at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: solsw      ! net shortwave radiation at surface 
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: evap     ! evaporation at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: evap     ! evaporation at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
@@ -605,5 +638,5 @@
 
 ! Martin
-! sisvat
+! inlandsis
     REAL, DIMENSION(klon),       INTENT(OUT)        :: qsnow      ! snow water content
     REAL, DIMENSION(klon),       INTENT(OUT)        :: snowhgt    ! snow height
@@ -632,5 +665,5 @@
     INTEGER                            :: n 
 ! << PC
-    INTEGER                            :: iflag_split 
+    INTEGER                            :: iflag_split, iflag_split_ref 
     INTEGER                            :: i, k, nsrf 
     INTEGER                            :: knon, j
@@ -643,8 +676,10 @@
     REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
     REAL, DIMENSION(klon)              :: yts, yz0m, yz0h, ypct
+    REAL, DIMENSION(klon)              :: yz0h_old
 !albedo SB >>>
     REAL, DIMENSION(klon)              :: yalb,yalb_vis
 !albedo SB <<<
     REAL, DIMENSION(klon)              :: yt1, yq1, yu1, yv1
+    REAL, DIMENSION(klon)              :: yqa
     REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
     REAL, DIMENSION(klon)              :: yrain_f, ysnow_f
@@ -670,4 +705,6 @@
     REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
     REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
+    INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
+    INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout, n2mout_x, n2mout_w
     REAL, DIMENSION(klon)              :: yustar
     REAL, DIMENSION(klon)              :: ywstar
@@ -690,4 +727,5 @@
     REAL, DIMENSION(klon)              :: yz0h_oupas
     REAL, DIMENSION(klon)              :: yfluxsens
+    REAL, DIMENSION(klon)              :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
     REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
 #ifdef ISO
@@ -696,5 +734,5 @@
     REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
     REAL, DIMENSION(klon)              :: ypsref
-    REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb3_new
+    REAL, DIMENSION(klon)              :: yevap, yevap_pot, ytsurf_new, yalb3_new
 !albedo SB >>>
     REAL, DIMENSION(klon,nsw)          :: yalb_dir_new, yalb_dif_new
@@ -708,5 +746,5 @@
     REAL, DIMENSION(klon,klev)         :: y_flux_u, y_flux_v
     REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm,ycoefq
-    REAL, DIMENSION(klon)              :: ycdragh, ycdragm
+    REAL, DIMENSION(klon)              :: ycdragh, ycdragq, ycdragm
     REAL, DIMENSION(klon,klev)         :: yu, yv
     REAL, DIMENSION(klon,klev)         :: yt, yq
@@ -746,5 +784,6 @@
     REAL, DIMENSION(klon,klev)         :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w
     REAL, DIMENSION(klon,klev)         :: ycoefq_x, ycoefq_w
-    REAL, DIMENSION(klon)              :: ycdragh_x, ycdragm_x, ycdragh_w, ycdragm_w
+    REAL, DIMENSION(klon)              :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
+    REAL, DIMENSION(klon)              :: ycdragm_x, ycdragm_w
     REAL, DIMENSION(klon)              :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x
     REAL, DIMENSION(klon)              :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w
@@ -767,5 +806,8 @@
     REAL                               :: zx_qs_surf, zcor_surf, zdelta_surf
     REAL, DIMENSION(klon)              :: ytsurf_th, yqsatsurf
+!jyg<
     REAL, DIMENSION(klon)              :: ybeta
+    REAL, DIMENSION(klon)              :: ybeta_prev
+!>jyg
     REAL, DIMENSION(klon, klev)        :: d_u_x
     REAL, DIMENSION(klon, klev)        :: d_u_w
@@ -915,5 +957,14 @@
 !!! nrlmd le 13/06/2011
     REAL, DIMENSION(klon)              :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1
-    REAL, DIMENSION(klon)              :: y_delta_tsurf,delta_coef,tau_eq
+    REAL, DIMENSION(klon)              :: y_delta_tsurf, y_delta_tsurf_new
+    REAL, DIMENSION(klon)              :: delta_coef, tau_eq
+    REAL, DIMENSION(klon)              :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
+    REAL, DIMENSION(klon)              :: phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0
+    REAL, DIMENSION(klon)              :: y_delta_qsurf
+    REAL, DIMENSION(klon)              :: y_delta_qsats
+    REAL, DIMENSION(klon)              :: yg_T, yg_Q
+    REAL, DIMENSION(klon)              :: yGamma_dTs_phiT, yGamma_dQs_phiQ
+    REAL, DIMENSION(klon)              :: ydTs_ins, ydqs_ins
+!
     REAL, PARAMETER                    :: facteur=2./sqrt(3.14)
     REAL, PARAMETER                    :: inertia=2000.
@@ -928,5 +979,7 @@
     REAL, DIMENSION(klon)              :: Kech_m
     REAL, DIMENSION(klon)              :: Kech_m_x, Kech_m_w 
-    REAL, DIMENSION(klon)              :: yts_x,yts_w
+    REAL, DIMENSION(klon)              :: yts_x, yts_w
+    REAL, DIMENSION(klon)              :: yqsatsrf0_x, yqsatsrf0_w
+    REAL, DIMENSION(klon)              :: yqsurf_x, yqsurf_w
 !jyg<
 !!    REAL, DIMENSION(klon)              :: Kech_Hp, Kech_H_xp, Kech_H_wp
@@ -935,7 +988,7 @@
 !!    REAL, DIMENSION(klon)              :: Kech_Vp, Kech_V_xp, Kech_V_wp
 !>jyg
-!jyg<
-    REAL, DIMENSION(klon)              :: ah, bh     ! coefficients of the delta_Tsurf equation
-!>jyg
+
+    REAL                               :: fact_cdrag
+    REAL                               :: z1lay
 
     REAL                               :: vent
@@ -971,9 +1024,15 @@
     REAL, DIMENSION(klon)              :: ytoice
     REAL, DIMENSION(klon)              :: ysnowhgt, yqsnow, ysissnow, yrunoff
+    REAL, DIMENSION(klon)              :: yzmea
     REAL, DIMENSION(klon)              :: yzsig
-    REAL, DIMENSION(klon,klev)         :: ypphi
     REAL, DIMENSION(klon)              :: ycldt
     REAL, DIMENSION(klon)              :: yrmu0
     ! Martin
+
+    REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, ydser, &
+         ytkt, ytks, ytaur, ysss
+    ! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, tkt, tks,
+    ! taur, sss on ocean points
+
 #ifdef ISO
     REAL, DIMENSION(klon)       :: h1
@@ -991,5 +1050,6 @@
 !
 !!jyg      iflag_split = mod(iflag_pbl_split,2)
-      iflag_split = mod(iflag_pbl_split,10)
+!!jyg      iflag_split = mod(iflag_pbl_split,10)
+      iflag_split_ref = mod(iflag_pbl_split,10)
 
 #ifdef ISO      
@@ -1038,9 +1098,15 @@
 
     IF (first_call) THEN
+
+       iflag_new_t2mq2m=1
+       CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
+       WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
+
        print*,'PBL SURFACE AVEC GUSTINESS'
        first_call=.FALSE.
       
        ! Initialize ok_flux_surf (for 1D model)
-       if (klon_glo>1) ok_flux_surf=.FALSE.
+       IF (klon_glo>1) ok_flux_surf=.FALSE.
+       IF (klon_glo>1) ok_forc_tsurf=.FALSE.
 
        ! intialize beta_land
@@ -1113,4 +1179,5 @@
  zxfluxlat(:)=0.
  zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
+ zn2mout(:,:)=0 ;
  d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
  zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
@@ -1128,4 +1195,5 @@
  fder_print(:)=0.
  zxqsurf(:)=0.
+ delta_qsurf(:) = 0.
  zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
  solsw(:,:)=0. ; sollw(:,:)=0.
@@ -1164,4 +1232,5 @@
 !!    tke(:,:,is_ave)=0.
     tke_x(:,:,is_ave)=0.
+
     wake_dltke(:,:,is_ave)=0.
 !>jyg
@@ -1184,5 +1253,5 @@
     yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
 !albedo SB <<<
-    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0    
+    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0
     ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0    
     yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
@@ -1195,5 +1264,6 @@
 !!    d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0 
     yqsol = 0.0    
-    ytherm = 0.0  ; ytke=0.
+
+    ytke=0.
 !FC 
     y_treedrg=0.
@@ -1202,5 +1272,5 @@
     ysnowhgt = 0.0; yqsnow = 0.0     ; yrunoff = 0.0   ; ytoice =0.0
     yalb3_new = 0.0  ; ysissnow = 0.0 
-    ypphi = 0.0   ; ycldt = 0.0      ; yrmu0 = 0.0
+    ycldt = 0.0      ; yrmu0 = 0.0
     ! Martin
 
@@ -1218,6 +1288,11 @@
     y_delta_flux_t1=0.
     ydtsurf_th=0.
-    yts_x=0.      ; yts_w=0.
-    y_delta_tsurf=0.
+    yts_x(:)=0.      ; yts_w(:)=0.
+    y_delta_tsurf(:)=0. ; y_delta_qsurf(:)=0.
+    yqsurf_x(:)=0.      ; yqsurf_w(:)=0.
+    yg_T(:) = 0. ;        yg_Q(:) = 0.
+    yGamma_dTs_phiT(:) = 0. ; yGamma_dQs_phiQ(:) = 0.
+    ydTs_ins(:) = 0. ; ydqs_ins(:) = 0.
+
 !!!
     ytsoil = 999999. 
@@ -1410,12 +1485,5 @@
        DO i = 1, klon
           sollw(i,nsrf) = sollw_m(i) + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ts(i,nsrf))
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!         ! Martin
-! Apparently introduced for sisvat but not used
-!         sollwd(i,nsrf)= sollwd_m(i)
-!         ! Martin
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+!--OB this line is not satisfactory because alb is the direct albedo not total albedo
           solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
        ENDDO
@@ -1440,4 +1508,8 @@
 !>al1
 
+!--OB add diffuse fraction of SW down
+   DO n=1,nbcf_out
+       IF (cfname_out(n) == "swdownfdiff" ) fields_out(:,n) = solswfdiff_m(:)
+   ENDDO
 ! >> PC
    IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
@@ -1461,7 +1533,18 @@
 ! 
 !****************************************************************************************
-   
-    loop_nbsrf: DO nsrf = 1, nbsrf
+                                                                          !<<<<<<<<<<<<<
+    loop_nbsrf: DO nsrf = 1, nbsrf                                        !<<<<<<<<<<<<<
+                                                                          !<<<<<<<<<<<<<
        IF (prt_level >=10) print *,' Loop nsrf ',nsrf
+!
+       IF (iflag_split_ref == 3) THEN
+         IF (nsrf == is_oce) THEN
+            iflag_split = 1
+         ELSE
+            iflag_split=0
+         ENDIF   !! (nsrf == is_oce)
+       ELSE                     
+         iflag_split = iflag_split_ref
+       ENDIF   !! (iflag_split_ref == 3)
 
 ! Search for index(ni) and size(knon) of domaine to treat
@@ -1499,4 +1582,21 @@
 !****************************************************************************************
 
+!
+!jyg<    (20190926)
+!   Provisional : set ybeta to standard values
+       IF (nsrf .NE. is_ter) THEN
+           ybeta(:) = 1.
+       ELSE
+           IF (iflag_split .EQ. 0) THEN
+              ybeta(:) = 1.
+           ELSE
+             DO j = 1, knon
+                i = ni(j)
+                ybeta(j)   = beta(i,nsrf)
+             ENDDO
+           ENDIF  ! (iflag_split .LE.1)
+       ENDIF !  (nsrf .NE. is_ter)
+!>jyg
+!
        DO j = 1, knon
           i = ni(j)
@@ -1531,5 +1631,6 @@
           ywindsp(j) = windsp(i,nsrf)
 !>jyg
-          ! Martin
+          ! Martin and Etienne
+          yzmea(j)   = zmea(i)
           yzsig(j)   = zsig(i)
           ycldt(j)   = cldt(i)
@@ -1656,4 +1757,5 @@
              ytke_w(j,k)      = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
              ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
+            
 !>jyg
           ENDDO
@@ -1695,4 +1797,14 @@
           ENDDO
        ENDIF
+
+       if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
+          if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
+             ydelta_sal(:knon) = delta_sal(ni(:knon))
+             ydelta_sst(:knon) = delta_sst(ni(:knon))
+          end if
+          
+          yds_ns(:knon) = ds_ns(ni(:knon))
+          ydt_ns(:knon) = dt_ns(ni(:knon))
+       end if
        
 !****************************************************************************************
@@ -1735,4 +1847,5 @@
       ENDDO
      ENDIF
+
         IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
        ELSE  !(iflag_split .eq.0)
@@ -1749,7 +1862,9 @@
            speed_x(i) = SQRT(yu_x(i,1)**2+yv_x(i,1)**2)
         ENDDO
-        CALL cdrag(knon, nsrf, &
+
+
+            CALL cdrag(knon, nsrf, &
             speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
-            yts_x, yqsurf, yz0m, yz0h, &
+            yts_x, yqsurf_x, yz0m, yz0h, &
             ycdragm_x, ycdragh_x, zri1_x, pref_x )
 
@@ -1778,5 +1893,5 @@
         CALL cdrag(knon, nsrf, &
             speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
-            yts_w, yqsurf, yz0m, yz0h, &
+            yts_w, yqsurf_w, yz0m, yz0h, &
             ycdragm_w, ycdragh_w, zri1_w, pref_w )
 !
@@ -1818,4 +1933,5 @@
       print *,' args coef_diff_turb: ycdragh ', ycdragh
       print *,' args coef_diff_turb: ytke ', ytke
+
        ENDIF
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -1847,7 +1963,8 @@
       print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x
       print *,' args coef_diff_turb: ytke_x ', ytke_x
+
        ENDIF
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
-            ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf, ycdragm_x, &
+            ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf_x, ycdragm_x, &
             ycoefm_x, ycoefh_x, ytke_x,y_treedrg)
 !            ycoefm_x, ycoefh_x, ytke_x)
@@ -1877,5 +1994,5 @@
        ENDIF
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
-            ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf, ycdragm_w, &
+            ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf_w, ycdragm_w, &
             ycoefm_w, ycoefh_w, ytke_w,y_treedrg)
 !            ycoefm_w, ycoefh_w, ytke_w)
@@ -2029,80 +2146,115 @@
          yxt1(:,:) = yxt(:,:,1)
 #endif
-!!       ELSE IF (iflag_split .eq. 1) THEN
-!!!
-!jyg<
-!!         CALL wx_pbl_fuse_no_dts(knon, dtime, ypplay, ywake_s, &
-!!                                 yt_x, yt_w, yq_x, yq_w, &
-!!                                 yu_x, yu_w, yv_x, yv_w, &
-!!                                 ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
-!!                                 AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
-!!                                 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
-!!                                 BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
-!!                                 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
-!!                                 AcoefH, AcoefQ, AcoefU, AcoefV, &
-!!                                 BcoefH, BcoefQ, BcoefU, BcoefV, &
-!!                                 ycdragh, ycdragm, &
-!!                                 yt1, yq1, yu1, yv1 &
-!!                                 )
+
        ELSE IF (iflag_split .ge. 1) THEN
-         CALL wx_pbl0_fuse(knon, dtime, ypplay, ywake_s, &
+#ifdef ISO
+        call abort_gcm('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1)
+#endif
+
+!
+! Cdragq computation
+! ------------------
+    !******************************************************************************
+    ! Cdragq computed from cdrag
+    ! The difference comes only from a factor (f_z0qh_oce) on z0, so that
+    ! it can be computed inside wx_pbl0_merge
+    ! More complicated appraches may require the propagation through
+    ! pbl_surface of an independant cdragq variable.
+    !******************************************************************************
+!
+    IF ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce) THEN
+       ! Si on suit les formulations par exemple de Tessel, on 
+       ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
+!!       ycdragq_x(1:knon)=ycdragh_x(1:knon)*                                      &
+!!            log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
+!!       ycdragq_w(1:knon)=ycdragh_w(1:knon)*                                      &
+!!            log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
+!
+       DO j = 1,knon
+         z1lay = zgeo1(j)/RG
+         fact_cdrag = log(z1lay/yz0h(j))/log(z1lay/(f_z0qh_oce*yz0h(j)))
+         ycdragq_x(j)=ycdragh_x(j)*fact_cdrag
+         ycdragq_w(j)=ycdragh_w(j)*fact_cdrag
+!!     Print *,'YYYYpbl0: fact_cdrag ', fact_cdrag
+       ENDDO  ! j = 1,knon
+!
+!!  Print *,'YYYYpbl0: z1lay, yz0h, f_z0qh_oce, ycdragh_w, ycdragq_w ', &
+!!                z1lay, yz0h(1:knon), f_z0qh_oce, ycdragh_w(1:knon), ycdragq_w(1:knon)
+    ELSE
+       ycdragq_x(1:knon)=ycdragh_x(1:knon)
+       ycdragq_w(1:knon)=ycdragh_w(1:knon)
+    ENDIF  ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
+!
+         CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s,  &
+                         yts, y_delta_tsurf, ygustiness, &
                          yt_x, yt_w, yq_x, yq_w, &
                          yu_x, yu_w, yv_x, yv_w, &
-                         ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
+                         ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
+                         ycdragm_x, ycdragm_w, &
+                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
+                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
+                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
+                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w  &
+                         )
+         CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta,  &
+                         BcoefQ_x, BcoefQ_w  &
+                         )
+         CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
+                         ywake_s, ydTs0, ydqs0, &
+                         yt_x, yt_w, yq_x, yq_w, &
+                         yu_x, yu_w, yv_x, yv_w, &
+                         ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
+                         ycdragm_x, ycdragm_w, &
                          AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
                          AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
                          BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
                          BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
-                         AcoefH, AcoefQ, AcoefU, AcoefV, &
-                         BcoefH, BcoefQ, BcoefU, BcoefV, &
-                         ycdragh, ycdragm, &
+                         AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
+                         BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
+                         ycdragh, ycdragq, ycdragm, &
                          yt1, yq1, yu1, yv1 &
-#ifdef ISO
-                         ,yxt_x,yxt_w,yxt1 &
-#endif
                          )
-!!       ELSE IF (iflag_split .ge.2) THEN
-!!!    Provisoire
-!!         ah(:) = 0.
-!!         bh(:) = 0.
-!!         IF (nsrf == is_oce) THEN
-!!           ybeta(:) = 1.
-!!         ELSE
-!!           ybeta(:) = beta_land
-!!         ENDIF
-!!         ycdragh(:) = ywake_s(:)*ycdragh_w(:) + (1.-ywake_s(:))*ycdragh_x(:)
-!!         CALL wx_dts(knon, nsrf, ywake_cstar, ywake_s, ywake_dens, &
-!!                     yts, ypplay(:,1), ybeta, ycdragh , ypaprs(:,1), &
-!!                     yq(:,1), yt(:,1), yu(:,1), yv(:,1), ygustiness, &
-!!                     ah, bh &
-!!                     )
-!!!
-!!         CALL wx_pbl_fuse(knon, dtime, ypplay, ywake_s, &
-!!                         yt_x, yt_w, yq_x, yq_w, &
-!!                         yu_x, yu_w, yv_x, yv_w, &
-!!                         ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
-!!                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
-!!                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
-!!                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
-!!                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
-!!                         ah, bh, &
-!!                         AcoefH, AcoefQ, AcoefU, AcoefV, &
-!!                         BcoefH, BcoefQ, BcoefU, BcoefV, &
-!!                         ycdragh, ycdragm, &
-!!                         yt1, yq1, yu1, yv1 &
-!!                         )
-!>jyg
-!!!
-         ENDIF  ! (iflag_split .eq.0)
+         IF (iflag_split .eq. 2 .AND. nsrf .ne. is_oce) THEN
+           CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
+                           ywake_s, ybeta, ywake_cstar, ywake_dens, &
+                           AcoefH_x, AcoefH_w, &
+                           BcoefH_x, BcoefH_w, &
+                           AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
+                           AcoefH, AcoefQ, BcoefH, BcoefQ,  &
+                           HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
+                           phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
+                           yg_T, yg_Q, &
+                           yGamma_dTs_phiT, yGamma_dQs_phiQ, &
+                           ydTs_ins, ydqs_ins &
+                           )
+         ELSE !
+           AcoefH(:) = AcoefH_0(:)
+           AcoefQ(:) = AcoefQ_0(:)
+           BcoefH(:) = BcoefH_0(:)
+           BcoefQ(:) = BcoefQ_0(:)
+           yg_T(:) = 0.
+           yg_Q(:) = 0.
+           yGamma_dTs_phiT(:) = 0.
+           yGamma_dQs_phiQ(:) = 0.
+           ydTs_ins(:) = 0.
+           ydqs_ins(:) = 0.
+         ENDIF   ! (iflag_split .eq. 2)
+       ENDIF  ! (iflag_split .eq.0)
 !!!
        IF (prt_level >=10) THEN
-         PRINT *,'pbl_surface (fuse->): yt(1,:) ',yt(1,:)
-         PRINT *,'pbl_surface (fuse->): yq(1,:) ',yq(1,:)
-         PRINT *,'pbl_surface (fuse->): yu(1,:) ',yu(1,:)
-         PRINT *,'pbl_surface (fuse->): yv(1,:) ',yv(1,:)
-         PRINT *,'pbl_surface (fuse->): AcoefH(1) ',AcoefH(1)
-         PRINT *,'pbl_surface (fuse->): BcoefH(1) ',BcoefH(1)
+         PRINT *,'pbl_surface (merge->): yt(1,:) ',yt(1,:)
+         PRINT *,'pbl_surface (merge->): yq(1,:) ',yq(1,:)
+         PRINT *,'pbl_surface (merge->): yu(1,:) ',yu(1,:)
+         PRINT *,'pbl_surface (merge->): yv(1,:) ',yv(1,:)
+         PRINT *,'pbl_surface (merge->): AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1) ', &
+                                         AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1)
+         PRINT *,'pbl_surface (merge->): BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1) ', &
+                                         BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1)
+
        ENDIF
 
+!  Save initial value of z0h for use in evappot (z0h wiil be computed again in the surface models)
+          yz0h_old(1:knon) = yz0h(1:knon)
+!
 !****************************************************************************************
 !
@@ -2119,8 +2271,16 @@
 
           ! Calculate the temperature et relative humidity at 2m and the wind at 10m 
+          IF (iflag_new_t2mq2m==1) THEN
+           CALL stdlevvarn(klon, knon, is_ter, zxli, &
+               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
+               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
+               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
+               yn2mout(:, nsrf, :))
+          ELSE 
           CALL stdlevvar(klon, knon, is_ter, zxli, &
                yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
                yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
                yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+          ENDIF
           
        ENDIF
@@ -2211,5 +2371,5 @@
           CALL surf_landice(itap, dtime, knon, ni, &
                rlon, rlat, debut, lafin, &
-               yrmu0, ylwdown, yalb, ypphi(:,1), &
+               yrmu0, ylwdown, yalb, zgeo1, &
                ysolsw, ysollw, yts, ypplay(:,1), &
 !!jyg               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
@@ -2221,5 +2381,5 @@
                ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
                ytsurf_new, y_dflux_t, y_dflux_q, &
-               yzsig, ycldt, &
+               yzmea, yzsig, ycldt, &
                ysnowhgt, yqsnow, ytoice, ysissnow, &
                yalb3_new, yrunoff, &
@@ -2284,5 +2444,7 @@
                yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
                ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
-               y_flux_u1, y_flux_v1 &
+               y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
+               yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
+               ytkt(:knon), ytks(:knon), ytaur(:knon), ysss &
 #ifdef ISO
          &      ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
@@ -2392,7 +2554,15 @@
 !
 !****************************************************************************************
-
-!!!
-!!! jyg le 10/04/2013
+!!
+!!!
+!!! jyg le 10/04/2013 et EV 10/2020
+
+        IF (ok_forc_tsurf) THEN
+            DO j=1,knon
+                ytsurf_new(j)=tg
+                y_d_ts(j) = ytsurf_new(j) - yts(j) 
+            ENDDO
+        ENDIF ! ok_forc_tsurf
+
 !!!
         IF (ok_flux_surf) THEN
@@ -2429,35 +2599,105 @@
 #endif
           ENDDO
-        ENDIF
-
-       IF (prt_level >=10) THEN
-        DO j=1,knon
-         print*,'y_flux_t1,yfluxlat,wakes' &
- &             ,  y_flux_t1(j), yfluxlat(j), ywake_s(j)
-         print*,'beta,ytsurf_new', ybeta(j), ytsurf_new(j)
-         print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
-        ENDDO
-       ENDIF
-
-!!! jyg le 07/02/2012 puis le 10/04/2013
-!!       IF (iflag_split .eq.1) THEN
-!!!!!
-!!!jyg<
-!!         CALL wx_pbl_split_no_dts(knon, ywake_s, &
-!!                                AcoefH_x, AcoefH_w, &
-!!                                AcoefQ_x, AcoefQ_w, &
-!!                                AcoefU_x, AcoefU_w, &
-!!                                AcoefV_x, AcoefV_w, &
-!!                                y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
-!!                                y_flux_t1_x, y_flux_t1_w, &
-!!                                y_flux_q1_x, y_flux_q1_w, &
-!!                                y_flux_u1_x, y_flux_u1_w, &
-!!                                y_flux_v1_x, y_flux_v1_w, &
-!!                                yfluxlat_x, yfluxlat_w &
-!!                                )
-!!       ELSE IF (iflag_split .ge. 2) THEN
+        ENDIF ! (ok_flux_surf)
+!
+! ------------------------------------------------------------------------------
+! 12a)  Splitting
+! ------------------------------------------------------------------------------
+
        IF (iflag_split .GE. 1) THEN
-         CALL wx_pbl0_split(knon, dtime, ywake_s, &
+#ifdef ISO
+        call abort_gcm('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1)
+#endif
+!
+         IF (nsrf .ne. is_oce) THEN
+!
+!         Compute potential evaporation and aridity factor  (jyg, 20200328)
+          ybeta_prev(:) = ybeta(:)
+             DO j = 1, knon
+               yqa(j) = AcoefQ(j) - BcoefQ(j)*yevap(j)*dtime
+             ENDDO
+!
+          CALL wx_evappot(knon, yqa, yTsurf_new, yevap_pot)
+!
+          ybeta(1:knon) = min(yevap(1:knon)/yevap_pot(1:knon), 1.)
+          
+          IF (prt_level >=10) THEN
+           DO j=1,knon
+            print*,'y_flux_t1,yfluxlat,wakes' &
+ &                ,  y_flux_t1(j), yfluxlat(j), ywake_s(j)
+            print*,'beta_prev, beta, ytsurf_new', ybeta_prev(j), ybeta(j), ytsurf_new(j)
+            print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
+           ENDDO
+          ENDIF  ! (prt_level >=10)
+!
+! Second call to wx_pbl0_merge and wx_pbl_dts_merge in order to take into account 
+! the update of the aridity coeficient beta.
+!
+        CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta,  &
+                        BcoefQ_x, BcoefQ_w  &
+                        )
+        CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
+                          ywake_s, ydTs0, ydqs0, &
+                          yt_x, yt_w, yq_x, yq_w, &
+                          yu_x, yu_w, yv_x, yv_w, &
+                          ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
+                          ycdragm_x, ycdragm_w, &
+                          AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
+                          AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
+                          BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
+                          BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
+                          AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
+                          BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
+                          ycdragh, ycdragq, ycdragm, &
+                          yt1, yq1, yu1, yv1 &
+                          )
+          IF (iflag_split .eq. 2) THEN
+            CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
+                            ywake_s, ybeta, ywake_cstar, ywake_dens, &
+                            AcoefH_x, AcoefH_w, &
+                            BcoefH_x, BcoefH_w, &
+                            AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
+                            AcoefH, AcoefQ, BcoefH, BcoefQ,  &
+                            HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
+                            phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
+                            yg_T, yg_Q, &
+                            yGamma_dTs_phiT, yGamma_dQs_phiQ, &
+                            ydTs_ins, ydqs_ins &
+                            )
+          ELSE !
+            AcoefH(:) = AcoefH_0(:)
+            AcoefQ(:) = AcoefQ_0(:)
+            BcoefH(:) = BcoefH_0(:)
+            BcoefQ(:) = BcoefQ_0(:)
+            yg_T(:) = 0.
+            yg_Q(:) = 0.
+            yGamma_dTs_phiT(:) = 0.
+            yGamma_dQs_phiQ(:) = 0.
+            ydTs_ins(:) = 0.
+            ydqs_ins(:) = 0.
+          ENDIF   ! (iflag_split .eq. 2)
+!
+        ELSE    ! (nsrf .ne. is_oce)
+          ybeta(1:knon) = 1.
+          yevap_pot(1:knon) = yevap(1:knon)
+          AcoefH(:) = AcoefH_0(:)
+          AcoefQ(:) = AcoefQ_0(:)
+          BcoefH(:) = BcoefH_0(:)
+          BcoefQ(:) = BcoefQ_0(:)
+          yg_T(:) = 0.
+          yg_Q(:) = 0.
+          yGamma_dTs_phiT(:) = 0.
+          yGamma_dQs_phiQ(:) = 0.
+          ydTs_ins(:) = 0.
+          ydqs_ins(:) = 0.
+        ENDIF   ! (nsrf .ne. is_oce)
+! 
+        CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, &
+                       yg_T, yg_Q, &
+                       yGamma_dTs_phiT, yGamma_dQs_phiQ, &
+                       ydTs_ins, ydqs_ins, &
                        y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
+!!!!                       HTRn_b, dd_HTRn, HTphiT_b, dd_HTphiT, &
+                       phiQ0_b, phiT0_b, &
                        y_flux_t1_x, y_flux_t1_w, &
                        y_flux_q1_x, y_flux_q1_w, &
@@ -2465,7 +2705,49 @@
                        y_flux_v1_x, y_flux_v1_w, &
                        yfluxlat_x, yfluxlat_w, &
-                       y_delta_tsurf &
+                       y_delta_qsats, &
+                       y_delta_tsurf_new, y_delta_qsurf &
                        )
+!
+         CALL wx_pbl_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
+                       yTs, y_delta_tsurf,  & 
+                       yqsurf, yTsurf_new,  &
+                       y_delta_tsurf_new, y_delta_qsats,  &
+                       AcoefH_x, AcoefH_w, &
+                       BcoefH_x, BcoefH_w, &
+                       AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
+                       AcoefH, AcoefQ, BcoefH, BcoefQ,  &
+                       y_flux_t1, y_flux_q1,  &
+                       y_flux_t1_x, y_flux_t1_w, &
+                       y_flux_q1_x, y_flux_q1_w)
+!
+         IF (nsrf .ne. is_oce) THEN
+           CALL wx_pbl_dts_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
+                         yTs, y_delta_tsurf,  & 
+                         yqsurf, yTsurf_new,  &
+                         y_delta_qsats, y_delta_tsurf_new, y_delta_qsurf,  &
+                         AcoefH_x, AcoefH_w, &
+                         BcoefH_x, BcoefH_w, &
+                         AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
+                         AcoefH, AcoefQ, BcoefH, BcoefQ,  &
+                         HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
+                         phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
+                         yg_T, yg_Q, &
+                         yGamma_dTs_phiT, yGamma_dQs_phiQ, &
+                         ydTs_ins, ydqs_ins, &
+                         y_flux_t1, y_flux_q1,  &
+                         y_flux_t1_x, y_flux_t1_w, &
+                         y_flux_q1_x, y_flux_q1_w )
+         ENDIF   ! (nsrf .ne. is_oce)
+!
+       ELSE  ! (iflag_split .ge. 1)
+         ybeta(1:knon) = 1.
+         yevap_pot(1:knon) = yevap(1:knon)
        ENDIF  ! (iflag_split .ge. 1)
+!
+       IF (prt_level >= 10) THEN
+         print *,'pbl_surface, ybeta , yevap, yevap_pot ', &
+                               ybeta , yevap, yevap_pot
+       ENDIF  ! (prt_level >= 10)
+!
 !>jyg
 !
@@ -2648,10 +2930,10 @@
        ENDIF  ! (iflag_split .eq.0)
 !!!
-
-        DO j = 1, knon
-          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
-          y_dflux_q(j) = y_dflux_q(j) * ypct(j)
-        ENDDO
-
+!!
+!!        DO j = 1, knon
+!!          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
+!!          y_dflux_q(j) = y_dflux_q(j) * ypct(j)
+!!        ENDDO
+!!
 !****************************************************************************************
 ! 13) Transform variables for output format : 
@@ -2821,4 +3103,5 @@
           i = ni(j)
           evap(i,nsrf) = - flux_q(i,1,nsrf)                  !jyg
+          beta(i,nsrf) = ybeta(j)                             !jyg
           d_ts(i,nsrf) = y_d_ts(j)
 !albedo SB >>>
@@ -2836,6 +3119,6 @@
           cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
           cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
-          dflux_t(i) = dflux_t(i) + y_dflux_t(j)
-          dflux_q(i) = dflux_q(i) + y_dflux_q(j)
+          dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
+          dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
 #ifdef ISO
         do ixt=1,niso
@@ -2844,5 +3127,5 @@
         do ixt=1,ntraciso
           xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf)
-          dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j) 
+          dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j)
         enddo  
         IF (nsrf == is_lic) THEN
@@ -2874,5 +3157,8 @@
 !!! nrlmd le 13/06/2011
 !!jyg20170131          delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j)
-          delta_tsurf(i,nsrf)=y_delta_tsurf(j)
+!!jyg20210118          delta_tsurf(i,nsrf)=y_delta_tsurf(j)
+          delta_tsurf(i,nsrf)=y_delta_tsurf_new(j)
+!
+          delta_qsurf(i) = delta_qsurf(i) + y_delta_qsurf(j)*ypct(j)
 !
           cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
@@ -2918,4 +3204,5 @@
               tke_x(i,k,nsrf)    = ytke(j,k)
               tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
+
 !>jyg
            ENDDO
@@ -2931,6 +3218,7 @@
 !!            tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j)
             tke_x(i,k,nsrf)   = ytke_x(j,k)
-            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)
+            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)        
             wake_dltke(i,k,is_ave)   = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
+            
 
 !>jyg
@@ -3069,4 +3357,30 @@
           d_t_w(:,1), d_t_x(:,1), d_t(:,1)
        ENDIF
+
+       if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
+          delta_sal = missing_val
+          ds_ns = missing_val
+          dt_ns = missing_val
+          delta_sst = missing_val
+          dter = missing_val
+          dser = missing_val
+          tkt = missing_val
+          tks = missing_val
+          taur = missing_val
+          sss = missing_val
+          
+          delta_sal(ni(:knon)) = ydelta_sal(:knon)
+          ds_ns(ni(:knon)) = yds_ns(:knon)
+          dt_ns(ni(:knon)) = ydt_ns(:knon)
+          delta_sst(ni(:knon)) = ydelta_sst(:knon)
+          dter(ni(:knon)) = ydter(:knon)
+          dser(ni(:knon)) = ydser(:knon)
+          tkt(ni(:knon)) = ytkt(:knon)
+          tks(ni(:knon)) = ytks(:knon)
+          taur(ni(:knon)) = ytaur(:knon)
+          sss(ni(:knon)) = ysss(:knon)
+       end if
+
+
 
 !****************************************************************************************
@@ -3106,5 +3420,6 @@
                * (ypaprs(j,1)-ypplay(j,1))
           tairsol(j) = yts(j) + y_d_ts(j)
-          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
+!!          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
+          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf_new(j)
           qairsol(j) = yqsurf(j)
         ENDDO
@@ -3145,9 +3460,29 @@
 !!! jyg le 07/02/2012
        IF (iflag_split .eq.0) THEN
+        IF (iflag_new_t2mq2m==1) THEN
+         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+            uzon, vmer, tair1, qair1, zgeo1, &
+            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
+            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
+            yn2mout(:, nsrf, :))
+        ELSE
         CALL stdlevvar(klon, knon, nsrf, zxli, &
             uzon, vmer, tair1, qair1, zgeo1, &
             tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
             yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+        ENDIF
        ELSE  !(iflag_split .eq.0)
+        IF (iflag_new_t2mq2m==1) THEN
+         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
+            tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
+            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, &
+            yn2mout_x(:, nsrf, :))
+         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
+            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
+            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, &
+            yn2mout_w(:, nsrf, :))
+        ELSE
         CALL stdlevvar(klon, knon, nsrf, zxli, &
             uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
@@ -3158,4 +3493,5 @@
             tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
             yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
+        ENDIF
 !!!
        ENDIF  ! (iflag_split .eq.0)
@@ -3171,4 +3507,9 @@
           u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
           v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
+!
+          DO k = 1, 6
+           n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
+          END DO  
+!
         ENDDO
        ELSE  !(iflag_split .eq.0)
@@ -3181,4 +3522,9 @@
           u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
           v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
+!
+          DO k = 1, 6
+           n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
+          END DO  
+!
         ENDDO
         DO j=1, knon
@@ -3194,4 +3540,9 @@
           u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
           v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
+!
+          DO k = 1, 6
+           n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
+          END DO  
+!
         ENDDO
 !!!
@@ -3479,10 +3830,10 @@
 #endif
 !!!
-   
+
 !
 ! Incrementer la temperature du sol
 !
     zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
-    zt2m(:) = 0.0    ; zq2m(:) = 0.0 
+    zt2m(:) = 0.0    ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
     zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
     s_pblh(:) = 0.0  ; s_plcl(:) = 0.0 
@@ -3537,4 +3888,9 @@
           zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
           zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
+!
+          DO k = 1, 6
+           zn2mout(i,k)  = zn2mout(i,k)  + n2mout(i,nsrf,k)  * pctsrf(i,nsrf)
+          ENDDO  
+!
           zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
           wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
@@ -3568,4 +3924,9 @@
           zt2m(i)  = zt2m(i)  + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
           zq2m(i)  = zq2m(i)  + q2m_x(i,nsrf)  * pctsrf(i,nsrf)
+!
+          DO k = 1, 6
+           zn2mout(i,k)  = zn2mout(i,k)  + n2mout_x(i,nsrf,k)  * pctsrf(i,nsrf)
+          ENDDO
+!
           zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
           wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
@@ -3649,5 +4010,5 @@
     DO nsrf = 1, nbsrf
        DO i = 1, klon
-          zxqsurf(i) = zxqsurf(i) + qsurf(i,nsrf) * pctsrf(i,nsrf)
+          zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
           zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
 #ifdef ISO
@@ -3718,4 +4079,6 @@
     IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
     IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
+    IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0)
+    IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0)
 #ifdef ISO
     IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow)
@@ -3739,7 +4102,7 @@
 
 !albedo SB >>>
-SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
-     evap, z0m, z0h, agesno,                                  &
-     tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke &
+  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
+       evap, z0m, z0h, agesno,                                  &
+       tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke &
 #ifdef ISO
      ,xtevap  &
@@ -3750,4 +4113,6 @@
 
     USE indice_sol_mod
+    use phys_state_var_mod, only: delta_sal, ds_ns, dt_ns, delta_sst
+    use config_ocean_skin_m, only: activate_ocean_skin
 #ifdef ISO
   USE infotrac_phy, ONLY: ntraciso    
@@ -3852,4 +4217,14 @@
                       alb_dif(i,k,nsrf) = 0.06
                    ENDDO
+                   if (activate_ocean_skin >= 1) then
+                      if (activate_ocean_skin == 2 &
+                           .and. type_ocean == "couple") then
+                         delta_sal(i) = 0.
+                         delta_sst(i) = 0.
+                      end if
+                      
+                      ds_ns(i) = 0.
+                      dt_ns(i) = 0.
+                   end if
                 ELSE IF (nsrf.EQ.is_sic) THEN
                    tsurf(i,nsrf) = 271.35
Index: LMDZ6/trunk/libf/phylmdiso/perturb_radlwsw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/perturb_radlwsw.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/perturb_radlwsw.F90	(revision 3940)
@@ -1,27 +1,1 @@
-      SUBROUTINE perturb_radlwsw(zxtsol,iflag_radia)
-!
-!Case-specific radiative setup
-!
-      use dimphy
-      IMPLICIT none
-      INCLUDE "flux_arp.h"     
-!
-! Arguments :
-!------------
-      REAL,DIMENSION(klon), INTENT(INOUT) :: zxtsol
-      INTEGER, INTENT(IN)                 :: iflag_radia
-!
-!======================================================================
-!
-      IF (iflag_radia == 2) THEN
-!
-! Iflag_radia = 2 : DICE case : 
-!               on force zxtsol=tg pour le rayonnement (MPL 20130806)
-!Sonia : Cas dice lmdz1d force en flux : on impose Tg pour imposer le LWUP
-!
-        zxtsol(:) =  tg
-      ENDIF
-!
-      RETURN
-      END
-
+link ../phylmd/perturb_radlwsw.F90
Index: LMDZ6/trunk/libf/phylmdiso/phyetat0.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phyetat0.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phyetat0.F90	(revision 3940)
@@ -1,3 +1,3 @@
-! $Id: phyetat0.F90 3581 2019-10-10 12:35:59Z oboucher $
+! $Id: phyetat0.F90 3890 2021-05-05 15:15:06Z jyg $
 
 SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
@@ -19,6 +19,6 @@
        ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, radpas, radsol, rain_fall, ratqs, &
        rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
-       solsw, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
-       wake_deltat, wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
+       solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
+       wake_deltat, wake_delta_pbl_TKE, delta_tsurf, beta_aridity, wake_fip, wake_pe, &
        wake_s, wake_dens, zgam, zmax0, zmea, zpic, zsig, &
 #ifdef ISO
@@ -27,5 +27,5 @@
 #endif
        zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
-       ale_wake, ale_bl_stat
+       ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal, ratqs_inter
 !FC
   USE geometry_mod, ONLY : longitude_deg, latitude_deg
@@ -38,4 +38,10 @@
   USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, ocean_slab_init
   USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
+#ifdef CPP_XIOS
+  USE wxios, ONLY: missing_val
+#else
+  use netcdf, only: missing_val => nf90_fill_real
+#endif
+  use config_ocean_skin_m, only: activate_ocean_skin
 #ifdef ISO
   USE infotrac_phy, ONLY: ntraciso,niso,iso_num
@@ -52,5 +58,4 @@
   ! Objet: Lecture de l'etat initial pour la physique
   !======================================================================
-  include "netcdf.inc"
   include "dimsoil.h"
   include "clesphys.h"
@@ -330,11 +335,12 @@
 
   found=phyetat0_get(1,solsw,"solsw","net SW radiation surf",0.)
+  found=phyetat0_get(1,solswfdiff,"solswfdiff","fraction of SW radiation surf that is diffuse",1.)
   found=phyetat0_get(1,sollw,"sollw","net LW radiation surf",0.)
   found=phyetat0_get(1,sollwdown,"sollwdown","down LW radiation surf",0.)
   IF (.NOT. found) THEN
-     sollwdown = 0. ;  zts=0.
-     do nsrf=1,nbsrf
+     sollwdown(:) = 0. ;  zts(:)=0.
+     DO nsrf=1,nbsrf
         zts(:)=zts(:)+ftsol(:,nsrf)*pctsrf(:,nsrf)
-     enddo
+     ENDDO
      sollwdown(:)=sollw(:)+RSIGMA*zts(:)**4
   ENDIF
@@ -413,5 +419,8 @@
   IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
     found=phyetat0_srf(klev+1,wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
-    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
+!!    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
+    found=phyetat0_srf(1,delta_tsurf,"DELTATS","Delta Ts wk/env ",0.)
+!!    found=phyetat0_srf(1,beta_aridity,"BETA_S","Aridity factor ",1.)
+    found=phyetat0_srf(1,beta_aridity,"BETAS","Aridity factor ",1.)
   ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
 
@@ -452,4 +461,8 @@
   found=phyetat0_get(1,ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
 
+! fisrtilp/Clouds 0.002 could be ratqsbas. But can stay like this as well
+  found=phyetat0_get(klev,ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
+
+
 !===========================================
   ! Read and send field trs to traclmdz
@@ -468,6 +481,6 @@
   ENDIF
 
-!--OB now this is for co2i
-  IF (type_trac == 'co2i') THEN
+!--OB now this is for co2i - ThL: and therefore also for inco
+  IF (type_trac == 'co2i' .OR. type_trac == 'inco') THEN
      IF (carbon_cycle_cpl) THEN
         ALLOCATE(co2_send(klon), stat=ierr)
@@ -564,4 +577,25 @@
   ENDIF ! Slab        
 
+  if (activate_ocean_skin >= 1) then
+     if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
+        found = phyetat0_get(1, delta_sal, "delta_sal", &
+             "ocean-air interface salinity minus bulk salinity", 0.)
+        found = phyetat0_get(1, delta_sst, "delta_SST", &
+             "ocean-air interface temperature minus bulk SST", 0.)
+     end if
+     
+     found = phyetat0_get(1, ds_ns, "dS_ns", "delta salinity near surface", 0.)
+     found = phyetat0_get(1, dt_ns, "dT_ns", "delta temperature near surface", &
+          0.)
+
+     where (pctsrf(:, is_oce) == 0.)
+        ds_ns = missing_val
+        dt_ns = missing_val
+        delta_sst = missing_val
+        delta_sal = missing_val
+     end where
+  end if
+ 
+
   ! on ferme le fichier
   CALL close_startphy
Index: LMDZ6/trunk/libf/phylmdiso/phyredem.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phyredem.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phyredem.F90	(revision 3940)
@@ -12,5 +12,6 @@
   USE fonte_neige_mod,  ONLY : fonte_neige_final
   USE pbl_surface_mod,  ONLY : pbl_surface_final
-  USE phys_state_var_mod, ONLY: radpas, zmasq, pctsrf, ftsol, falb_dir,      &
+  USE phys_state_var_mod, ONLY: radpas, zmasq, pctsrf,                       &
+                                ftsol, beta_aridity, delta_tsurf, falb_dir,  &
                                 falb_dif, qsol, fevap, radsol, solsw, sollw, &
                                 sollwdown, rain_fall, snow_fall, z0m, z0h,   &
@@ -26,6 +27,7 @@
                                 detr_therm, ale_bl, ale_bl_trig, alp_bl,     &
                                 ale_wake, ale_bl_stat,                       &
-                                du_gwd_rando, du_gwd_front, u10m, v10m,      &
-                                treedrg
+                                du_gwd_rando, du_gwd_front, u10m, v10m, &
+                                treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
+                                delta_sst, ratqs_inter
 #ifdef ISO
   USE phys_state_var_mod, ONLY: xtsol, fxtevap,xtrain_fall, xtsnow_fall,     &
@@ -48,4 +50,5 @@
   USE ocean_slab_mod, ONLY : nslay, tslab, seaice, tice, fsic
   USE time_phylmdz_mod, ONLY: annee_ref, day_end, itau_phy, pdtphys
+  use config_ocean_skin_m, only: activate_ocean_skin  
 
   IMPLICIT none
@@ -179,5 +182,13 @@
     END IF
 
+!    Surface variables 
     CALL put_field_srf1(pass,"TS","Temperature",ftsol(:,:))
+
+!!    CALL put_field_srf1(pass,"DELTA_TS","w-x surface temperature difference", delta_tsurf(:,:))
+    CALL put_field_srf1(pass,"DELTATS","w-x surface temperature difference", delta_tsurf(:,:))
+
+!    CALL put_field_srf1(pass,"BETA_S","Aridity factor", beta_aridity(:,:))
+    CALL put_field_srf1(pass,"BETAS","Aridity factor", beta_aridity(:,:))
+!    End surface variables
 
 ! ================== Albedo =======================================
@@ -209,4 +220,6 @@
 
     CALL put_field(pass,"solsw", "Rayonnement solaire a la surface", solsw)
+
+    CALL put_field(pass,"solswfdiff", "Fraction du rayonnement solaire a la surface qui est diffus", solswfdiff)
 
     CALL put_field(pass,"sollw", "Rayonnement IF a la surface", sollw)
@@ -323,4 +336,8 @@
 
     CALL put_field(pass,"ALE_BL_STAT", "ALE_BL_STAT", ale_bl_stat)
+
+
+    ! fisrtilp/clouds
+    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter)
 
 
@@ -366,4 +383,16 @@
     IF (.not. ok_hines .and. ok_gwd_rando) call put_field(pass,"du_gwd_front", &
          "tendency on zonal wind due to acama gravity waves", du_gwd_front)
+
+    if (activate_ocean_skin >= 1) then
+       if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
+          CALL put_field(pass, "delta_sal", &
+               "ocean-air interface salinity minus bulk salinity", delta_sal)
+          CALL put_field(pass, "delta_SST", &
+               "ocean-air interface temperature minus bulk SST", delta_sst)
+       end if
+       
+       CALL put_field(pass, "dS_ns", "delta salinity near surface", ds_ns)
+       CALL put_field(pass, "dT_ns", "delta temperature near surface", dT_ns)
+    end if
 
 #ifdef ISO
Index: LMDZ6/trunk/libf/phylmdiso/phys_cal_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phys_cal_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phys_cal_mod.F90	(revision 3940)
@@ -1,95 +1,1 @@
-! $Id: phys_cal_mod.F90 3452 2019-01-28 09:45:20Z fairhead $
-MODULE phys_cal_mod
-! This module contains information on the calendar at the current time step
-
-  INTEGER,SAVE :: year_cur      ! current year
-!$OMP THREADPRIVATE(year_cur)
-  INTEGER,SAVE :: mth_cur       ! current month
-!$OMP THREADPRIVATE(mth_cur)
-  INTEGER,SAVE :: day_cur       ! current day
-!$OMP THREADPRIVATE(day_cur)
-  INTEGER,SAVE :: days_elapsed  ! number of whole days since start of the current year
-!$OMP THREADPRIVATE(days_elapsed)
-  INTEGER,SAVE :: mth_len       ! number of days in the current month
-!$OMP THREADPRIVATE(mth_len)
-  INTEGER,SAVE :: year_len      ! number of days in the current year
-!$OMP THREADPRIVATE(year_len)
-  REAL,SAVE    :: hour         ! seconds elapsed (in the current day) since midnight
-!$OMP THREADPRIVATE(hour)
-  REAL,SAVE    :: jD_1jan
-!$OMP THREADPRIVATE(jD_1jan)
-  REAL,SAVE    :: jH_1jan
-!$OMP THREADPRIVATE(jH_1jan)
-  REAL,SAVE    :: xjour
-!$OMP THREADPRIVATE(xjour)
-  REAL,SAVE    :: jD_cur  ! jour courant a l'appel de la physique (jour julien)
-!$OMP THREADPRIVATE(jD_cur)
-  REAL,SAVE    :: jH_cur  ! heure courante a l'appel de la physique (jour julien)
-!$OMP THREADPRIVATE(jH_cur)
-  REAL,SAVE    :: jD_ref  ! jour du demarage de la simulation (jour julien)
-!$OMP THREADPRIVATE(jD_ref)
- CHARACTER (len=10) :: calend ! type of calendar to use
-                              ! (can be earth_360d, earth_365d or earth_366d)
-!$OMP THREADPRIVATE(calend)
-
-CONTAINS
-  
-  SUBROUTINE phys_cal_init(annee_ref,day_ref)
-
-    USE IOIPSL, ONLY:  ymds2ju, ioconf_calendar
-    USE mod_phys_lmdz_para, ONLY:  is_master,is_omp_master
-    USE ioipsl_getin_p_mod, ONLY: getin_p
-
-    IMPLICIT NONE
-    INTEGER,INTENT(IN) :: annee_ref
-    INTEGER,INTENT(IN) :: day_ref
-
-    ! Find out which type of calendar we are using
-    calend = 'earth_360d' ! default
-    CALL getin_p("calend",calend)
-
-    IF (is_omp_master) THEN
-      IF (calend == 'earth_360d') THEN
-        CALL ioconf_calendar('360d')
-      ELSE IF (calend == 'earth_365d') THEN
-        CALL ioconf_calendar('noleap')
-      ELSE IF (calend == 'earth_366d' .OR. calend == 'gregorian') THEN
-        CALL ioconf_calendar('gregorian')
-      ELSE
-        CALL abort_physic('phys_cal_init','Mauvais choix de calendrier',1)
-      ENDIF
-    ENDIF
-!$OMP BARRIER
-     
-    CALL ymds2ju(annee_ref, 1, day_ref, 0., jD_ref)
-    jD_ref=INT(jD_ref)
-  
-  END SUBROUTINE  phys_cal_init
-
-  SUBROUTINE phys_cal_update(julian_date)
-    ! This subroutine updates the module saved variables.
-
-    USE IOIPSL, only: ju2ymds, ymds2ju, ioget_mon_len, ioget_year_len
-    IMPLICIT NONE
-    REAL, INTENT(IN) :: julian_date
-
-    jD_cur=INT(julian_date)
-    jH_cur=julian_date-jD_cur
-    
-    CALL ju2ymds(jD_cur+jH_cur, year_cur, mth_cur, day_cur, hour)
-    CALL ymds2ju(year_cur, 1, 1, 0., jD_1jan)
-    
-    jH_1jan = jD_1jan - int (jD_1jan)
-    jD_1jan = int (jD_1jan) 
-    xjour = jD_cur - jD_1jan
-    days_elapsed = jD_cur - jD_1jan
-
-    ! Get lenght of current month
-    mth_len = ioget_mon_len(year_cur,mth_cur)
-
-    ! Get length of current year
-    year_len = ioget_year_len(year_cur)
-
-  END SUBROUTINE phys_cal_update
-
-END MODULE phys_cal_mod
+link ../phylmd/phys_cal_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/phys_local_var_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phys_local_var_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phys_local_var_mod.F90	(revision 3940)
@@ -1,4 +1,4 @@
 !
-! $Id: phys_local_var_mod.F90 3662 2020-04-12 16:41:53Z oboucher $
+! $Id: phys_local_var_mod.F90 3888 2021-05-05 10:50:37Z jyg $
 !
       MODULE phys_local_var_mod
@@ -16,7 +16,6 @@
       REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:)
       !$OMP THREADPRIVATE(u_seri, v_seri)
-      REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:), l_mix(:,:,:)
-      !$OMP THREADPRIVATE(l_mixmin, l_mix)
-
+      REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:), l_mix(:,:,:), tke_dissip(:,:,:)
+      !$OMP THREADPRIVATE(l_mixmin, l_mix, tke_dissip)
       REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
       !$OMP THREADPRIVATE(tr_seri)
@@ -334,5 +333,5 @@
 !!!OMP THREADPRIVATE(d_s_the, d_dens_the)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)           :: d_deltat_ajs_cv, d_deltaq_ajs_cv
-!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)
+!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)                       
 #ifdef ISO
     REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          :: d_deltaxt_wk
@@ -355,6 +354,5 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cldh, cldl, cldm, cldq, cldt, qsat2m
 !$OMP THREADPRIVATE(cldh, cldl, cldm, cldq, cldt, qsat2m )
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cldhjn, cldljn, cldmjn,cldtjn
-!$OMP THREADPRIVATE(cldhjn, cldljn, cldmjn, cldtjn)
+!AS: cldhjn, cldljn, cldmjn,cldtjn pas utilisés en tant que variables, juste noms de diagnostics
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: JrNt
 !$OMP THREADPRIVATE(JrNt)
@@ -411,4 +409,6 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat_x, zxfluxlat_w
 !$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: delta_qsurf
+!$OMP THREADPRIVATE(delta_qsurf)
 !jyg<
 !!! Entrees supplementaires couche-limite
@@ -455,10 +455,4 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_min_mon, t2m_max_mon
 !$OMP THREADPRIVATE(t2m_min_mon, t2m_max_mon)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zq2m_cor, zt2m_cor
-!$OMP THREADPRIVATE(zq2m_cor, zt2m_cor)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zu10m_cor, zv10m_cor
-!$OMP THREADPRIVATE(zu10m_cor, zv10m_cor)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zrh2m_cor, zqsat2m_cor
-!$OMP THREADPRIVATE(zrh2m_cor, zqsat2m_cor)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: weak_inversion
 !$OMP THREADPRIVATE(weak_inversion)
@@ -567,6 +561,6 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: ref_liq_pi, ref_ice_pi
 !$OMP THREADPRIVATE(ref_liq_pi, ref_ice_pi)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zx_rh
-!$OMP THREADPRIVATE(zx_rh)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zx_rh, zx_rhl, zx_rhi
+!$OMP THREADPRIVATE(zx_rh, zx_rhl, zx_rhi)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca
 !$OMP THREADPRIVATE(prfl, psfl, fraca)
@@ -604,4 +598,7 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: p_tropopause, z_tropopause, t_tropopause
 !$OMP THREADPRIVATE(p_tropopause, z_tropopause, t_tropopause)
+
+      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zn2mout
+!$OMP THREADPRIVATE(zn2mout)
 
 #ifdef CPP_StratAer
@@ -694,6 +691,6 @@
       ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
       ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
-      ALLOCATE(l_mixmin(klon,klev+1,nbsrf), l_mix(klon,klev+1,nbsrf))
-      l_mix(:,:,:)=0. ; l_mixmin(:,:,:)=0. ! doit etre initialse car pas toujours remplis
+      ALLOCATE(l_mixmin(klon,klev+1,nbsrf), l_mix(klon,klev+1,nbsrf), tke_dissip(klon,klev+1,nbsrf))
+      l_mix(:,:,:)=0. ; l_mixmin(:,:,:)=0. ; tke_dissip(:,:,:)=0. ! doit etre initialse car pas toujours remplis
 
       ALLOCATE(tr_seri(klon,klev,nbtr))
@@ -882,5 +879,4 @@
       ALLOCATE(cdragm(klon), cdragh(klon), cldh(klon), cldl(klon))
       ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon))
-      ALLOCATE(cldhjn(klon), cldljn(klon), cldmjn(klon), cldtjn(klon))
       ALLOCATE(JrNt(klon))
       ALLOCATE(dthmin(klon), evap(klon), fder(klon), plcl(klon), plfc(klon))
@@ -915,4 +911,5 @@
       ALLOCATE(sens_x(klon), sens_w(klon))
       ALLOCATE(zxfluxlat_x(klon), zxfluxlat_w(klon))
+      ALLOCATE(delta_qsurf(klon))
 !jyg<
 !!      ALLOCATE(t_x(klon,klev), t_w(klon,klev))
@@ -940,6 +937,4 @@
       ALLOCATE(zt2m_min_mon(klon), zt2m_max_mon(klon))
       ALLOCATE(t2m_min_mon(klon), t2m_max_mon(klon))
-      ALLOCATE(zq2m_cor(klon), zt2m_cor(klon), zu10m_cor(klon), zv10m_cor(klon))
-      ALLOCATE(zrh2m_cor(klon), zqsat2m_cor(klon))
       ALLOCATE(sens(klon), flwp(klon), fiwp(klon))
       ALLOCATE(alp_bl_conv(klon), alp_bl_det(klon))
@@ -962,5 +957,5 @@
       ALLOCATE(ref_liq(klon, klev), ref_ice(klon, klev), theta(klon, klev))
       ALLOCATE(ref_liq_pi(klon, klev), ref_ice_pi(klon, klev))
-      ALLOCATE(zphi(klon, klev), zx_rh(klon, klev))
+      ALLOCATE(zphi(klon, klev), zx_rh(klon, klev), zx_rhl(klon,klev), zx_rhi(klon,klev))
       ALLOCATE(pmfd(klon, klev), pmfu(klon, klev))
 
@@ -1039,4 +1034,6 @@
       ALLOCATE (z_tropopause(klon))
       ALLOCATE (t_tropopause(klon))
+
+      ALLOCATE(zn2mout(klon,6))
 
 #ifdef CPP_StratAer
@@ -1089,5 +1086,5 @@
       DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri)
       DEALLOCATE(u_seri,v_seri)
-      DEALLOCATE(l_mixmin,l_mix)
+      DEALLOCATE(l_mixmin,l_mix, tke_dissip)
 
       DEALLOCATE(tr_seri)
@@ -1253,5 +1250,5 @@
       DEALLOCATE(cdragm, cdragh, cldh, cldl)
       DEALLOCATE(cldm, cldq, cldt, qsat2m)
-      DEALLOCATE(cldljn, cldmjn, cldhjn, cldtjn, JrNt)
+      DEALLOCATE(JrNt)
       DEALLOCATE(dthmin, evap, fder, plcl, plfc)
       DEALLOCATE(prw, prlw, prsw, zustar, zu10m, zv10m, rh2m, s_lcl)
@@ -1274,4 +1271,5 @@
       DEALLOCATE(sens_x, sens_w)
       DEALLOCATE(zxfluxlat_x, zxfluxlat_w)
+      DEALLOCATE(delta_qsurf)
 !jyg<
 !!      DEALLOCATE(t_x, t_w)
@@ -1303,6 +1301,4 @@
       DEALLOCATE(zt2m_min_mon, zt2m_max_mon)
       DEALLOCATE(t2m_min_mon, t2m_max_mon)
-      DEALLOCATE(zq2m_cor, zt2m_cor, zu10m_cor, zv10m_cor)
-      DEALLOCATE(zrh2m_cor, zqsat2m_cor)
       DEALLOCATE(sens, flwp, fiwp)
       DEALLOCATE(alp_bl_conv,alp_bl_det)
@@ -1322,5 +1318,5 @@
       DEALLOCATE(ref_liq, ref_ice, theta)
       DEALLOCATE(ref_liq_pi, ref_ice_pi)
-      DEALLOCATE(zphi, zx_rh)
+      DEALLOCATE(zphi, zx_rh, zx_rhl, zx_rhi)
       DEALLOCATE(pmfd, pmfu)
 
@@ -1391,4 +1387,5 @@
       DEALLOCATE (z_tropopause)
       DEALLOCATE (t_tropopause)
+      DEALLOCATE(zn2mout)
 
 #ifdef CPP_StratAer
Index: LMDZ6/trunk/libf/phylmdiso/phys_output_ctrlout_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 3940)
@@ -1,4 +1,4 @@
 !
-! $Id: phys_output_ctrlout_mod.F90 3691 2020-05-30 15:37:19Z oboucher $
+! $Id: phys_output_ctrlout_mod.F90 3888 2021-05-05 10:50:37Z jyg $
 !
 MODULE phys_output_ctrlout_mod
@@ -7,5 +7,4 @@
   USE indice_sol_mod
   USE aero_mod
-
 
   IMPLICIT NONE
@@ -273,4 +272,18 @@
     't2m_sic', "Temp 2m "//clnsurf(4), "K", (/ ('', i=1, 10) /)) /)
 
+  TYPE(ctrl_out), SAVE :: o_nt2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nt2mout', 'Nbt2m out of range complete computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nq2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nq2mout', 'Nbq2m out of range complete computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nu2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nu2mout', 'Nbu2m out of range complete computation', '-', (/ ('', i=1, 10) /))
+
+  TYPE(ctrl_out), SAVE :: o_nt2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nt2moutfg', 'Nbt2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nq2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nq2moutfg', 'Nbq2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nu2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nu2moutfg', 'Nbu2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
+
   TYPE(ctrl_out), SAVE :: o_gusts = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11, 11/), &
     'gusts', 'surface gustiness', 'm2/s2', (/ ('', i=1, 10) /))
@@ -281,7 +294,7 @@
     'wind100m', '100-m wind speed', 'm/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_loadfactor_wind_onshore = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'load_factor_wind_onshore', 'Load factor for onshore windmill', '-', (/ ('', i=1, 10) /))
+    'woncfr', 'Onshore Wind Capacity factor', 'kW/kW_installed', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_loadfactor_wind_offshore = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'load_factor_wind_offshore', 'Load factor for offshore windmill', '-', (/ ('', i=1, 10) /))
+    'wofcfr', 'Offshore Wind Capacity factor', 'kW/kW_installed', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_wind10max = ctrl_out((/ 10, 1, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'wind10max', '10m wind speed max', 'm/s', &
@@ -462,5 +475,7 @@
   TYPE(ctrl_out), SAVE :: o_SWupSFCcleanclr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     'SWupSFCcleanclr', 'SWup clear sky clean (no aerosol) at surface', 'W/m2', (/ ('', i=1, 10) /))
-  TYPE(ctrl_out), SAVE :: o_SWdnSFC = ctrl_out((/ 1, 1, 10, 10, 5, 10, 11, 11, 11, 11/), &
+  TYPE(ctrl_out), SAVE :: o_fdiffSWdnSFC = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'fdiffSWdnSFC', 'Fraction of diffuse SWdn at surface', 'W/m2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_SWdnSFC = ctrl_out((/ 1, 1, 1, 10, 5, 10, 11, 11, 11, 11/), &
     'SWdnSFC', 'SWdn at surface', 'W/m2', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_SWdnSFCclr = ctrl_out((/ 1, 4, 10, 10, 5, 10, 11, 11, 11, 11/), &
@@ -567,11 +582,11 @@
   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_evappot_srf  = (/ &
       ctrl_out((/ 1, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_ter',    &
-      "Temperature"//clnsurf(1),"K", (/ ('', i=1, 10) /)),   &
+      "Potential evaporation "//clnsurf(1),"kg/(m2*s)", (/ ('', i=1, 10) /)),   &
       ctrl_out((/ 4, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_lic',    &
-      "Temperature"//clnsurf(2),"K", (/ ('', i=1, 10) /)),   &
+      "Potential evaporation "//clnsurf(2),"kg/(m2*s)", (/ ('', i=1, 10) /)),   &
       ctrl_out((/ 4, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_oce',    &
-      "Temperature"//clnsurf(3),"K", (/ ('', i=1, 10) /)),   &
+      "Potential evaporation "//clnsurf(3),"kg/(m2*s)", (/ ('', i=1, 10) /)),   &
       ctrl_out((/ 4, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_sic',    &
-      "Temperature"//clnsurf(4),"K", (/ ('', i=1, 10) /)) /)
+      "Potential evaporation "//clnsurf(4),"kg/(m2*s)", (/ ('', i=1, 10) /)) /)
 
   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_sens_srf     = (/          &
@@ -695,15 +710,15 @@
     'iwp', 'Cloud ice water path', 'kg/m2', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_ue = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'ue', 'Zonal dry static energy transport', '-', (/ ('', i=1, 10) /))
+    'ue', 'Zonal dry static energy transport', 'J/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_ve = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    've', 'Merid dry static energy transport', '-', (/ ('', i=1, 10) /))
+    've', 'Merid dry static energy transport', 'J/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_uq = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'uq', 'Zonal humidity transport', '-', (/ ('', i=1, 10) /))
+    'uq', 'Zonal humidity transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_vq = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'vq', 'Merid humidity transport', '-', (/ ('', i=1, 10) /))
+    'vq', 'Merid humidity transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_uwat = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'uwat', 'Zonal total water transport', '-', (/ ('', i=1, 10) /))
+    'uwat', 'Zonal total water transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_vwat = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'vwat', 'Merid total water transport', '-', (/ ('', i=1, 10) /))
+    'vwat', 'Merid total water transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_cape = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'cape', 'Conv avlbl pot ener', 'J/kg', (/ ('', i=1, 10) /))
@@ -799,6 +814,4 @@
 'flat_w', 'flat within_wake', 'W/m2', (/ ('', i=1, 10) /))
 !!
-  type(ctrl_out),save :: o_delta_tsurf    = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-'delta_tsurf', 'Temperature difference (w-x)', 'K', (/ ('', i=1, 10) /))
   type(ctrl_out),save :: o_cdragh_x       = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
 'cdragh_x', 'cdragh off-wake', '', (/ ('', i=1, 10) /))
@@ -1004,9 +1017,10 @@
   TYPE(ctrl_out), SAVE :: o_tke = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke ', 'TKE', 'm2/s2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_tke_dissip = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'tke_dissip ', 'TKE DISSIPATION', 'm2/s3', (/ ('', i=1, 10) /))   
   TYPE(ctrl_out), SAVE :: o_tke_max = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke_max', 'TKE max', 'm2/s2',                                  &
       (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', &
          't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
-
   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_tke_srf      = (/             &
       ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'tke_ter',       &
@@ -1050,4 +1064,5 @@
       "min PBL mixing length "//clnsurf(4),"m", (/ ('', i=1, 10) /)) /)
 
+
   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_tke_max_srf  = (/                          &
       ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'tke_max_ter',                &
@@ -1077,4 +1092,16 @@
       ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'dltpbltke_sic',       &
       "TKE difference (w - x) "//clnsurf(4),"-", (/ ('', i=1, 10) /)) /)
+
+  TYPE(ctrl_out), SAVE :: o_delta_tsurf = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'delta_tsurf ', 'T_surf difference (w - x)', 'K', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_delta_tsurf_srf      = (/             &
+      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_ter',       &
+      "T_surf difference (w - x) "//clnsurf(1),"-", (/ ('', i=1, 10) /)), &
+      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_lic',       &
+      "T_surf difference (w - x) "//clnsurf(2),"-", (/ ('', i=1, 10) /)), &
+      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_oce',       &
+      "T_surf difference (w - x) "//clnsurf(3),"-", (/ ('', i=1, 10) /)), &
+      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_sic',       &
+      "T_surf difference (w - x) "//clnsurf(4),"-", (/ ('', i=1, 10) /)) /)
 
   TYPE(ctrl_out), SAVE :: o_kz = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
@@ -1304,4 +1331,8 @@
   TYPE(ctrl_out), SAVE :: o_flx_co2_land = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     'flx_co2_land', 'CO2 flux from the land', '1', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_flx_co2_ocean_cor = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'flx_co2_ocean_cor', 'correction of the CO2 flux from the ocean', 'kg CO2 m-2 s-1', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_flx_co2_land_cor = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'flx_co2_land_cor', 'correction of the CO2 flux from the land', 'kg CO2 m-2 s-1', (/ ('', i=1, 10) /))
 
 #ifdef CPP_StratAer
@@ -1433,4 +1464,8 @@
   TYPE(ctrl_out), SAVE :: o_rhum = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'rhum', 'Relative humidity', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_rhl = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'rhl', 'Relative humidity wrt liquid', '%', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_rhi = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'rhi', 'Relative humidity wrt ice', '%', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_ozone = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'ozone', 'Ozone mole fraction', '-', (/ ('', i=1, 10) /))
@@ -1970,3 +2005,43 @@
 #endif
 
+   type(ctrl_out), save:: o_delta_sst &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'delta_SST', &
+        "ocean-air interface temperature minus bulk SST", "K", '')
+
+   type(ctrl_out), save:: o_delta_sal &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'delta_sal', &
+        "ocean-air interface salinity minus bulk salinity", "ppt", '')
+
+   type(ctrl_out), save:: o_ds_ns &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dS_ns', &
+        "subskin salinity minus foundation salinity", "ppt", '')
+
+   type(ctrl_out), save:: o_dt_ns &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dT_ns', &
+        "subskin temperature minus foundation temperature", "K", '')
+
+   type(ctrl_out), save:: o_dter &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dTer', &
+        "ocean-air interface temperature minus sub-skin temperature", "K", '')
+
+   type(ctrl_out), save:: o_dser &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dSer', &
+        "ocean-air interface salinity minus sub-skin salinity", "ppt", '')
+
+   type(ctrl_out), save:: o_tkt &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'tkt', &
+        "thickness of thermal microlayer", "m", '')
+
+   type(ctrl_out), save:: o_tks &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'tks', &
+        "thickness of salinity microlayer", "m", '')
+
+   type(ctrl_out), save:: o_taur &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'taur', &
+        "momentum flux due to rain", "Pa", '')
+
+   type(ctrl_out), save:: o_sss &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'SSS', &
+        "bulk sea-surface salinity", "ppt", '')
+
 END MODULE phys_output_ctrlout_mod
Index: LMDZ6/trunk/libf/phylmdiso/phys_output_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phys_output_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phys_output_mod.F90	(revision 3940)
@@ -1,3 +1,3 @@
-! $Id: phys_output_mod.F90 3666 2020-04-20 10:13:34Z lfalletti $
+! $Id: phys_output_mod.F90 3792 2021-01-04 17:01:25Z evignon $
 !
 
@@ -41,5 +41,5 @@
     USE mod_phys_lmdz_para
     !Martin
-    USE surface_data, ONLY : ok_snow
+    USE surface_data, ONLY : landice_opt
     USE phys_output_ctrlout_mod
     USE mod_grid_phy_lmdz, only: klon_glo,nbp_lon,nbp_lat
@@ -379,5 +379,4 @@
     ENDIF
 
-        write(*,*) 'phys_output_mid 344'
 !!! Declaration des axes verticaux de chaque fichier:
     IF (prt_level >= 10) THEN
@@ -452,5 +451,4 @@
    ENDIF
 #endif 
-        write(*,*) 'phys_output_mid 416'
 
         IF (clef_files(iff)) THEN
Index: LMDZ6/trunk/libf/phylmdiso/phys_output_var_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phys_output_var_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phys_output_var_mod.F90	(revision 3940)
@@ -133,4 +133,28 @@
  !$OMP THREADPRIVATE(sens_prec_liq_o, sens_prec_sol_o,lat_prec_liq_o,lat_prec_sol_o)
 
+  ! Ocean-atmosphere interface, subskin ocean and near-surface ocean:
+  
+  REAL, ALLOCATABLE, SAVE:: dter(:)
+  ! Temperature variation in the diffusive microlayer, that is
+  ! ocean-air interface temperature minus subskin temperature. In K.
+      
+  REAL, SAVE, ALLOCATABLE:: dser(:)
+  ! Temperature variation in the diffusive microlayer, that is
+  ! subskin temperature minus ocean-air interface temperature. In K.
+
+  REAL, SAVE, ALLOCATABLE:: tkt(:)
+  ! épaisseur (m) de la couche de diffusion thermique (microlayer)
+  ! cool skin thickness
+
+  REAL, SAVE, ALLOCATABLE:: tks(:)
+  ! épaisseur (m) de la couche de diffusion de masse (microlayer)
+  
+  REAL, SAVE, ALLOCATABLE:: taur(:) ! momentum flux due to rain, in Pa
+
+  REAL, SAVE, ALLOCATABLE:: sss(:)
+  ! bulk salinity of the surface layer of the ocean, in ppt
+  
+  !$OMP THREADPRIVATE(dter, dser, tkt, tks, taur, sss)
+
 CONTAINS
 
@@ -138,4 +162,5 @@
   SUBROUTINE phys_output_var_init
     use dimphy
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     IMPLICIT NONE
@@ -191,4 +216,7 @@
     IF (ok_gwd_rando) allocate(zustr_gwd_rando(klon), zvstr_gwd_rando(klon))
 
+    if (activate_ocean_skin >= 1) allocate(dter(klon), dser(klon), tkt(klon), &
+         tks(klon), taur(klon), sss(klon))
+
   END SUBROUTINE phys_output_var_init
 
Index: LMDZ6/trunk/libf/phylmdiso/phys_output_write_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phys_output_write_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phys_output_write_mod.F90	(revision 3940)
@@ -1,4 +1,4 @@
 !
-! $Id: phys_output_write_mod.F90 3692 2020-06-02 14:57:54Z oboucher $
+! $Id: phys_output_write_mod.F90 3900 2021-05-17 13:35:58Z evignon $
 !
 MODULE phys_output_write_mod
@@ -38,4 +38,7 @@
          o_t2m, o_t2m_min, o_t2m_max, &
          o_t2m_min_mon, o_t2m_max_mon, &
+         o_nt2mout, o_nt2moutfg, &
+         o_nq2mout, o_nq2moutfg, &
+         o_nu2mout, o_nu2moutfg, &
          o_q2m, o_ustar, o_u10m, o_v10m, &
          o_wind10m, o_wind10max, o_wind100m, o_gusts, o_sicf, &
@@ -45,5 +48,5 @@
          o_snow, o_msnow, o_fsnow, o_evap, o_ep,o_epmax_diag, & ! epmax_cape
          o_tops, o_tops0, o_topl, o_topl0, &
-         o_SWupTOA, o_SWupTOAclr, o_SWupTOAcleanclr, o_SWdnTOA, &
+         o_SWupTOA, o_SWupTOAclr, o_SWupTOAcleanclr, o_SWdnTOA, o_fdiffSWdnSFC, &
          o_SWdnTOAclr, o_nettop, o_SWup200, &
          o_SWup200clr, o_SWdn200, o_SWdn200clr, &
@@ -84,5 +87,5 @@
          o_dtvdf_x    , o_dtvdf_w    , o_dqvdf_x    , o_dqvdf_w    , &
          o_sens_x     , o_sens_w     , o_flat_x     , o_flat_w     , &
-         o_delta_tsurf, &
+         o_delta_tsurf, o_delta_tsurf_srf, &
          o_cdragh_x   , o_cdragh_w   , o_cdragm_x   , o_cdragm_w   , &
          o_kh         , o_kh_x       , o_kh_w       , &
@@ -133,8 +136,8 @@
          o_vitu, o_vitv, o_vitw, o_pres, o_paprs, &
          o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
-         o_rnebls, o_rneblsvol, o_rhum, o_ozone, o_ozone_light, &
+         o_rnebls, o_rneblsvol, o_rhum, o_rhl, o_rhi, o_ozone, o_ozone_light, &
          o_duphy, o_dtphy, o_dqphy, o_dqphy2d, o_dqlphy, o_dqlphy2d, &
          o_dqsphy, o_dqsphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
-         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, &
+         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, o_tke_dissip, &
          o_tke_max, o_kz, o_kz_max, o_clwcon, &
          o_dtdyn, o_dqdyn, o_dqdyn2d, o_dqldyn, o_dqldyn2d, & 
@@ -206,6 +209,9 @@
          o_col_O3_strato, o_col_O3_tropo,                 & 
 !--interactive CO2
-         o_flx_co2_ocean, o_flx_co2_land, o_flx_co2_ff, o_flx_co2_bb
-
+         o_flx_co2_ocean, o_flx_co2_ocean_cor, &
+         o_flx_co2_land, o_flx_co2_land_cor, & 
+         o_flx_co2_ff, o_flx_co2_bb, & 
+         o_delta_sst, o_delta_sal, o_ds_ns, o_dt_ns, o_dter, o_dser, o_tkt, &
+         o_tks, o_taur, o_sss
 
 #ifdef CPP_StratAer
@@ -230,5 +236,5 @@
          qsol, z0m, z0h, fevap, agesno, &
          nday_rain, rain_con, snow_con, &
-         topsw, toplw, toplw0, swup, swdn, &
+         topsw, toplw, toplw0, swup, swdn, solswfdiff, &
          topsw0, swupc0, swdnc0, swup0, swdn0, SWup200, SWup200clr, &
          SWdn200, SWdn200clr, LWup200, LWup200clr, &
@@ -252,14 +258,14 @@
          T2sumSTD, nlevSTD, du_gwd_rando, du_gwd_front, &
          ulevSTD, vlevSTD, wlevSTD, philevSTD, qlevSTD, tlevSTD, &
-         rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, &
+         rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, vphiSTD, &
+         wTSTD, u2STD, v2STD, T2STD, missing_val_nf90, delta_sal, ds_ns, &
 #ifdef ISO
         xtrain_con, xtsnow_con, xtrain_fall, xtsnow_fall, &
 #endif
-         vphiSTD, wTSTD, u2STD, v2STD, T2STD, missing_val_nf90
+         dt_ns, delta_sst
 
     USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
-         zt2m_cor,zq2m_cor,zu10m_cor,zv10m_cor, zrh2m_cor, zqsat2m_cor, &
-         t2m_min_mon, t2m_max_mon, evap, &
-         l_mixmin,l_mix, &
+         zn2mout, t2m_min_mon, t2m_max_mon, evap, &
+         l_mixmin,l_mix, tke_dissip, &
          zu10m, zv10m, zq2m, zustar, zxqsurf, &
          rain_lsc, rain_num, snow_lsc, bils, sens, fder, &
@@ -268,8 +274,8 @@
          sissnow, runoff, albsol3_lic, evap_pot, &
          t2m, fluxt, fluxlat, fsollw, fsolsw, &
-         wfbils, wfbilo, wfevap, wfrain, wfsnow, & 
+         wfbils, wfbilo, wfevap, wfrain, wfsnow, &
          cdragm, cdragh, cldl, cldm, &
-         cldh, cldt, JrNt, cldljn, cldmjn, cldhjn, &
-         cldtjn, cldq, flwp, fiwp, ue, ve, uq, vq, &
+         cldh, cldt, JrNt,   & ! only output names: cldljn,cldmjn,cldhjn,cldtjn
+         cldq, flwp, fiwp, ue, ve, uq, vq, &
          uwat, vwat, &
          plcl, plfc, wbeff, convoccur, upwd, dnwd, dnwd0, prw, prlw, prsw, &
@@ -307,5 +313,5 @@
          ql_seri, qs_seri, tr_seri, &
          zphi, u_seri, v_seri, omega, cldfra, &
-         rneb, rnebjn, rneblsvol, zx_rh, d_t_dyn,  & 
+         rneb, rnebjn, rneblsvol, zx_rh, zx_rhl, zx_rhi, d_t_dyn,  & 
          d_q_dyn,  d_ql_dyn, d_qs_dyn, &
          d_q_dyn2d,  d_ql_dyn2d, d_qs_dyn2d, &
@@ -349,4 +355,5 @@
 
     USE carbon_cycle_mod, ONLY: fco2_ff, fco2_bb, fco2_land, fco2_ocean
+    USE carbon_cycle_mod, ONLY: fco2_ocean_cor, fco2_land_cor
 
     USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, &
@@ -370,5 +377,5 @@
          alt_tropo, &
 !Ionela
-         ok_4xCO2atm
+         ok_4xCO2atm, dter, dser, tkt, tks, taur, sss
 
     USE ocean_slab_mod, ONLY: nslay, tslab, slab_bilg, tice, seaice, &
@@ -383,5 +390,5 @@
 #endif
     USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
-    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, ok_snow
+    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, landice_opt
     USE aero_mod, ONLY: naero_tot, id_STRAT_phy
     USE ioipsl, ONLY: histend, histsync
@@ -402,4 +409,5 @@
 #endif
     USE tracinca_mod, ONLY: config_inca
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     USE vertical_layers_mod, ONLY: presnivs
@@ -471,4 +479,6 @@
     REAL,DIMENSION(klon)      :: zrho, zt
 
+    INTEGER :: nqup
+
     ! On calcul le nouveau tau:
     itau_w = itau_phy + itap 
@@ -484,4 +494,8 @@
 #ifdef CPP_XIOS
     CALL wxios_set_context
+#endif
+
+#ifndef CPP_XIOS
+    missing_val=missing_val_nf90
 #endif
 
@@ -702,7 +716,7 @@
        CALL histwrite_phy(o_slp, slp)
        CALL histwrite_phy(o_tsol, zxtsol)
-       CALL histwrite_phy(o_t2m, zt2m_cor)
-       CALL histwrite_phy(o_t2m_min, zt2m_cor)
-       CALL histwrite_phy(o_t2m_max, zt2m_cor)
+       CALL histwrite_phy(o_t2m, zt2m)
+       CALL histwrite_phy(o_t2m_min, zt2m)
+       CALL histwrite_phy(o_t2m_max, zt2m)
        CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon)
        CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon)
@@ -710,5 +724,47 @@
        IF (vars_defined) THEN
           DO i=1, klon
-             zx_tmp_fi2d(i)=SQRT(zu10m_cor(i)*zu10m_cor(i)+zv10m_cor(i)*zv10m_cor(i))
+             zx_tmp_fi2d(i)=real(zn2mout(i,1))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nt2mout, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,2))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nt2moutfg, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,3))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nq2mout, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,4))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nq2moutfg, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,5))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nu2mout, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,6))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nu2moutfg, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
           ENDDO
        ENDIF
@@ -717,5 +773,5 @@
        IF (vars_defined) THEN
           DO i=1, klon
-             zx_tmp_fi2d(i)=SQRT(zu10m_cor(i)*zu10m_cor(i)+zv10m_cor(i)*zv10m_cor(i))
+             zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
           ENDDO
        ENDIF
@@ -725,5 +781,4 @@
 
        IF (vars_defined) THEN
-          missing_val=missing_val_nf90
           DO k = 1, kmax_100m                                      !--we could stop much lower
             zrho(:) = pplay(:,k)/t_seri(:,k)/RD                    ! air density in kg/m3
@@ -759,6 +814,6 @@
                zx_tmp_fi2d(i)=1.0
              ELSE
-               zx_tmp_fi2d(i)= 1.059e-09*x**10. - 1.351e-07*x**9. + 7.478e-06*x**8. - 0.0002352*x**7. + 0.004627*x**6. & 
-                             - 0.05898*x**5. + 0.4893*x**4. - 2.59*x**3. + 8.339*x**2. - 14.69*x + 10.73
+               zx_tmp_fi2d(i)= 10.73 + x*(-14.69 + x*(8.339 + x*(-2.59 + x*(0.4893 + x*(-0.05898 + x*(0.004627 + & 
+                               x*(-0.0002352 + x*(7.478e-06 + x*(-1.351e-07 + x*(1.059e-09))))))))))
                zx_tmp_fi2d(i)=MIN(MAX(zx_tmp_fi2d(i),0.0),1.0)
              ENDIF
@@ -780,6 +835,6 @@
                zx_tmp_fi2d(i)=1.0
              ELSE
-               zx_tmp_fi2d(i)= 3.352e-10*x**10. - 4.959e-08*x**9. + 3.195e-06*x**8. - 0.0001175*x**7. + 0.002716*x**6. &
-                             - 0.04099*x**5. + 0.4065*x**4. - 2.601*x**3. + 10.25*x**2. - 22.39*x + 20.59
+               zx_tmp_fi2d(i)= 20.59 + x*(-22.39 + x*(10.25 + x*(-2.601 + x*(0.4065 + x*(-0.04099 + x*(0.002716 + & 
+                               x*(-0.0001175 + x*(3.195e-06 + x*(-4.959e-08 + x*(3.352e-10))))))))))
                zx_tmp_fi2d(i)=MIN(MAX(zx_tmp_fi2d(i),0.0),1.0)
              ENDIF
@@ -797,8 +852,10 @@
        ENDIF
        CALL histwrite_phy(o_sicf, zx_tmp_fi2d)
-       CALL histwrite_phy(o_q2m, zq2m_cor)
-       CALL histwrite_phy(o_ustar, zustar)
-       CALL histwrite_phy(o_u10m, zu10m_cor)
-       CALL histwrite_phy(o_v10m, zv10m_cor)
+       CALL histwrite_phy(o_q2m, zq2m)
+       IF (vars_defined) zx_tmp_fi2d = zustar
+       CALL histwrite_phy(o_ustar, zx_tmp_fi2d)
+       CALL histwrite_phy(o_u10m, zu10m)
+       CALL histwrite_phy(o_v10m, zv10m)
+
 
        IF (vars_defined) THEN
@@ -961,4 +1018,6 @@
        ENDIF
        CALL histwrite_phy(o_SWdnSFCcleanclr, zx_tmp_fi2d)
+
+       CALL histwrite_phy(o_fdiffSWdnSFC, solswfdiff)
 
        IF (vars_defined) THEN
@@ -1022,13 +1081,14 @@
        CALL histwrite_phy(o_tauy, zx_tmp_fi2d)
 
-       IF (ok_snow) THEN
-          CALL histwrite_phy(o_snowsrf, snow_o)
-          CALL histwrite_phy(o_qsnow, qsnow)
-          CALL histwrite_phy(o_snowhgt,snowhgt)
-          CALL histwrite_phy(o_toice,to_ice)
-          CALL histwrite_phy(o_sissnow,sissnow)
-          CALL histwrite_phy(o_runoff,runoff)
-          CALL histwrite_phy(o_albslw3,albsol3_lic)
-       ENDIF
+       ! Etienne: test sorties pour compil sur JZ
+!       IF (landice_opt .GE. 1) THEN
+!          CALL histwrite_phy(o_snowsrf, snow_o)
+!          CALL histwrite_phy(o_qsnow, qsnow)
+!          CALL histwrite_phy(o_snowhgt,snowhgt)
+!          CALL histwrite_phy(o_toice,to_ice)
+!          CALL histwrite_phy(o_sissnow,sissnow)
+!          CALL histwrite_phy(o_runoff,runoff)
+!          CALL histwrite_phy(o_albslw3,albsol3_lic)
+!       ENDIF
 
        DO nsrf = 1, nbsrf
@@ -1080,4 +1140,6 @@
              CALL histwrite_phy(o_l_mixmin(nsrf),  l_mixmin(:,1:klev,nsrf))
              CALL histwrite_phy(o_tke_max_srf(nsrf),  pbl_tke(:,1:klev,nsrf))
+
+                         
           ENDIF
 !jyg<
@@ -1090,6 +1152,20 @@
 !            ENDIF
 
-
        ENDDO
+       
+                
+        IF (iflag_pbl > 1) THEN
+          zx_tmp_fi3d=0.
+          IF (vars_defined) THEN
+             DO nsrf=1,nbsrf
+                DO k=1,klev
+                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
+                        +pctsrf(:,nsrf)*tke_dissip(:,k,nsrf)
+                ENDDO
+             ENDDO
+          ENDIF
+          
+          CALL histwrite_phy(o_tke_dissip, zx_tmp_fi3d)    
+       ENDIF
 
        IF (vars_defined) zx_tmp_fi2d(1 : klon) = sens_prec_liq_o(1 : klon, 1)
@@ -1215,5 +1291,4 @@
        ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
        ! Champs interpolles sur des niveaux de pression
-       missing_val=missing_val_nf90
        DO iff=1, nfiles
           ll=0
@@ -1307,9 +1382,18 @@
 !
                CALL histwrite_phy(o_dqvdf_w    ,zx_tmp_fi3d) 
-               CALL histwrite_phy(o_sens_x     ,sens_x     ) 
-               CALL histwrite_phy(o_sens_w     ,sens_w     ) 
+       IF (vars_defined)  zx_tmp_fi2d(1:klon)=-1*sens_x(1:klon)
+               CALL histwrite_phy(o_sens_x     ,zx_tmp_fi2d) 
+       IF (vars_defined)  zx_tmp_fi2d(1:klon)=-1*sens_w(1:klon)
+               CALL histwrite_phy(o_sens_w     ,zx_tmp_fi2d) 
                CALL histwrite_phy(o_flat_x     ,zxfluxlat_x) 
                CALL histwrite_phy(o_flat_w     ,zxfluxlat_w) 
-               CALL histwrite_phy(o_delta_tsurf,delta_tsurf) 
+          zx_tmp_fi2d=0.
+          IF (vars_defined) THEN
+             DO nsrf=1,nbsrf
+                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:) &
+                        +pctsrf(:,nsrf)*delta_tsurf(:,nsrf)
+             ENDDO
+          ENDIF
+               CALL histwrite_phy(o_delta_tsurf,zx_tmp_fi2d) 
                CALL histwrite_phy(o_cdragh_x   ,cdragh_x   ) 
                CALL histwrite_phy(o_cdragh_w   ,cdragh_w   ) 
@@ -1419,5 +1503,9 @@
        IF (vars_defined) THEN
           DO i=1, klon
-             zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.)
+             IF (zt2m(i).LE.273.15) then
+                zx_tmp_fi2d(i)=MAX(0.,rh2m(i)*100.)
+             ELSE
+                zx_tmp_fi2d(i)=MAX(0.,MIN(100.,rh2m(i)*100.))
+             ENDIF
           ENDDO
        ENDIF
@@ -1438,5 +1526,5 @@
 !       CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d)
 
-       CALL histwrite_phy(o_qsat2m, zqsat2m_cor)
+       CALL histwrite_phy(o_qsat2m, qsat2m)
        CALL histwrite_phy(o_tpot, tpot)
        CALL histwrite_phy(o_tpote, tpote)
@@ -1717,4 +1805,11 @@
        CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d)
        CALL histwrite_phy(o_rhum, zx_rh)
+       IF (iflag_ice_thermo .GT. 0) THEN
+          IF (vars_defined) zx_tmp_fi3d = zx_rhl * 100.
+          CALL histwrite_phy(o_rhl, zx_tmp_fi3d)
+          IF (vars_defined) zx_tmp_fi3d = zx_rhi * 100.
+          CALL histwrite_phy(o_rhi, zx_tmp_fi3d)
+       ENDIF
+
        
        IF (vars_defined) zx_tmp_fi3d = wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd
@@ -1775,6 +1870,6 @@
           ENDIF
           CALL histwrite_phy(o_tke, zx_tmp_fi3d)
-
-          CALL histwrite_phy(o_tke_max, zx_tmp_fi3d)
+          CALL histwrite_phy(o_tke_max, zx_tmp_fi3d)  
+
        ENDIF
 
@@ -2188,5 +2283,4 @@
           CALL histwrite_phy(o_rldcs4co2, lwdn0p)
        ENDIF !ok_4xCO2atm
-        write(*,*) 'phys_output_write 2188'
 !!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!!
 #ifdef CPP_IOIPSL
@@ -2195,5 +2289,4 @@
        ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
        ! Champs interpolles sur des niveaux de pression
-       missing_val=missing_val_nf90
        DO iff=7, nfiles-1 !--OB: here we deal with files 7,8,9
 
@@ -2329,5 +2422,4 @@
   ENDIF
 #endif
-        write(*,*) 'phys_output_write 2331'
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        IF (iflag_phytrac == 1 ) then
@@ -2389,10 +2481,51 @@
            CALL histwrite_phy(o_flx_co2_land,  fco2_land)
            CALL histwrite_phy(o_flx_co2_ocean, fco2_ocean)
+           CALL histwrite_phy(o_flx_co2_ocean_cor, fco2_ocean_cor)
+           CALL histwrite_phy(o_flx_co2_land_cor, fco2_land_cor)
            CALL histwrite_phy(o_flx_co2_ff,    fco2_ff)
            CALL histwrite_phy(o_flx_co2_bb,    fco2_bb)
          ENDIF !--type_trac co2i
 
+         IF (type_trac == 'inco') THEN
+           nqup = nqo+1
+           DO iq=nqo+1, nqup
+             !--3D fields
+             CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
+             CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
+             CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
+             CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
+             !--2D fields
+             !--CO2 burden
+             zx_tmp_fi2d=0.
+             IF (vars_defined) THEN
+                DO k=1,klev
+                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
+                ENDDO
+             ENDIF
+             CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
+           ENDDO !--iq
+           !--CO2 net fluxes
+           CALL histwrite_phy(o_flx_co2_land,  fco2_land)
+           CALL histwrite_phy(o_flx_co2_ocean, fco2_ocean)
+           CALL histwrite_phy(o_flx_co2_ocean_cor, fco2_ocean_cor)
+           CALL histwrite_phy(o_flx_co2_land_cor, fco2_land_cor)
+           CALL histwrite_phy(o_flx_co2_ff,    fco2_ff)
+           CALL histwrite_phy(o_flx_co2_bb,    fco2_bb)
+         ENDIF !--type_trac inco
+
        ENDIF   !(iflag_phytrac==1)
 
+       if (activate_ocean_skin >= 1) then
+          CALL histwrite_phy(o_delta_sst, delta_sst)
+          CALL histwrite_phy(o_delta_sal, delta_sal)
+          CALL histwrite_phy(o_ds_ns, ds_ns)
+          CALL histwrite_phy(o_dt_ns, dt_ns)
+          CALL histwrite_phy(o_dter, dter)
+          CALL histwrite_phy(o_dser, dser)
+          CALL histwrite_phy(o_tkt, tkt)
+          CALL histwrite_phy(o_tks, tks)
+          CALL histwrite_phy(o_taur, taur)
+          CALL histwrite_phy(o_sss, sss)
+       end if
 
 #ifdef ISO
Index: LMDZ6/trunk/libf/phylmdiso/phys_state_var_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phys_state_var_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phys_state_var_mod.F90	(revision 3940)
@@ -1,4 +1,4 @@
 !
-! $Id: phys_state_var_mod.F90 3496 2019-05-10 10:17:35Z jyg $
+! $Id: phys_state_var_mod.F90 3888 2021-05-05 10:50:37Z jyg $
 !
       MODULE phys_state_var_mod
@@ -32,4 +32,6 @@
       REAL, ALLOCATABLE, SAVE :: ftsol(:,:)
 !$OMP THREADPRIVATE(ftsol)
+      REAL, ALLOCATABLE, SAVE :: beta_aridity(:,:)
+!$OMP THREADPRIVATE(beta_aridity)
       REAL,ALLOCATABLE,SAVE :: qsol(:),fevap(:,:),z0m(:,:),z0h(:,:),agesno(:,:)
 !$OMP THREADPRIVATE(qsol,fevap,z0m,z0h,agesno)
@@ -47,5 +49,5 @@
 !albedo SB >>>
       REAL, ALLOCATABLE, SAVE :: falb_dif(:,:,:), falb_dir(:,:,:)
-      real, allocatable, save :: chl_con(:)
+      REAL, ALLOCATABLE, SAVE :: chl_con(:)
 !$OMP THREADPRIVATE(falb_dir,falb_dif,chl_con)
 !albedo SB <<<
@@ -106,8 +108,4 @@
       REAL, ALLOCATABLE, SAVE :: coefm(:,:,:) ! Kz momentum
 !$OMP THREADPRIVATE(pbl_tke, coefh,coefm)
-!nrlmd<
-      REAL, ALLOCATABLE, SAVE :: delta_tsurf(:,:) ! Surface temperature difference inside-outside cold pool
-!$OMP THREADPRIVATE(delta_tsurf)
-!>nrlmd
       REAL, ALLOCATABLE, SAVE :: zmax0(:), f0(:) ! 
 !$OMP THREADPRIVATE(zmax0,f0)
@@ -294,4 +292,8 @@
       REAL,ALLOCATABLE,SAVE :: wake_delta_pbl_TKE(:,:,:)
 !$OMP THREADPRIVATE(wake_delta_pbl_TKE)
+!nrlmd<
+      REAL, ALLOCATABLE, SAVE :: delta_tsurf(:,:) ! Surface temperature difference inside-outside cold pool
+!$OMP THREADPRIVATE(delta_tsurf)
+!>nrlmd
 !>jyg
 !
@@ -442,8 +444,9 @@
 !$OMP THREADPRIVATE(ccm)
 
-!!! nrlmd le 10/04/2012
       REAL,SAVE,ALLOCATABLE :: ale_bl_trig(:)
 !$OMP THREADPRIVATE(ale_bl_trig)
-!!! fin nrlmd le 10/04/2012
+
+      REAL,SAVE,ALLOCATABLE :: ratqs_inter(:,:)
+!$OMP THREADPRIVATE(ratqs_inter)
 
 #ifdef ISO
@@ -462,5 +465,26 @@
 !$OMP THREADPRIVATE(is_initialized)    
 
-CONTAINS
+      ! Ocean-atmosphere interface:
+
+      REAL, ALLOCATABLE, SAVE:: ds_ns(:) ! (klon)
+      ! "delta salinity near surface". Salinity variation in the
+      ! near-surface turbulent layer. That is subskin salinity minus
+      ! foundation salinity. In ppt.
+
+      REAL, ALLOCATABLE, SAVE:: dt_ns(:) ! (klon)
+      ! "delta temperature near surface". Temperature variation in the
+      ! near-surface turbulent layer. That is subskin temperature
+      ! minus foundation temperature. (Can be negative.) In K.
+      
+      REAL, ALLOCATABLE, SAVE:: delta_sst(:) ! (klon)
+      ! Ocean-air interface temperature minus bulk SST, in
+      ! K. Allocated and defined only if activate_ocean_skin >= 1.
+
+      REAL, ALLOCATABLE, SAVE:: delta_sal(:) ! (klon)
+      ! Ocean-air interface salinity minus bulk salinity, in ppt
+      
+      !$OMP THREADPRIVATE(delta_sal, ds_ns, dt_ns, delta_sst)
+
+    CONTAINS
 
 !======================================================================
@@ -473,4 +497,5 @@
 #endif
 USE indice_sol_mod
+use config_ocean_skin_m, only: activate_ocean_skin
 IMPLICIT NONE
 
@@ -485,8 +510,10 @@
 include "clesphys.h"
 
+      print*, 'is_initialized', is_initialized
       IF (is_initialized) RETURN
       is_initialized=.TRUE.
       ALLOCATE(pctsrf(klon,nbsrf))
       ALLOCATE(ftsol(klon,nbsrf))
+      ALLOCATE(beta_aridity(klon,nbsrf))
       ALLOCATE(qsol(klon),fevap(klon,nbsrf))
       ALLOCATE(z0m(klon,nbsrf+1),z0h(klon,nbsrf+1),agesno(klon,nbsrf))
@@ -496,5 +523,7 @@
       ALLOCATE(falb2(klon,nbsrf))
 !albedo SB >>> 
+      print*, 'allocate falb'
       ALLOCATE(falb_dir(klon,nsw,nbsrf),falb_dif(klon,nsw,nbsrf))
+      print*, 'allocate falb good', falb_dir(1,1,1)
       ALLOCATE(chl_con(klon))
 !albedo SB <<<
@@ -675,9 +704,9 @@
 #endif      
 #endif
-!!! nrlmd le 10/04/2012
+
       ALLOCATE(ale_bl_trig(klon))
-!!! fin nrlmd le 10/04/2012
+      ALLOCATE(ratqs_inter(klon,klev))
       IF (ok_gwd_rando) THEN
-        allocate(du_gwd_rando(klon, klev))
+        ALLOCATE(du_gwd_rando(klon, klev))
         du_gwd_rando(:,:)=0.
       ENDIF
@@ -686,147 +715,155 @@
         du_gwd_front(:,:) = 0 !ym missing init   
       ENDIF
-END SUBROUTINE phys_state_var_init
+      if (activate_ocean_skin >= 1) ALLOCATE(delta_sal(klon), ds_ns(klon), &
+           dt_ns(klon), delta_sst(klon))
+
+    END SUBROUTINE phys_state_var_init
 
 !======================================================================
-SUBROUTINE phys_state_var_end
+    SUBROUTINE phys_state_var_end
+      ! Useful only for lmdz1d.
 !USE dimphy
 USE indice_sol_mod
+use config_ocean_skin_m, only: activate_ocean_skin
 IMPLICIT NONE
 include "clesphys.h"
 
-      deallocate(pctsrf, ftsol, falb1, falb2)
-      deallocate(qsol,fevap,z0m,z0h,agesno)
+      DEALLOCATE(pctsrf, ftsol, falb1, falb2)
+      DEALLOCATE(beta_aridity)
+      DEALLOCATE(qsol,fevap,z0m,z0h,agesno)
 !FC
-      deallocate(treedrg)
-      deallocate(rain_fall, snow_fall, solsw, solswfdiff, sollw, radsol, swradcorr)
-      deallocate(zmea, zstd, zsig, zgam)
-      deallocate(zthe, zpic, zval)
-      deallocate(rugoro, t_ancien, q_ancien, clwcon, rnebcon)
-      deallocate(qs_ancien, ql_ancien)
-      deallocate(prw_ancien, prlw_ancien, prsw_ancien)
-      deallocate(qtc_cv,sigt_cv)
-      deallocate(u_ancien, v_ancien)
-      deallocate(tr_ancien)                           !RomP
-      deallocate(ratqs, pbl_tke,coefh,coefm)
+      DEALLOCATE(treedrg)
+      DEALLOCATE(rain_fall, snow_fall, solsw, solswfdiff, sollw, radsol, swradcorr)
+      DEALLOCATE(zmea, zstd, zsig, zgam)
+      DEALLOCATE(zthe, zpic, zval)
+      DEALLOCATE(rugoro, t_ancien, q_ancien, clwcon, rnebcon)
+      DEALLOCATE(qs_ancien, ql_ancien)
+      DEALLOCATE(prw_ancien, prlw_ancien, prsw_ancien)
+      DEALLOCATE(qtc_cv,sigt_cv)
+      DEALLOCATE(u_ancien, v_ancien)
+      DEALLOCATE(tr_ancien)                           !RomP
+      DEALLOCATE(ratqs, pbl_tke,coefh,coefm)
+      DEALLOCATE(zmax0, f0)
+      DEALLOCATE(sig1, w01)
+      DEALLOCATE(entr_therm, fm_therm)
+      DEALLOCATE(detr_therm)
+      DEALLOCATE(clwcon0th, rnebcon0th)
+! radiation outputs
+      DEALLOCATE(swdnc0, swdn0, swdn)
+      DEALLOCATE(swupc0, swup0, swup)
+      DEALLOCATE(lwdnc0, lwdn0, lwdn)
+      DEALLOCATE(lwupc0, lwup0, lwup)
+      DEALLOCATE(SWdn200clr, SWdn200)
+      DEALLOCATE(SWup200clr, SWup200)
+      DEALLOCATE(LWdn200clr, LWdn200)
+      DEALLOCATE(LWup200clr, LWup200)
+      DEALLOCATE(LWdnTOA, LWdnTOAclr)
+! pressure level
+      DEALLOCATE(tsumSTD)
+      DEALLOCATE(usumSTD, vsumSTD)
+      DEALLOCATE(wsumSTD, phisumSTD)
+      DEALLOCATE(tnondef)
+      DEALLOCATE(qsumSTD, rhsumSTD)
+      DEALLOCATE(uvsumSTD)
+      DEALLOCATE(vqsumSTD)
+      DEALLOCATE(vTsumSTD)
+      DEALLOCATE(wqsumSTD)
+      DEALLOCATE(vphisumSTD)
+      DEALLOCATE(wTsumSTD)
+      DEALLOCATE(u2sumSTD)
+      DEALLOCATE(v2sumSTD)
+      DEALLOCATE(T2sumSTD)
+      DEALLOCATE(O3sumSTD)
+      DEALLOCATE(O3daysumSTD)
+!IM beg
+      DEALLOCATE(wlevSTD,ulevSTD,vlevSTD,tlevSTD,qlevSTD,rhlevSTD,philevSTD)
+      DEALLOCATE(uvSTD,vqSTD,vTSTD,wqSTD,vphiSTD,wTSTD,u2STD,v2STD,T2STD,O3STD,O3daySTD)
+!IM end
+      DEALLOCATE(seed_old)
+      DEALLOCATE(zuthe, zvthe)
+      DEALLOCATE(alb_neig)
+      DEALLOCATE(ema_cbmf)
+      DEALLOCATE(ema_pcb, ema_pct)
+      DEALLOCATE(Mipsh, Ma, qcondc)
+      DEALLOCATE(wd, sigd)
+      DEALLOCATE(cin, ALE, ALP)
+      DEALLOCATE(ftd, fqd)
+      DEALLOCATE(Ale_bl, Alp_bl)
+      DEALLOCATE(ale_wake)
+      DEALLOCATE(ale_bl_stat)
+      DEALLOCATE(lalim_conv, wght_th)
+      DEALLOCATE(wake_deltat, wake_deltaq)
+      DEALLOCATE(wake_s, awake_dens, wake_dens)
+      DEALLOCATE(wake_Cstar, wake_pe, wake_fip)
+!jyg<
+      DEALLOCATE(wake_delta_pbl_TKE)
 !nrlmd<
-      deallocate(delta_tsurf)
+      DEALLOCATE(delta_tsurf)
 !>nrlmd
-      deallocate(zmax0, f0)
-      deallocate(sig1, w01)
-      deallocate(entr_therm, fm_therm)
-      deallocate(detr_therm)
-      deallocate(clwcon0th, rnebcon0th)
-! radiation outputs
-      deallocate(swdnc0, swdn0, swdn)
-      deallocate(swupc0, swup0, swup)
-      deallocate(lwdnc0, lwdn0, lwdn)
-      deallocate(lwupc0, lwup0, lwup)
-      deallocate(SWdn200clr, SWdn200)
-      deallocate(SWup200clr, SWup200)
-      deallocate(LWdn200clr, LWdn200)
-      deallocate(LWup200clr, LWup200)
-      deallocate(LWdnTOA, LWdnTOAclr)
-! pressure level
-      deallocate(tsumSTD)
-      deallocate(usumSTD, vsumSTD)
-      deallocate(wsumSTD, phisumSTD)
-      deallocate(tnondef)
-      deallocate(qsumSTD, rhsumSTD)
-      deallocate(uvsumSTD)
-      deallocate(vqsumSTD)
-      deallocate(vTsumSTD)
-      deallocate(wqsumSTD)
-      deallocate(vphisumSTD)
-      deallocate(wTsumSTD)
-      deallocate(u2sumSTD)
-      deallocate(v2sumSTD)
-      deallocate(T2sumSTD)
-      deallocate(O3sumSTD)
-      deallocate(O3daysumSTD)
-!IM beg
-      deallocate(wlevSTD,ulevSTD,vlevSTD,tlevSTD,qlevSTD,rhlevSTD,philevSTD)
-      deallocate(uvSTD,vqSTD,vTSTD,wqSTD,vphiSTD,wTSTD,u2STD,v2STD,T2STD,O3STD,O3daySTD)
-!IM end
-      deallocate(seed_old)
-      deallocate(zuthe, zvthe)
-      deallocate(alb_neig)
-      deallocate(ema_cbmf)
-      deallocate(ema_pcb, ema_pct)
-      deallocate(Mipsh, Ma, qcondc)
-      deallocate(wd, sigd)
-      deallocate(cin, ALE, ALP)
-      deallocate(ftd, fqd)
-      deallocate(Ale_bl, Alp_bl)
-      deallocate(ale_wake)
-      deallocate(ale_bl_stat)
-      deallocate(lalim_conv, wght_th)
-      deallocate(wake_deltat, wake_deltaq)
-      deallocate(wake_s, awake_dens, wake_dens)
-      deallocate(wake_Cstar, wake_pe, wake_fip)
-!jyg<
-      deallocate(wake_delta_pbl_TKE)
 !>jyg
-      deallocate(pfrac_impa, pfrac_nucl)
-      deallocate(pfrac_1nucl)
-      deallocate(total_rain, nday_rain)
-      deallocate(paire_ter)
-      deallocate(albsol1, albsol2)
+      DEALLOCATE(pfrac_impa, pfrac_nucl)
+      DEALLOCATE(pfrac_1nucl)
+      DEALLOCATE(total_rain, nday_rain)
+      DEALLOCATE(paire_ter)
+      DEALLOCATE(albsol1, albsol2)
 !albedo SB >>>
-      deallocate(albsol_dir,albsol_dif,falb_dir,falb_dif,chl_con)
+      DEALLOCATE(albsol_dir,albsol_dif,falb_dir,falb_dif,chl_con)
 !albedo SB <<<
-      deallocate(wo)
-      deallocate(clwcon0,rnebcon0)
-      deallocate(heat, heat0) 
-      deallocate(cool, cool0)
-      deallocate(heat_volc, cool_volc) 
-      deallocate(topsw, toplw)
-      deallocate(sollwdown, sollwdownclr)
-      deallocate(gustiness)
-      deallocate(toplwdown, toplwdownclr)
-      deallocate(topsw0,toplw0,solsw0,sollw0)
-      deallocate(albpla)
+      DEALLOCATE(wo)
+      DEALLOCATE(clwcon0,rnebcon0)
+      DEALLOCATE(heat, heat0) 
+      DEALLOCATE(cool, cool0)
+      DEALLOCATE(heat_volc, cool_volc) 
+      DEALLOCATE(topsw, toplw)
+      DEALLOCATE(sollwdown, sollwdownclr)
+      DEALLOCATE(gustiness)
+      DEALLOCATE(toplwdown, toplwdownclr)
+      DEALLOCATE(topsw0,toplw0,solsw0,sollw0)
+      DEALLOCATE(albpla)
 !IM ajout variables CFMIP2/CMIP5
-      deallocate(heatp, coolp)
-      deallocate(heat0p, cool0p)
-      deallocate(radsolp, topswp, toplwp)
-      deallocate(albplap)
-      deallocate(solswp, solswfdiffp, sollwp)
-      deallocate(sollwdownp)
-      deallocate(topsw0p,toplw0p)
-      deallocate(solsw0p,sollw0p)
-      deallocate(lwdnc0p, lwdn0p, lwdnp)
-      deallocate(lwupc0p, lwup0p, lwupp)
-      deallocate(swdnc0p, swdn0p, swdnp)
-      deallocate(swupc0p, swup0p, swupp)
-      deallocate(cape)
-      deallocate(pbase,bbase)
-      deallocate(zqasc)
-      deallocate(ibas_con, itop_con)
-      deallocate(rain_con, snow_con)
-      deallocate(rlonPOS)
-      deallocate(newsst)
-      deallocate(ustar,u10m, v10m,wstar)
-      deallocate(topswad, solswad)
-      deallocate(topswai, solswai)
-      deallocate(tau_aero,piz_aero,cg_aero)
-      deallocate(tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
-      deallocate(tau_aero_lw_rrtm,piz_aero_lw_rrtm,cg_aero_lw_rrtm)
-      deallocate(ccm)
-      if (ok_gwd_rando) deallocate(du_gwd_rando)
-      if (.not. ok_hines .and. ok_gwd_rando) deallocate(du_gwd_front)
-       
-!!! nrlmd le 10/04/2012
-      deallocate(ale_bl_trig)
-!!! fin nrlmd le 10/04/2012
+      DEALLOCATE(heatp, coolp)
+      DEALLOCATE(heat0p, cool0p)
+      DEALLOCATE(radsolp, topswp, toplwp)
+      DEALLOCATE(albplap)
+      DEALLOCATE(solswp, solswfdiffp, sollwp)
+      DEALLOCATE(sollwdownp)
+      DEALLOCATE(topsw0p,toplw0p)
+      DEALLOCATE(solsw0p,sollw0p)
+      DEALLOCATE(lwdnc0p, lwdn0p, lwdnp)
+      DEALLOCATE(lwupc0p, lwup0p, lwupp)
+      DEALLOCATE(swdnc0p, swdn0p, swdnp)
+      DEALLOCATE(swupc0p, swup0p, swupp)
+      DEALLOCATE(cape)
+      DEALLOCATE(pbase,bbase)
+      DEALLOCATE(zqasc)
+      DEALLOCATE(ibas_con, itop_con)
+      DEALLOCATE(rain_con, snow_con)
+      DEALLOCATE(rlonPOS)
+      DEALLOCATE(newsst)
+      DEALLOCATE(ustar,u10m, v10m,wstar)
+      DEALLOCATE(topswad, solswad)
+      DEALLOCATE(topswai, solswai)
+      DEALLOCATE(tau_aero,piz_aero,cg_aero)
+      DEALLOCATE(tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
+      DEALLOCATE(tau_aero_lw_rrtm,piz_aero_lw_rrtm,cg_aero_lw_rrtm)
+      DEALLOCATE(ccm)
+      if (ok_gwd_rando) DEALLOCATE(du_gwd_rando)
+      if (.not. ok_hines .and. ok_gwd_rando) DEALLOCATE(du_gwd_front)
+      DEALLOCATE(ale_bl_trig)
+      DEALLOCATE(ratqs_inter)
+
+      if (activate_ocean_skin >= 1) deALLOCATE(delta_sal, ds_ns, dt_ns, &
+           delta_sst)
 
 #ifdef ISO    
-      deallocate(xtsol,fxtevap)  
-      deallocate(xt_ancien,xtl_ancien,xts_ancien, fxtd, wake_deltaxt)
-      deallocate(xtrain_fall, xtsnow_fall, xtrain_con, xtsnow_con)
+      DEALLOCATE(xtsol,fxtevap)  
+      DEALLOCATE(xt_ancien,xtl_ancien,xts_ancien, fxtd, wake_deltaxt)
+      DEALLOCATE(xtrain_fall, xtsnow_fall, xtrain_con, xtsnow_con)
 #ifdef ISOTRAC 
-      deallocate(bassin_map,boite_map) 
+      DEALLOCATE(bassin_map,boite_map) 
 #endif        
 #endif
       is_initialized=.FALSE.
+      
 END SUBROUTINE phys_state_var_end
 
Index: LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90	(revision 3940)
@@ -1,4 +1,4 @@
 !
-! $Id: physiq_mod.F90 3666 2020-04-20 10:13:34Z lfalletti $
+! $Id: physiq_mod.F90 3908 2021-05-20 07:11:13Z idelkadi $
 !
 !#define IO_DEBUG
@@ -16,14 +16,108 @@
        d_u, d_v, d_t, d_qx, d_ps)
 
+! For clarity, the "USE" section is now arranged in alphabetical order,
+! with a separate section for CPP keys
+! PLEASE try to follow this rule 
+
+    USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
+    USE aero_mod
+    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
+  &      fl_ebil, fl_cor_ebil
     USE assert_m, only: assert
+    USE change_srf_frac_mod
+    USE conf_phys_m, only: conf_phys
+    USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
+    USE CFMIP_point_locations   ! IM stations CFMIP
+    USE cmp_seri_mod
+    USE dimphy
+    USE etat0_limit_unstruct_mod
+    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
+    USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
+    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
     USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
          histwrite, ju2ymds, ymds2ju, getin
-    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
+    USE ioipsl_getin_p_mod, ONLY : getin_p
+    USE indice_sol_mod
+    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac,ok_isotopes, &
+        nqtottr,itr_indice ! C Risi
+
+    USE iophy
+    USE limit_read_mod, ONLY : init_limit_read
+    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
+    USE mod_phys_lmdz_mpi_data, only: is_mpi_root
+    USE mod_phys_lmdz_para
+    USE netcdf95, only: nf95_close
+    USE netcdf, only: nf90_fill_real     ! IM for NMC files
+    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
+    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
+    USE pbl_surface_mod, ONLY : pbl_surface
+    USE phyaqua_mod, only: zenang_an
+    USE phystokenc_mod, ONLY: offline, phystokenc
     USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
          year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour
+!!  USE phys_local_var_mod, ONLY : a long list of variables
+!!              ==> see below, after "CPP Keys" section
+    USE phys_state_var_mod ! Variables sauvegardees de la physique
+    USE phys_output_mod
+    USE phys_output_ctrlout_mod
+    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
+    USE readaerosol_mod, ONLY : init_aero_fromfile
+    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
+    USE radlwsw_m, only: radlwsw
+    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
+    USE regr_pr_time_av_m, only: regr_pr_time_av
+    USE surface_data,     ONLY : type_ocean, ok_veget, landice_opt
+    USE time_phylmdz_mod, only: annee_ref, current_time, day_ini, day_ref, &
+          day_step_phy, itau_phy, pdtphys, raz_date, start_time, update_time
+    USE tracinca_mod, ONLY: config_inca
+    USE tropopause_m,     ONLY: dyn_tropopause
+    USE vampir
+    USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
     USE write_field_phy
-    USE dimphy
-USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac,ok_isotopes, &
-        nqtottr,itr_indice ! C Risi
+
+    !USE cmp_seri_mod
+!    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
+!  &      fl_ebil, fl_cor_ebil
+
+!!!!!!!!!!!!!!!!!! "USE" section for CPP keys !!!!!!!!!!!!!!!!!!!!!!!!
+!
+!
+#ifdef CPP_Dust
+    USE phytracr_spl_mod, ONLY: phytracr_spl, phytracr_spl_out_init
+    USE phys_output_write_spl_mod
+#else
+    USE phytrac_mod, ONLY : phytrac_init, phytrac
+    USE phys_output_write_mod
+#endif
+
+
+#ifdef REPROBUS
+    USE CHEM_REP, ONLY : Init_chem_rep_xjour, &
+         d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, &
+         ztrop, gravit,itroprep, Z1,Z2,fac,B
+#endif
+
+
+#ifdef CPP_RRTM
+    USE YOERAD, ONLY : NRADLP
+    USE YOESW, ONLY : RSUN
+#endif
+
+
+#ifdef CPP_StratAer
+    USE strataer_mod, ONLY: strataer_init
+#endif
+
+
+#ifdef CPP_XIOS
+    USE xios, ONLY: xios_update_calendar, xios_context_finalize, &
+            xios_get_field_attr, xios_field_is_active
+    USE wxios, ONLY: missing_val, missing_val_omp
+#endif
+#ifndef CPP_XIOS
+    USE paramLMDZ_phy_mod
+#endif
+
+
 #ifdef ISO
     USE infotrac_phy, ONLY:  &
@@ -64,22 +158,10 @@
 #endif
 #endif
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
-    USE mod_phys_lmdz_para
-    USE iophy
-    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
-    USE phystokenc_mod, ONLY: offline, phystokenc
-    USE time_phylmdz_mod, only: raz_date, day_step_phy, update_time,current_time
-    USE vampir
-    USE pbl_surface_mod, ONLY : pbl_surface
-    USE change_srf_frac_mod
-    USE surface_data,     ONLY : type_ocean, ok_veget, ok_snow
-    USE tropopause_m,     ONLY: dyn_tropopause
-#ifdef CPP_Dust
-    USE phytracr_spl_mod, ONLY: phytracr_spl
-#endif
-#ifdef CPP_StratAer
-    USE strataer_mod, ONLY: strataer_init
-#endif
-    USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
+
+!
+!
+!!!!!!!!!!!!!!!!!!  END "USE" for CPP keys !!!!!!!!!!!!!!!!!!!!!!
+
+USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
        ! [Variables internes non sauvegardees de la physique]
        ! Variables locales pour effectuer les appels en serie
@@ -160,7 +242,5 @@
        cdragm, cdragh,                   &
        zustar, zu10m, zv10m, rh2m, qsat2m, &
-       zq2m, zt2m, weak_inversion, &
-       zq2m_cor,zt2m_cor,zu10m_cor,zv10m_cor, & ! pour corriger d'un bug
-       zrh2m_cor,zqsat2m_cor, &
+       zq2m, zt2m, zn2mout, weak_inversion, &
        zt2m_min_mon, zt2m_max_mon,   &         ! pour calcul_divers.h
        t2m_min_mon, t2m_max_mon,  &            ! pour calcul_divers.h
@@ -175,4 +255,5 @@
        zxrunofflic,                            &
        zxtsol, snow_lsc, zxfqfonte, zxqsurf,   &
+       delta_qsurf,                            &
        rain_lsc, rain_num,                     &
        !
@@ -236,5 +317,5 @@
        ref_liq, ref_ice, theta,  &
        ref_liq_pi, ref_ice_pi,  &
-       zphi, zx_rh,  &
+       zphi, zx_rh, zx_rhl, zx_rhi,  &
        pmfd, pmfu,  &
        !
@@ -284,69 +365,5 @@
 #endif
        !
-    USE phys_state_var_mod ! Variables sauvegardees de la physique
-#ifdef CPP_Dust
-    USE phys_output_write_spl_mod
-#else
-    USE phys_output_var_mod ! Variables pour les ecritures des sorties
-#endif
-
-    USE phys_output_write_mod
-    USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
-    USE phys_output_mod
-    USE phys_output_ctrlout_mod
-    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
-    USE regr_pr_time_av_m, only: regr_pr_time_av
-    USE netcdf95, only: nf95_close
-    !IM for NMC files
-    USE netcdf, only: nf90_fill_real
-    USE mod_phys_lmdz_mpi_data, only: is_mpi_root
-    USE aero_mod
-    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
-    USE conf_phys_m, only: conf_phys
-    USE radlwsw_m, only: radlwsw
-    USE phyaqua_mod, only: zenang_an
-    USE time_phylmdz_mod, only: day_step_phy, annee_ref, day_ref, itau_phy, &
-         start_time, pdtphys, day_ini
-    USE tracinca_mod, ONLY: config_inca
-#ifdef CPP_XIOS
-    USE wxios, ONLY: missing_val, missing_val_omp
-    USE xios, ONLY: xios_get_field_attr, xios_field_is_active
-#endif
-#ifdef REPROBUS
-    USE CHEM_REP, ONLY : Init_chem_rep_xjour, &
-         d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, &
-         ztrop, gravit,itroprep, Z1,Z2,fac,B
-#endif
-    USE indice_sol_mod
-    USE phytrac_mod, ONLY : phytrac_init, phytrac
-    USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
-
-#ifdef CPP_RRTM
-    USE YOERAD, ONLY : NRADLP
-    USE YOESW, ONLY : RSUN
-#endif
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-
-#ifndef CPP_XIOS
-    USE paramLMDZ_phy_mod
-#endif
-
-    USE cmp_seri_mod
-    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
-  &      fl_ebil, fl_cor_ebil
-
-    !IM stations CFMIP
-    USE CFMIP_point_locations
-    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
-    USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
-    USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
-    USE etat0_limit_unstruct_mod
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_update_calendar, xios_context_finalize
-#endif
-    USE limit_read_mod, ONLY : init_limit_read
-    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
-    USE readaerosol_mod, ONLY : init_aero_fromfile
-    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
+
 
     IMPLICIT NONE
@@ -671,9 +688,4 @@
     !$OMP THREADPRIVATE(iflag_alp_wk_cond)
 
-    INTEGER,  SAVE               :: iflag_bug_t2m_ipslcm61=1 !
-    !$OMP THREADPRIVATE(iflag_bug_t2m_ipslcm61)
-    INTEGER,  SAVE               :: iflag_bug_t2m_stab_ipslcm61=-1 !
-    !$OMP THREADPRIVATE(iflag_bug_t2m_stab_ipslcm61)
-
     REAL t_w(klon,klev),q_w(klon,klev) ! temperature and moisture profiles in the wake region
     REAL t_x(klon,klev),q_x(klon,klev) ! temperature and moisture profiles in the off-wake region
@@ -1419,9 +1431,4 @@
        WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl
 
-       iflag_bug_t2m_ipslcm61 = 1
-       CALL getin_p('iflag_bug_t2m_ipslcm61', iflag_bug_t2m_ipslcm61)
-       iflag_bug_t2m_stab_ipslcm61 = -1
-       CALL getin_p('iflag_bug_t2m_stab_ipslcm61', iflag_bug_t2m_stab_ipslcm61)
-
        CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond) 
        CALL getin_p('random_notrig_max',random_notrig_max)
@@ -1451,4 +1458,10 @@
        iflag_phytrac = 1 ! by default we do want to call phytrac
        CALL getin_p('iflag_phytrac',iflag_phytrac)
+#ifdef CPP_Dust
+       IF (iflag_phytrac.EQ.0) THEN 
+         WRITE(lunout,*) 'In order to run with SPLA, iflag_phytrac will be forced to 1'
+         iflag_phytrac = 1
+       ENDIF
+#endif
        nvm_lmdz = 13
        CALL getin_p('NVM',nvm_lmdz)
@@ -1508,5 +1521,5 @@
        tau_overturning_th(:)=0.
 
-       IF (type_trac == 'inca') THEN
+       IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
           ! jg : initialisation jusqu'au ces variables sont dans restart
           ccm(:,:,:) = 0.
@@ -1763,9 +1776,9 @@
 #ifdef CPP_COSP
       IF (ok_cosp) THEN
-           DO k = 1, klev
-             DO i = 1, klon
-               phicosp(i,k) = pphi(i,k) + pphis(i)
-             ENDDO
-           ENDDO
+!           DO k = 1, klev
+!             DO i = 1, klon
+!               phicosp(i,k) = pphi(i,k) + pphis(i)
+!             ENDDO
+!           ENDDO
         CALL phys_cosp(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
@@ -1785,9 +1798,9 @@
 #ifdef CPP_COSP2
         IF (ok_cosp) THEN
-           DO k = 1, klev
-             DO i = 1, klon
-               phicosp(i,k) = pphi(i,k) + pphis(i)
-             ENDDO
-           ENDDO
+!           DO k = 1, klev
+!             DO i = 1, klon
+!               phicosp(i,k) = pphi(i,k) + pphis(i)
+!             ENDDO
+!           ENDDO
           CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
@@ -1835,9 +1848,21 @@
 
        CALL iniradia(klon,klev,paprs(1,1:klev+1))
-       ! Initialisation des champs dans phytrac qui sont utilisés par phys_output_write
+
+       ! Initialisation des champs dans phytrac* qui sont utilisés par phys_output_write*
+#ifdef CPP_Dust
+       ! Quand on utilise SPLA, on force iflag_phytrac=1
+       CALL phytracr_spl_out_init()
+       CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,                  &
+                                pplay, lmax_th, aerosol_couple,                 &
+                                ok_ade, ok_aie, ivap, ok_sync,                  &
+                                ptconv, read_climoz, clevSTD,                   &
+                                ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse,      &
+                                flag_aerosol, flag_aerosol_strat, ok_cdnc)
+#else
+       ! phys_output_write écrit des variables traceurs seulement si iflag_phytrac == 1 
+       ! donc seulement dans ce cas on doit appeler phytrac_init()
        IF (iflag_phytrac == 1 ) THEN
           CALL phytrac_init()
-        ENDIF
-
+       ENDIF
        CALL phys_output_write(itap, pdtphys, paprs, pphis,                    &
                               pplay, lmax_th, aerosol_couple,                 &
@@ -1846,4 +1871,6 @@
                               ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
                               flag_aerosol, flag_aerosol_strat, ok_cdnc)
+#endif
+
 
 #ifdef CPP_XIOS
@@ -2070,5 +2097,5 @@
        !c         ENDDO
        !
-       IF (type_trac == 'inca') THEN
+       IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN			! ModThL
 #ifdef INCA
           CALL VTe(VTphysiq)
@@ -2087,5 +2114,5 @@
                klon, &
                nqtot, &
-               nqo, &
+               nqo+nqCO2, &
                pdtphys, &
                annee_ref, &
@@ -2840,5 +2867,6 @@
     !   s_therm,   s_trmb1,   s_trmb2, s_trmb3,
     !   zu10m,     zv10m,   fder,
-    !   zxqsurf,   rh2m,      zxfluxu, zxfluxv,
+    !   zxqsurf,   delta_qsurf,
+    !   rh2m,      zxfluxu, zxfluxv,
     !   frugs,     agesno,    fsollw,  fsolsw,
     !   d_ts,      fevap,     fluxlat, t2m,
@@ -2890,6 +2918,6 @@
             debut,     lafin, &
             longitude_deg, latitude_deg, rugoro,  zrmu0,      &
-            zsig,      sollwdown, pphi,    cldt,      &
-            rain_fall, snow_fall, solsw,   sollw,     &
+            sollwdown,    cldt,      &
+            rain_fall, snow_fall, solsw,   solswfdiff, sollw,     &
             gustiness,                                &
             t_seri,    q_seri,    u_seri,  v_seri,    &
@@ -2901,4 +2929,5 @@
                                 !albedo SB <<<
             cdragh,    cdragm,  u1,    v1,            &
+            beta_aridity, &
                                 !albedo SB >>>
                                 ! albsol1,   albsol2,   sens,    evap,      &
@@ -2906,5 +2935,5 @@
                                 !albedo SB <<<
             albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
-            zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
+            zxtsol,    zxfluxlat, zt2m,    qsat2m,  zn2mout, &
             d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
                                 !nrlmd<
@@ -2927,5 +2956,5 @@
             s_therm,   s_trmb1,   s_trmb2, s_trmb3, &
             zustar, zu10m,     zv10m,   fder, &
-            zxqsurf,   rh2m,      zxfluxu, zxfluxv, &
+            zxqsurf, delta_qsurf,   rh2m,      zxfluxu, zxfluxv, &
             z0m, z0h,     agesno,    fsollw,  fsolsw, &
             d_ts,      fevap,     fluxlat, t2m, &
@@ -3041,21 +3070,4 @@
 #endif
        ENDIF
-
-!add limitation for t,q at and wind at 10m
-        if ( iflag_bug_t2m_ipslcm61 == 0 ) THEN
-          CALL borne_var_surf( klon,klev,nbsrf,                 &
-            iflag_bug_t2m_stab_ipslcm61,                        &
-            t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),    &
-            ftsol,zxqsurf,pctsrf,paprs,                         &
-            t2m, q2m, u10m, v10m,                               &
-            zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor,           &
-            zrh2m_cor, zqsat2m_cor)
-        ELSE
-          zt2m_cor(:)=zt2m(:)
-          zq2m_cor(:)=zq2m(:)
-          zu10m_cor(:)=zu10m(:)
-          zv10m_cor(:)=zv10m(:)
-          zqsat2m_cor=999.999
-        ENDIF
 
        !---------------------------------------------------------------------
@@ -3977,5 +3989,5 @@
              ENDDO
           ENDIF
-        
+         
 #ifdef ISOVERIF
         write(*,*) 'physiq 3977: verif des inputs de calwake'
@@ -4312,5 +4324,4 @@
           !
           ENDIF  ! (mod(iflag_pbl_split/10,10) .GE. 1)
-
           !
           CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs,  &
@@ -4456,9 +4467,8 @@
          iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
          ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
-         tau_ratqs,fact_cldcon,   &
+         tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
          ptconv,ptconvth,clwcon0th, rnebcon0th,     &
          paprs,pplay,q_seri,zqsat,fm_therm, &
-         ratqs,ratqsc)
-
+         ratqs,ratqsc,ratqs_inter)
 
     !
@@ -5013,4 +5023,8 @@
           ENDIF
           zx_rh(i,k) = q_seri(i,k)/zx_qs
+            IF (iflag_ice_thermo .GT. 0) THEN
+          zx_rhl(i,k) = q_seri(i,k)/(qsatl(zx_t)/pplay(i,k))
+          zx_rhi(i,k) = q_seri(i,k)/(qsats(zx_t)/pplay(i,k))
+            ENDIF
           zqsat(i,k)=zx_qs
        ENDDO
@@ -5039,5 +5053,5 @@
     ENDDO
 
-    IF (type_trac == 'inca') THEN
+    IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN	! ModThL
 #ifdef INCA
        CALL VTe(VTphysiq)
@@ -5082,5 +5096,5 @@
             nbp_lon, &
             nbp_lat-1, &
-            tr_seri, &
+            tr_seri(:,:,1+nqCO2:nbtr), &
             ftsol, &
             paprs, &
@@ -5093,6 +5107,6 @@
        CALL VTe(VTinca)
        CALL VTb(VTphysiq)
-#endif 
-    ENDIF !type_trac = inca
+#endif
+    ENDIF !type_trac = inca or inco
     IF (type_trac == 'repr') THEN
 #ifdef REPROBUS
@@ -5265,5 +5279,6 @@
 
        IF (ok_newmicro) then
-          IF (iflag_rrtm.NE.0) THEN 
+! AI          IF (iflag_rrtm.NE.0) THEN 
+          IF (iflag_rrtm.EQ.1) THEN
 #ifdef CPP_RRTM
              IF (ok_cdnc.AND.NRADLP.NE.3) THEN
@@ -5452,5 +5467,5 @@
                heat,heat0,cool,cool0,albpla, &
                heat_volc,cool_volc, &
-               topsw,toplw,solsw,sollw, &
+               topsw,toplw,solsw,solswfdiff,sollw, &
                sollwdown, &
                topsw0,toplw0,solsw0,sollw0, &
@@ -5539,5 +5554,5 @@
                      heatp,heat0p,coolp,cool0p,albplap, &
                      heat_volc,cool_volc, &
-                     topswp,toplwp,solswp,sollwp, &
+                     topswp,toplwp,solswp,solswfdiffp,sollwp, &
                      sollwdownp, &
                      topsw0p,toplw0p,solsw0p,sollw0p, &
@@ -5976,5 +5991,8 @@
 
     CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pctsrf,pbl_tke)
-
+   !
+   ! Prevent pbl_tke_w from becoming negative
+    wake_delta_pbl_tke(:,:,:) = max(wake_delta_pbl_tke(:,:,:), -pbl_tke(:,:,:))
+   !
 
        ENDIF
@@ -6090,8 +6108,14 @@
 #ifdef CPP_COSPV2
        IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+!        IF (MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
           IF (prt_level .GE.10) THEN
              print*,'freq_cosp',freq_cosp
           ENDIF
+           DO k = 1, klev
+             DO i = 1, klon
+               phicosp(i,k) = pphi(i,k) + pphis(i)
+             ENDDO
+           ENDDO
           mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
                  print*,'Dans physiq.F avant appel '
@@ -6194,11 +6218,14 @@
     ELSE
        sh_in(:,:) = qx(:,:,ivap)
-       ch_in(:,:) = qx(:,:,iliq)
+       IF (nqo .EQ. 3) THEN 
+          ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol)
+       ELSE 
+          ch_in(:,:) = qx(:,:,iliq)
+       ENDIF
     ENDIF
 
-    IF (iflag_phytrac == 1 ) THEN
-
 #ifdef CPP_Dust
-      CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &  ! I
+    !  Avec SPLA, iflag_phytrac est forcé =1 
+    CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &  ! I
                       pdtphys,ftsol,                                   &  ! I
                       t,q_seri,paprs,pplay,RHcl,                  &  ! I
@@ -6216,6 +6243,6 @@
 
 #else
-
-    CALL phytrac ( &
+    IF (iflag_phytrac == 1 ) THEN
+      CALL phytrac ( &
          itap,     days_elapsed+1,    jH_cur,   debut, &
          lafin,    phys_tstep,     u, v,     t, &
@@ -6254,7 +6281,8 @@
 
 #endif
-
-#endif
     ENDIF    ! (iflag_phytrac=1)
+
+#endif
+    !ENDIF    ! (iflag_phytrac=1)
 
     IF (offline) THEN
@@ -6345,5 +6373,5 @@
 #endif
     !
-    IF (type_trac == 'inca') THEN
+    IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
 #ifdef INCA
        CALL VTe(VTphysiq)
@@ -6354,5 +6382,5 @@
             pplay, &
             t_seri, &
-            tr_seri, &
+            tr_seri(:,:,1+nqCO2:nbtr), &
             nbtr, &
             paprs, &
@@ -6620,5 +6648,5 @@
   CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,  &
        pplay, lmax_th, aerosol_couple,                 &
-       ok_ade, ok_aie, ivap, ok_sync,         &
+       ok_ade, ok_aie, ivap, ok_sync,                  &
        ptconv, read_climoz, clevSTD,                   &
        ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse,      &
@@ -6639,5 +6667,5 @@
 #endif
 
-! On remet des variables a .false. apres un premier appel
+! Pour XIOS : On remet des variables a .false. apres un premier appel
     IF (debut) THEN
 #ifdef CPP_XIOS
Index: LMDZ6/trunk/libf/phylmdiso/phystokenc_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/phystokenc_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/phystokenc_mod.F90	(revision 3940)
@@ -1,387 +1,1 @@
-!
-! $Id: phystokenc_mod.F90 2343 2015-08-20 10:02:53Z emillour $
-!
-MODULE phystokenc_mod
-
-  IMPLICIT NONE
-
-  LOGICAL,SAVE :: offline
-!$OMP THREADPRIVATE(offline)
-  INTEGER,SAVE :: istphy
-!$OMP THREADPRIVATE(istphy)
-
-
-CONTAINS
-
-  SUBROUTINE init_phystokenc(offline_dyn,istphy_dyn)
-    IMPLICIT NONE
-    LOGICAL,INTENT(IN) :: offline_dyn
-    INTEGER,INTENT(IN) :: istphy_dyn
-
-    offline=offline_dyn
-    istphy=istphy_dyn
-
-  END SUBROUTINE init_phystokenc
-
-SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, &
-     pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
-     pfm_therm,pentr_therm, &
-     cdragh, pcoefh,yu1,yv1,ftsol,pctsrf, &
-     frac_impa,frac_nucl, &
-     pphis,paire,dtime,itap, &
-     psh, pda, pphi, pmp, pupwd, pdnwd)
-  
-  USE ioipsl
-  USE dimphy
-  USE infotrac_phy, ONLY : nqtot
-  USE iophy
-  USE indice_sol_mod
-  USE print_control_mod, ONLY: lunout
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-  
-  IMPLICIT NONE
-  
-!======================================================================
-! Auteur(s) FH
-! Objet: Ecriture des variables pour transport offline
-!
-!======================================================================
-
-! Arguments:
-!
-  REAL,DIMENSION(klon,klev), INTENT(IN)     :: psh   ! humidite specifique
-  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pda
-  REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi
-  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pmp
-  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pupwd ! saturated updraft mass flux
-  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pdnwd ! saturated downdraft mass flux
-
-!   EN ENTREE:
-!   ==========
-!
-!   divers:
-!   -------
-!
-  INTEGER nlon ! nombre de points horizontaux
-  INTEGER nlev ! nombre de couches verticales
-  REAL pdtphys ! pas d'integration pour la physique (seconde)
-  INTEGER itap
-  INTEGER, SAVE :: physid
-!$OMP THREADPRIVATE(physid)
-
-!   convection:
-!   -----------
-!
-  REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
-  REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
-  REAL pen_u(klon,klev) ! flux entraine dans le panache montant
-  REAL pde_u(klon,klev) ! flux detraine dans le panache montant
-  REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
-  REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
-  REAL pt(klon,klev)
-  REAL,ALLOCATABLE,SAVE :: t(:,:)
-!$OMP THREADPRIVATE(t)
-!
-  REAL rlon(klon), rlat(klon), dtime
-  REAL zx_tmp_3d(nbp_lon,nbp_lat,klev),zx_tmp_2d(nbp_lon,nbp_lat)
-
-!   Couche limite:
-!   --------------
-!
-  REAL cdragh(klon)          ! cdrag
-  REAL pcoefh(klon,klev)     ! coeff melange CL
-  REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
-  REAL yv1(klon)
-  REAL yu1(klon),pphis(klon),paire(klon)
-
-!   Les Thermiques : (Abderr 25 11 02)
-!   ---------------
-  REAL, INTENT(IN) ::  pfm_therm(klon,klev+1)
-  REAL pentr_therm(klon,klev)
-  
-  REAL,ALLOCATABLE,SAVE :: entr_therm(:,:)
-  REAL,ALLOCATABLE,SAVE :: fm_therm(:,:)
-!$OMP THREADPRIVATE(entr_therm)
-!$OMP THREADPRIVATE(fm_therm)
-!
-!   Lessivage:
-!   ----------
-!
-  REAL frac_impa(klon,klev)
-  REAL frac_nucl(klon,klev)
-!
-! Arguments necessaires pour les sources et puits de traceur
-!
-  REAL ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
-  REAL pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
-!======================================================================
-!
-  INTEGER i, k, kk
-  REAL,ALLOCATABLE,SAVE :: mfu(:,:)  ! flux de masse dans le panache montant
-  REAL,ALLOCATABLE,SAVE :: mfd(:,:)  ! flux de masse dans le panache descendant
-  REAL,ALLOCATABLE,SAVE :: en_u(:,:) ! flux entraine dans le panache montant
-  REAL,ALLOCATABLE,SAVE :: de_u(:,:) ! flux detraine dans le panache montant
-  REAL,ALLOCATABLE,SAVE :: en_d(:,:) ! flux entraine dans le panache descendant
-  REAL,ALLOCATABLE,SAVE :: de_d(:,:) ! flux detraine dans le panache descendant
-  REAL,ALLOCATABLE,SAVE :: coefh(:,:) ! flux detraine dans le panache descendant
-  
-  REAL,ALLOCATABLE,SAVE :: pyu1(:)
-  REAL,ALLOCATABLE,SAVE :: pyv1(:)
-  REAL,ALLOCATABLE,SAVE :: pftsol(:,:)
-  REAL,ALLOCATABLE,SAVE :: ppsrf(:,:)
-!$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh)
-!$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf)
-
-
-  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: sh  
-  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: da
-  REAL,DIMENSION(:,:,:), ALLOCATABLE,SAVE   :: phi
-  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: mp
-  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: upwd
-  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: dnwd
-  
-  REAL, SAVE :: dtcum
-  INTEGER, SAVE:: iadvtr=0
-!$OMP THREADPRIVATE(dtcum,iadvtr)
-  REAL zmin,zmax
-  LOGICAL ok_sync
-  CHARACTER(len=12) :: nvar
-  logical, parameter :: lstokenc=.FALSE.
-!
-!======================================================================
-
-  iadvtr=iadvtr+1
-
-! Dans le meme vecteur on recombine le drag et les coeff d'echange
-  pcoefh_buf(:,1)      = cdragh(:)
-  pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
-  
-  ok_sync = .TRUE.
-
-! Initialization done only once
-!======================================================================
-  IF (iadvtr==1) THEN
-     ALLOCATE( t(klon,klev))
-     ALLOCATE( mfu(klon,klev))  
-     ALLOCATE( mfd(klon,klev))  
-     ALLOCATE( en_u(klon,klev)) 
-     ALLOCATE( de_u(klon,klev)) 
-     ALLOCATE( en_d(klon,klev)) 
-     ALLOCATE( de_d(klon,klev)) 
-     ALLOCATE( coefh(klon,klev)) 
-     ALLOCATE( entr_therm(klon,klev))
-     ALLOCATE( fm_therm(klon,klev))
-     ALLOCATE( pyu1(klon))
-     ALLOCATE( pyv1(klon))
-     ALLOCATE( pftsol(klon,nbsrf))
-     ALLOCATE( ppsrf(klon,nbsrf))
-     
-     ALLOCATE(sh(klon,klev)) 
-     ALLOCATE(da(klon,klev)) 
-     ALLOCATE(phi(klon,klev,klev)) 
-     ALLOCATE(mp(klon,klev)) 
-     ALLOCATE(upwd(klon,klev)) 
-     ALLOCATE(dnwd(klon,klev)) 
-
-     CALL initphysto('phystoke', dtime, dtime*istphy,dtime*istphy,physid)
-     
-     ! Write field phis and aire only once
-     CALL histwrite_phy(physid,lstokenc,"phis",itap,pphis)
-     CALL histwrite_phy(physid,lstokenc,"aire",itap,paire)
-     CALL histwrite_phy(physid,lstokenc,"longitudes",itap,rlon)
-     CALL histwrite_phy(physid,lstokenc,"latitudes",itap,rlat)
-
-  END IF
-  
-  
-! Set to zero cumulating fields
-!======================================================================
-  IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN
-     WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr
-     mfu(:,:)=0.
-     mfd(:,:)=0.
-     en_u(:,:)=0.
-     de_u(:,:)=0.
-     en_d(:,:)=0.
-     de_d(:,:)=0.
-     coefh(:,:)=0.
-     t(:,:)=0.
-     fm_therm(:,:)=0.
-     entr_therm(:,:)=0.
-     pyv1(:)=0.
-     pyu1(:)=0.
-     pftsol(:,:)=0.
-     ppsrf(:,:)=0.
-     sh(:,:)=0.
-     da(:,:)=0.
-     phi(:,:,:)=0.
-     mp(:,:)=0.
-     upwd(:,:)=0.
-     dnwd(:,:)=0.
-     dtcum=0.
-  ENDIF
-  
-
-! Cumulate fields at each time step
-!======================================================================
-  DO k=1,klev
-     DO i=1,klon
-        mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
-        mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
-        en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
-        de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
-        en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
-        de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
-        coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
-        t(i,k)=t(i,k)+pt(i,k)*pdtphys
-        fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
-        entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
-        sh(i,k) = sh(i,k) + psh(i,k)*pdtphys
-        da(i,k) = da(i,k) + pda(i,k)*pdtphys
-        mp(i,k) = mp(i,k) + pmp(i,k)*pdtphys
-        upwd(i,k) = upwd(i,k) + pupwd(i,k)*pdtphys
-        dnwd(i,k) = dnwd(i,k) + pdnwd(i,k)*pdtphys
-     ENDDO
-  ENDDO
-
-  DO kk=1,klev
-     DO k=1,klev
-        DO i=1,klon
-           phi(i,k,kk) = phi(i,k,kk) + pphi(i,k,kk)*pdtphys
-        END DO
-     END DO
-  END DO
-
-  DO i=1,klon
-     pyv1(i)=pyv1(i)+yv1(i)*pdtphys
-     pyu1(i)=pyu1(i)+yu1(i)*pdtphys
-  END DO
-  DO k=1,nbsrf
-     DO i=1,klon
-        pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
-        ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
-     ENDDO
-  ENDDO
-  
-! Add time step to cumulated time
-  dtcum=dtcum+pdtphys
-  
-
-! Write fields to file, if it is time to do so
-!======================================================================
-  IF(MOD(iadvtr,istphy)==0) THEN 
-
-     ! normalize with time period
-     DO k=1,klev
-        DO i=1,klon
-           mfu(i,k)=mfu(i,k)/dtcum
-           mfd(i,k)=mfd(i,k)/dtcum
-           en_u(i,k)=en_u(i,k)/dtcum
-           de_u(i,k)=de_u(i,k)/dtcum
-           en_d(i,k)=en_d(i,k)/dtcum
-           de_d(i,k)=de_d(i,k)/dtcum
-           coefh(i,k)=coefh(i,k)/dtcum
-           t(i,k)=t(i,k)/dtcum	
-           fm_therm(i,k)=fm_therm(i,k)/dtcum
-           entr_therm(i,k)=entr_therm(i,k)/dtcum
-           sh(i,k)=sh(i,k)/dtcum
-           da(i,k)=da(i,k)/dtcum
-           mp(i,k)=mp(i,k)/dtcum
-           upwd(i,k)=upwd(i,k)/dtcum
-           dnwd(i,k)=dnwd(i,k)/dtcum
-        ENDDO
-     ENDDO
-     DO kk=1,klev
-        DO k=1,klev
-           DO i=1,klon
-              phi(i,k,kk) = phi(i,k,kk)/dtcum
-           END DO
-        END DO
-     END DO
-     DO i=1,klon
-        pyv1(i)=pyv1(i)/dtcum
-        pyu1(i)=pyu1(i)/dtcum
-     END DO
-     DO k=1,nbsrf
-        DO i=1,klon
-           pftsol(i,k)=pftsol(i,k)/dtcum
-           ppsrf(i,k)=ppsrf(i,k)/dtcum
-        ENDDO
-     ENDDO
-
-     ! write fields
-     CALL histwrite_phy(physid,lstokenc,"t",itap,t)
-     CALL histwrite_phy(physid,lstokenc,"mfu",itap,mfu)
-     CALL histwrite_phy(physid,lstokenc,"mfd",itap,mfd)
-     CALL histwrite_phy(physid,lstokenc,"en_u",itap,en_u)
-     CALL histwrite_phy(physid,lstokenc,"de_u",itap,de_u)
-     CALL histwrite_phy(physid,lstokenc,"en_d",itap,en_d)
-     CALL histwrite_phy(physid,lstokenc,"de_d",itap,de_d)
-     CALL histwrite_phy(physid,lstokenc,"coefh",itap,coefh)	
-     CALL histwrite_phy(physid,lstokenc,"fm_th",itap,fm_therm)
-     CALL histwrite_phy(physid,lstokenc,"en_th",itap,entr_therm)
-     CALL histwrite_phy(physid,lstokenc,"frac_impa",itap,frac_impa)
-     CALL histwrite_phy(physid,lstokenc,"frac_nucl",itap,frac_nucl)
-     CALL histwrite_phy(physid,lstokenc,"pyu1",itap,pyu1)
-     CALL histwrite_phy(physid,lstokenc,"pyv1",itap,pyv1)
-     CALL histwrite_phy(physid,lstokenc,"ftsol1",itap,pftsol(:,1))
-     CALL histwrite_phy(physid,lstokenc,"ftsol2",itap,pftsol(:,2))
-     CALL histwrite_phy(physid,lstokenc,"ftsol3",itap,pftsol(:,3))
-     CALL histwrite_phy(physid,lstokenc,"ftsol4",itap,pftsol(:,4))
-     CALL histwrite_phy(physid,lstokenc,"psrf1",itap,ppsrf(:,1))
-     CALL histwrite_phy(physid,lstokenc,"psrf2",itap,ppsrf(:,2))
-     CALL histwrite_phy(physid,lstokenc,"psrf3",itap,ppsrf(:,3))
-     CALL histwrite_phy(physid,lstokenc,"psrf4",itap,ppsrf(:,4))
-     CALL histwrite_phy(physid,lstokenc,"sh",itap,sh)
-     CALL histwrite_phy(physid,lstokenc,"da",itap,da)
-     CALL histwrite_phy(physid,lstokenc,"mp",itap,mp)
-     CALL histwrite_phy(physid,lstokenc,"upwd",itap,upwd)
-     CALL histwrite_phy(physid,lstokenc,"dnwd",itap,dnwd)
-
-
-! phi
-     DO k=1,klev
-        IF (k<10) THEN
-           WRITE(nvar,'(i1)') k
-        ELSE IF (k<100) THEN
-           WRITE(nvar,'(i2)') k
-        ELSE
-           WRITE(nvar,'(i3)') k
-        END IF
-        nvar='phi_lev'//trim(nvar)
-        
-        CALL histwrite_phy(physid,lstokenc,nvar,itap,phi(:,:,k))
-     END DO
-     
-     ! Syncronize file
-!$OMP MASTER
-     IF (ok_sync) CALL histsync(physid)
-!$OMP END MASTER
-     
-     
-     ! Calculate min and max values for some fields (coefficients de lessivage)
-     zmin=1e33
-     zmax=-1e33
-     DO k=1,klev
-        DO i=1,klon
-           zmax=MAX(zmax,frac_nucl(i,k))
-           zmin=MIN(zmin,frac_nucl(i,k))
-        ENDDO
-     ENDDO
-     WRITE(lunout,*)'------ coefs de lessivage (min et max) --------'
-     WRITE(lunout,*)'facteur de nucleation ',zmin,zmax
-     zmin=1e33
-     zmax=-1e33
-     DO k=1,klev
-        DO i=1,klon
-           zmax=MAX(zmax,frac_impa(i,k))
-           zmin=MIN(zmin,frac_impa(i,k))
-        ENDDO
-     ENDDO
-     WRITE(lunout,*)'facteur d impaction ',zmin,zmax
-     
-  ENDIF ! IF(MOD(iadvtr,istphy)==0)
-
-END SUBROUTINE phystokenc
-
-END MODULE phystokenc_mod
+link ../phylmd/phystokenc_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/planete.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/planete.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/planete.h	(revision 3940)
@@ -1,11 +1,1 @@
-!-----------------------------------------------------------------------
-! INCLUDE planet.h
-
-      COMMON/planet/aphelie,periheli,year_day,peri_day, obliquit, timeperi,&
-           e_elips,p_elips,unitastr
-
-      REAL aphelie,periheli,year_day,peri_day, obliquit, timeperi,e_elips, &
-           p_elips,unitastr
-
-!-----------------------------------------------------------------------
-!$OMP THREADPRIVATE(/planet/)
+link ../phylmd/planete.h
Index: LMDZ6/trunk/libf/phylmdiso/plevel.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/plevel.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/plevel.F90	(revision 3940)
@@ -1,139 +1,1 @@
-
-! $Header$
-
-! ================================================================
-! ================================================================
-SUBROUTINE plevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres)
-  ! ================================================================
-  ! ================================================================
-  USE netcdf
-  USE dimphy
-#ifdef CPP_IOIPSL 
-  USE phys_state_var_mod, ONLY: missing_val_nf90 
-#endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
-  IMPLICIT NONE
-
-  ! ================================================================
-
-  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
-  ! pression donnee (pres)
-
-  ! INPUT:  ilon ----- nombre de points
-  ! ilev ----- nombre de couches
-  ! lnew ----- true si on doit reinitialiser les poids
-  ! pgcm ----- pressions modeles
-  ! pres ----- pression vers laquelle on interpolle
-  ! Qgcm ----- champ GCM
-  ! Qpres ---- champ interpolle au niveau pres
-
-  ! ================================================================
-
-  ! arguments :
-  ! -----------
-
-  INTEGER ilon, ilev
-  LOGICAL lnew
-
-  REAL pgcm(ilon, ilev)
-  REAL qgcm(ilon, ilev)
-  REAL pres
-  REAL qpres(ilon)
-
-  ! local :
-  ! -------
-
-  ! ym      INTEGER lt(klon), lb(klon)
-  ! ym      REAL ptop, pbot, aist(klon), aisb(klon)
-
-  ! ym      save lt,lb,ptop,pbot,aist,aisb
-  INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: lt, lb
-  REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: aist, aisb
-  !$OMP THREADPRIVATE(lt,lb,aist,aisb)
-  REAL, SAVE :: ptop, pbot
-  !$OMP THREADPRIVATE(ptop, pbot)
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-  INTEGER i, k
-
-! REAL missing_val
-#ifndef CPP_XIOS
-  REAL :: missing_val
-#endif
-
-! missing_val = nf90_fill_real
-
-#ifndef CPP_XIOS
-      missing_val=missing_val_nf90
-#endif
-
-  IF (first) THEN
-    ALLOCATE (lt(klon), lb(klon), aist(klon), aisb(klon))
-    first = .FALSE.
-  END IF
-
-  ! =====================================================================
-  IF (lnew) THEN
-    ! on r�nitialise les r�ndicages et les poids
-    ! =====================================================================
-
-
-    ! Chercher les 2 couches les plus proches du niveau a obtenir
-
-    ! Eventuellement, faire l'extrapolation a partir des deux couches
-    ! les plus basses ou les deux couches les plus hautes:
-    DO i = 1, klon
-      IF (abs(pres-pgcm(i,ilev))<abs(pres-pgcm(i,1))) THEN
-        lt(i) = ilev ! 2
-        lb(i) = ilev - 1 ! 1
-      ELSE
-        lt(i) = 2
-        lb(i) = 1
-      END IF
-    END DO
-    DO k = 1, ilev - 1
-      DO i = 1, klon
-        pbot = pgcm(i, k)
-        ptop = pgcm(i, k+1)
-        IF (ptop<=pres .AND. pbot>=pres) THEN
-          lt(i) = k + 1
-          lb(i) = k
-        END IF
-      END DO
-    END DO
-
-    ! Interpolation lineaire:
-
-    DO i = 1, klon
-      ! interpolation en logarithme de pression:
-
-      ! ...   Modif . P. Le Van    ( 20/01/98) ....
-      ! Modif Fr��ic Hourdin (3/01/02)
-
-      aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
-      aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
-    END DO
-
-
-  END IF ! lnew
-
-  ! ======================================================================
-  ! inteprollation
-  ! ======================================================================
-
-  DO i = 1, klon
-    qpres(i) = qgcm(i, lb(i))*aisb(i) + qgcm(i, lt(i))*aist(i)
-  END DO
-
-  ! Je mets les vents a zero quand je rencontre une montagne
-  DO i = 1, klon
-    IF (pgcm(i,1)<pres) THEN
-      qpres(i) = missing_val
-    END IF
-  END DO
-
-
-  RETURN
-END SUBROUTINE plevel
+link ../phylmd/plevel.F90
Index: LMDZ6/trunk/libf/phylmdiso/plevel_new.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/plevel_new.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/plevel_new.F90	(revision 3940)
@@ -1,148 +1,1 @@
-
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/plevel.F,v 1.1.1.1.10.1 2006/08/17
-! 15:41:51 fairhead Exp $
-
-! ================================================================
-! ================================================================
-SUBROUTINE plevel_new(ilon, ilev, klevstd, lnew, pgcm, pres, qgcm, qpres)
-  ! ================================================================
-  ! ================================================================
-  USE netcdf
-  USE dimphy
-#ifdef CPP_IOIPSL 
-  USE phys_state_var_mod, ONLY: missing_val_nf90
-#endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
-
-  IMPLICIT NONE
-
-  ! ================================================================
-
-  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
-  ! pression donnee (pres)
-
-  ! INPUT:  ilon ----- nombre de points
-  ! ilev ----- nombre de couches
-  ! lnew ----- true si on doit reinitialiser les poids
-  ! pgcm ----- pressions modeles
-  ! pres ----- pression vers laquelle on interpolle
-  ! Qgcm ----- champ GCM
-  ! Qpres ---- champ interpolle au niveau pres
-
-  ! ================================================================
-
-  ! arguments :
-  ! -----------
-
-  INTEGER ilon, ilev, klevstd
-  LOGICAL lnew
-
-  REAL pgcm(ilon, ilev)
-  REAL qgcm(ilon, ilev)
-  REAL pres(klevstd)
-  REAL qpres(ilon, klevstd)
-
-  ! local :
-  ! -------
-
-  ! ym      INTEGER lt(klon), lb(klon)
-  ! ym      REAL ptop, pbot, aist(klon), aisb(klon)
-
-  ! ym      save lt,lb,ptop,pbot,aist,aisb
-  INTEGER, ALLOCATABLE, SAVE, DIMENSION (:, :) :: lt, lb
-  REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: aist, aisb
-  !$OMP THREADPRIVATE(lt,lb,aist,aisb)
-  REAL, SAVE :: ptop, pbot
-  !$OMP THREADPRIVATE(ptop, pbot)
-  LOGICAL, SAVE :: first = .TRUE.
-  INTEGER :: nlev
-  !$OMP THREADPRIVATE(first)
-  INTEGER i, k
-
-! REAL missing_val
-#ifndef CPP_XIOS
-  REAL :: missing_val
-#endif
-
-! missing_val = nf90_fill_real
-
-#ifndef CPP_XIOS
-      missing_val=missing_val_nf90
-#endif
-
-  IF (first) THEN
-    ALLOCATE (lt(klon,klevstd), lb(klon,klevstd))
-    ALLOCATE (aist(klon,klevstd), aisb(klon,klevstd))
-    first = .FALSE.
-  END IF
-
-  ! =====================================================================
-  IF (lnew) THEN
-    ! on reinitialise les reindicages et les poids
-    ! =====================================================================
-
-
-    ! Chercher les 2 couches les plus proches du niveau a obtenir
-
-    ! Eventuellement, faire l'extrapolation a partir des deux couches
-    ! les plus basses ou les deux couches les plus hautes:
-
-
-    DO nlev = 1, klevstd
-      DO i = 1, klon
-        IF (abs(pres(nlev)-pgcm(i,ilev))<abs(pres(nlev)-pgcm(i,1))) THEN
-          lt(i, nlev) = ilev ! 2
-          lb(i, nlev) = ilev - 1 ! 1
-        ELSE
-          lt(i, nlev) = 2
-          lb(i, nlev) = 1
-        END IF
-      END DO
-      DO k = 1, ilev - 1
-        DO i = 1, klon
-          pbot = pgcm(i, k)
-          ptop = pgcm(i, k+1)
-          IF (ptop<=pres(nlev) .AND. pbot>=pres(nlev)) THEN
-            lt(i, nlev) = k + 1
-            lb(i, nlev) = k
-          END IF
-        END DO
-      END DO
-
-      ! Interpolation lineaire:
-      DO i = 1, klon
-        ! interpolation en logarithme de pression:
-
-        ! ...   Modif . P. Le Van    ( 20/01/98) ....
-        ! Modif Frederic Hourdin (3/01/02)
-
-        aist(i, nlev) = log(pgcm(i,lb(i,nlev))/pres(nlev))/log(pgcm(i,lb(i, &
-          nlev))/pgcm(i,lt(i,nlev)))
-        aisb(i, nlev) = log(pres(nlev)/pgcm(i,lt(i,nlev)))/log(pgcm(i,lb(i, &
-          nlev))/pgcm(i,lt(i,nlev)))
-      END DO
-    END DO
-
-  END IF ! lnew
-
-  ! ======================================================================
-  ! inteprollation
-  ! ET je mets les vents a zero quand je rencontre une montagne
-  ! ======================================================================
-
-  DO nlev = 1, klevstd
-    DO i = 1, klon
-      IF (pgcm(i,1)<pres(nlev)) THEN
-        qpres(i, nlev) = missing_val
-      ELSE
-        qpres(i, nlev) = qgcm(i, lb(i,nlev))*aisb(i, nlev) + &
-          qgcm(i, lt(i,nlev))*aist(i, nlev)
-      END IF
-    END DO
-  END DO
-
-
-  RETURN
-END SUBROUTINE plevel_new
+link ../phylmd/plevel_new.F90
Index: LMDZ6/trunk/libf/phylmdiso/pppmer.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/pppmer.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/pppmer.F90	(revision 3940)
@@ -1,161 +1,1 @@
-SUBROUTINE PPPMER(KPROMA,KSTART,KPROF,PRPRESS,POROG,PTSTAR,PT0,PMSLPPP)
-
-!**** *PPPMER* - POST-PROCESS MSL PRESSURE.
-
-!     PURPOSE.
-!     --------
-!           COMPUTES MSL PRESSURE.
-
-!**   INTERFACE.
-!     ----------
-
-!        *CALL* *PPPMER(KPROMA,KSTART,KPROF,PRPRESS,POROG,PTSTAR,PT0,
-!    S                  PMSLPPP)
-
-!        EXPLICIT ARGUMENTS
-!        --------------------
-
-
-!        KPROMA                    - HORIZONTAL DIMENSION.             (INPUT)
-!        KSTART                    - START OF WORK.                    (INPUT)
-!        KPROF                     - DEPTH OF WORK.                    (INPUT)
-!        PRPRESS(KPROMA)           - SURFACE PRESSURE                  (INPUT)
-!        POROG(KPROMA)             - MODEL OROGRAPHY.                  (INPUT)
-!        PTSTAR(KPROMA)            - SURFACE TEMPERATURE               (INPUT)
-!        PT0(KPROMA)               - STANDARD SURFACE TEMPERATURE      (INPUT)
-!        PMSLPPP(KPROMA)           - POST-PROCESSED MSL PRESSURE       (OUTPUT)
-!        IMPLICIT ARGUMENTS :  CONSTANTS FROM YOMCST,YOMGEM,YOMSTA.
-!        --------------------
-
-!     METHOD.
-!     -------
-!        SEE DOCUMENTATION
-
-!     EXTERNALS.  NONE
-!     ----------
-
-!     REFERENCE.
-!     ----------
-!        ECMWF Research Department documentation of the IFS
-
-!     AUTHOR.
-!     -------
-!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*
-
-!     MODIFICATIONS.
-!     --------------
-!        ORIGINAL : 89-01-26
-
-!     E. A-son, J-F Geleyn 920409 Mod. T*, T0 and alpha below surface.
-!        M.Hamrud      01-Oct-2003 CY28 Cleaning
-
-!     ------------------------------------------------------------------
-
-! USE PARKIND1 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/parkind1.F90.php#parkind1>  ,ONLY : JPIM     ,JPRB
-! USE YOMHOOK 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/yomhook.F90.php#yomhook>   ,ONLY : LHOOK,   DR_HOOK
-
-!USE YOMCST, ONLY : RG, RD
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomcst.F90.php#yomcst>   , ONLY : RG
-
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>       ,RD
-! USE YOMSTA 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomsta.F90.php#yomsta>   , ONLY : RDTDZ1
-
-  IMPLICIT NONE
-
-include "YOMCST.h"
-!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
-!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
-!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
- INTEGER,INTENT(IN)    :: KPROMA
- INTEGER,INTENT(IN)    :: KSTART
- INTEGER,INTENT(IN)    :: KPROF
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPRESS(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSTAR(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PT0(KPROMA)
-!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PMSLPPP(KPROMA)
-!IM REAL(KIND=JPRB) :: ZTSTAR(KPROMA)
-!IM REAL(KIND=JPRB) :: ZALPHA(KPROMA)
- REAL,INTENT(IN)    :: PRPRESS(KPROMA)
- REAL,INTENT(IN)    :: POROG(KPROMA)
- REAL,INTENT(IN)    :: PTSTAR(KPROMA)
- REAL,INTENT(IN)    :: PT0(KPROMA)
- REAL,INTENT(OUT)   :: PMSLPPP(KPROMA)
- REAL :: ZTSTAR(KPROMA)
- REAL :: ZALPHA(KPROMA)
-
-!IM INTEGER(KIND=JPIM) :: JL
- INTEGER :: JL
-
-!IM REAL(KIND=JPRB) :: ZDTDZSG, ZOROG, ZT0, ZTX, ZTY, ZX, ZY, ZY2
-!IM REAL(KIND=JPRB) :: ZHOOK_HANDLE
- REAL :: ZDTDZSG, ZOROG, ZT0, ZTX, ZTY, ZX, ZY, ZY2
- REAL :: ZHOOK_HANDLE
-!IM beg
-REAL, PARAMETER                  :: RDTDZ1=-0.0065 !or USE YOMSTA
-!IM end
-
-!     ------------------------------------------------------------------
-
-!*       1.    POST-PROCESS MSL PRESSURE.
-!              --------------------------
-
-!*       1.1   COMPUTATION OF MODIFIED ALPHA AND TSTAR.
-
-!IM IF (LHOOK) CALL DR_HOOK('PPPMER',0,ZHOOK_HANDLE)
-!IM ZTX=290.5_JPRB
-!IM ZTY=255.0_JPRB
- ZTX=290.5
- ZTY=255.0
- ZDTDZSG=-RDTDZ1/RG 
-!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
- DO JL=KSTART,KPROF
-
-   IF(PTSTAR(JL) < ZTY) THEN
-!IM  ZTSTAR(JL)=0.5_JPRB*(ZTY+PTSTAR(JL))
-     ZTSTAR(JL)=0.5*(ZTY+PTSTAR(JL))
-   ELSEIF(PTSTAR(JL) < ZTX) THEN
-     ZTSTAR(JL)=PTSTAR(JL)
-   ELSE
-!IM    ZTSTAR(JL)=0.5_JPRB*(ZTX+PTSTAR(JL))
-     ZTSTAR(JL)=0.5*(ZTX+PTSTAR(JL))
-   ENDIF
-
-   ZT0=ZTSTAR(JL)+ZDTDZSG*POROG(JL)
-   IF(ZTX > ZTSTAR(JL) .AND. ZT0 > ZTX) THEN
-     ZT0=ZTX
-   ELSEIF(ZTX <= ZTSTAR(JL) .AND. ZT0 > ZTSTAR(JL)) THEN
-     ZT0=ZTSTAR(JL)
-   ELSE
-     ZT0=PT0(JL)
-   ENDIF
-
-!IM  ZOROG=SIGN(MAX(1.0_JPRB,ABS(POROG(JL))),POROG(JL))
-   ZOROG=SIGN(MAX(1.0,ABS(POROG(JL))),POROG(JL))
-   ZALPHA(JL)=RD*(ZT0-ZTSTAR(JL))/ZOROG
- ENDDO
-
-!*       1.2   COMPUTATION OF MSL PRESSURE.
-
- DO JL=KSTART,KPROF
-!IM  IF (ABS(POROG(JL)) >= 0.001_JPRB) THEN
-   IF (ABS(POROG(JL)) >= 0.001) THEN
-     ZX=POROG(JL)/(RD*ZTSTAR(JL))
-     ZY=ZALPHA(JL)*ZX
-     ZY2=ZY*ZY
-
-!IM    PMSLPPP(JL)=PRPRESS(JL)*EXP(ZX*(1.0_JPRB-0.5_JPRB*ZY+1.0_JPRB/3._JPRB*ZY2))
-     PMSLPPP(JL)=PRPRESS(JL)*EXP(ZX*(1.0-0.5*ZY+1.0/3.*ZY2))
-   ELSE
-     PMSLPPP(JL)=PRPRESS(JL)
-   ENDIF
- ENDDO
-
-
-!     ------------------------------------------------------------------
-
-!IM IF (LHOOK) CALL DR_HOOK('PPPMER',1,ZHOOK_HANDLE)
- END SUBROUTINE PPPMER
+link ../phylmd/pppmer.F90
Index: LMDZ6/trunk/libf/phylmdiso/press_coefoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/press_coefoz_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/press_coefoz_m.F90	(revision 3940)
@@ -1,74 +1,1 @@
-! $Id$
-module press_coefoz_m
-
-  implicit none
-
-  real, pointer, save:: plev(:)
-  ! (pressure level of Mobidic input data, converted to Pa, in strictly
-  ! ascending order)
-
-  real, allocatable, save:: press_in_edg(:)
-  ! (edges of pressure intervals for Mobidic input data, in Pa, in strictly
-  ! ascending order)
-
-contains
-
-  subroutine press_coefoz
-
-    ! This procedure is called once per "gcm" run.
-    ! A single thread of the root process reads the pressure levels
-    ! from "coefoz_LMDZ.nc" and broadcasts them to the other processes.
-
-    ! We assume that, in "coefoz_LMDZ.nc", the pressure levels are in hPa
-    ! and in strictly ascending order.
-
-    use netcdf95, only: nf95_open, nf95_close, nf95_gw_var, nf95_inq_varid
-    use netcdf, only: nf90_nowrite
-
-    use mod_phys_lmdz_mpi_data, only: is_mpi_root
-    use mod_phys_lmdz_mpi_transfert, only: bcast_mpi ! broadcast
-
-    ! Variables local to the procedure:
-    integer ncid, varid ! for NetCDF
-    integer n_plev ! number of pressure levels in the input data
-    integer k
-
-    !---------------------------------------
-
-    !$omp single
-    print *, "Call sequence information: press_coefoz"
-
-    if (is_mpi_root) then
-       call nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
-
-       call nf95_inq_varid(ncid, "plev", varid)
-       call nf95_gw_var(ncid, varid, plev)
-       ! Convert from hPa to Pa because "paprs" and "pplay" are in Pa:
-       plev = plev * 100.
-       n_plev = size(plev)
-
-       call nf95_close(ncid)
-    end if
-
-    call bcast_mpi(n_plev)
-    if (.not. is_mpi_root) allocate(plev(n_plev))
-    call bcast_mpi(plev)
-    
-    ! Compute edges of pressure intervals:
-    allocate(press_in_edg(n_plev + 1))
-    if (is_mpi_root) then
-       press_in_edg(1) = 0.
-       ! We choose edges halfway in logarithm:
-       DO k = 2,n_plev
-          press_in_edg(k) = SQRT(plev(k - 1) * plev(k))
-       ENDDO
-       press_in_edg(n_plev + 1) = huge(0.)
-       ! (infinity, but any value guaranteed to be greater than the
-       ! surface pressure would do)
-    end if
-    call bcast_mpi(press_in_edg)
-    !$omp end single
-
-  end subroutine press_coefoz
-
-end module press_coefoz_m
+link ../phylmd/press_coefoz_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/print_debug_phys.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/print_debug_phys.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/print_debug_phys.F90	(revision 3940)
@@ -1,21 +1,1 @@
-SUBROUTINE print_debug_phys (i,debug_lev,text)
-
-USE dimphy, ONLY: klev
-USE phys_local_var_mod, ONLY: u_seri, v_seri, t_seri, q_seri, ql_seri
-USE geometry_mod, ONLY: longitude_deg, latitude_deg
-IMPLICIT NONE
-integer i,debug_lev
-CHARACTER*(*) text
-
-
-integer k
-
-print*,'PLANTAGE POUR LE POINT i=',i,text
-print*,'l    u, v, T, q, ql'
-DO k = 1, klev
-   write(*,'(i3,2f8.4,3f14.4,2e14.2)') k,longitude_deg(i),latitude_deg(i), &
-   u_seri(i,k),v_seri(i,k),t_seri(i,k),q_seri(i,k),ql_seri(i,k)
-ENDDO
-
-RETURN
-END
+link ../phylmd/print_debug_phys.F90
Index: LMDZ6/trunk/libf/phylmdiso/printflag.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/printflag.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/printflag.F90	(revision 3940)
@@ -1,190 +1,1 @@
-
-! $Header$
-
-SUBROUTINE printflag(tabcntr0, radpas, ok_journe, ok_instan, ok_region)
-
-
-
-  ! Auteur :  P. Le Van
-
-  IMPLICIT NONE
-
-  REAL tabcntr0(100)
-  LOGICAL cycle_diurn0, soil_model0, new_oliq0, ok_orodr0
-  LOGICAL ok_orolf0, ok_limitvr0
-  LOGICAL ok_journe, ok_instan, ok_region
-  INTEGER radpas, radpas0
-
-  include "clesphys.h"
-
-
-  PRINT 100
-  PRINT *, ' ******************************************************* &
-    &                                                         &
-    &  ************'
-  PRINT *, ' ********   Choix  des principales  cles de la physique &
-    &                                                         &
-    &      *********'
-  PRINT *, ' ******************************************************* &
-    &                                                         &
-    &  ************'
-  PRINT 100
-  PRINT 10, iflag_cycle_diurne.GE.1, soil_model
-  PRINT 100
-
-  IF (iflag_con==1) THEN
-    PRINT *, ' *****           Shema  convection   LMD        &
-      &                                                       &
-      &                   ******'
-  ELSE IF (iflag_con==2) THEN
-    PRINT *, ' *****           Shema  convection  Tiedtke     &
-      &                                                       &
-      &                   ******'
-  ELSE IF (iflag_con>=3) THEN
-    PRINT *, ' *****           Shema  convection    Emanuel   &
-      &                                                       &
-      &                   ******'
-  END IF
-  PRINT 100
-
-  PRINT 11, new_oliq, ok_orodr, ok_orolf
-  PRINT 100
-
-  PRINT 7, ok_limitvrai
-  PRINT 100
-
-  PRINT 12, nbapp_rad
-  PRINT 100
-
-  PRINT 8, radpas
-  PRINT 100
-
-  PRINT 4, ok_journe, ok_instan, ok_region
-  PRINT 100
-  PRINT 100
-
-
-  cycle_diurn0 = .FALSE.
-  soil_model0 = .FALSE.
-  new_oliq0 = .FALSE.
-  ok_orodr0 = .FALSE.
-  ok_orolf0 = .FALSE.
-  ok_limitvr0 = .FALSE.
-
-  IF (tabcntr0(7)==1.) cycle_diurn0 = .TRUE.
-  IF (tabcntr0(8)==1.) soil_model0 = .TRUE.
-  IF (tabcntr0(9)==1.) new_oliq0 = .TRUE.
-  IF (tabcntr0(10)==1.) ok_orodr0 = .TRUE.
-  IF (tabcntr0(11)==1.) ok_orolf0 = .TRUE.
-  IF (tabcntr0(12)==1.) ok_limitvr0 = .TRUE.
-
-  PRINT *, ' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ &
-    &                                                         &
-    & $$$$$$$$$$$$$'
-  PRINT 100
-
-  IF (int(tabcntr0(5))/=iflag_con) THEN
-    PRINT 20, int(tabcntr0(5)), iflag_con
-    PRINT 100
-  END IF
-
-  IF (int(tabcntr0(6))/=nbapp_rad) THEN
-    PRINT 21, int(tabcntr0(6)), nbapp_rad
-    ! radpas0  = NINT( 86400./tabcntr0(1)/INT( tabcntr0(6) ) )
-    PRINT 100
-    ! PRINT 22, radpas0, radpas
-    PRINT 100
-  END IF
-
-  IF (cycle_diurn0 .AND. .NOT. (iflag_cycle_diurne.GE.1) .OR. .NOT. cycle_diurn0 .AND. &
-      (iflag_cycle_diurne.GE.1) ) THEN
-    PRINT 13, cycle_diurn0, iflag_cycle_diurne
-    PRINT 100
-  END IF
-
-  IF (soil_model0 .AND. .NOT. soil_model .OR. .NOT. soil_model0 .AND. &
-      soil_model) THEN
-    PRINT 14, soil_model0, soil_model
-    PRINT 100
-  END IF
-
-  IF (new_oliq0 .AND. .NOT. new_oliq .OR. .NOT. new_oliq0 .AND. new_oliq) &
-      THEN
-    PRINT 16, new_oliq0, new_oliq
-    PRINT 100
-  END IF
-
-  IF (ok_orodr0 .AND. .NOT. ok_orodr .OR. .NOT. ok_orodr0 .AND. ok_orodr) &
-      THEN
-    PRINT 15, ok_orodr0, ok_orodr
-    PRINT 100
-  END IF
-
-  IF (ok_orolf0 .AND. .NOT. ok_orolf .OR. .NOT. ok_orolf0 .AND. ok_orolf) &
-      THEN
-    PRINT 17, ok_orolf0, ok_orolf
-    PRINT 100
-  END IF
-
-  IF (ok_limitvr0 .AND. .NOT. ok_limitvrai .OR. .NOT. ok_limitvr0 .AND. &
-      ok_limitvrai) THEN
-    PRINT 18, ok_limitvr0, ok_limitvrai
-    PRINT 100
-  END IF
-
-  PRINT 100
-  PRINT *, ' ******************************************************* &
-    &                                                         &
-    &  ************'
-  PRINT 100
-
-4 FORMAT (2X, 5('*'), '  ok_journe= ', L3, 3X, ',ok_instan = ', L3, 3X, &
-    ',ok_region = ', L3, 3X, 5('*'))
-
-7 FORMAT (2X, 5('*'), 15X, '      ok_limitvrai   = ', L3, 16X, 5('*'))
-
-8 FORMAT (2X, '*****             radpas    =                      ', I4, 6X, &
-    ' *****')
-
-10 FORMAT (2X, 5('*'), '    Cycle_diurne = ', L3, 4X, ', Soil_model = ', L3, &
-    12X, 6('*'))
-
-
-11 FORMAT (2X, 5('*'), '  new_oliq = ', L3, 3X, ', Ok_orodr = ', L3, 3X, &
-    ', Ok_orolf = ', L3, 3X, 5('*'))
-
-
-12 FORMAT (2X, '*****  Nb d appels /jour des routines de rayonn. = ', I4, 6X, &
-    ' *****')
-
-13 FORMAT (2X, '$$$$$$$$   Attention !!  cycle_diurne  different  sur', /1X, &
-    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
-
-14 FORMAT (2X, '$$$$$$$$   Attention !!    soil_model  different  sur', /1X, &
-    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
-
-15 FORMAT (2X, '$$$$$$$$   Attention !!      ok_orodr  different  sur', /1X, &
-    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
-
-16 FORMAT (2X, '$$$$$$$$   Attention !!      new_oliq  different  sur', /1X, &
-    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
-
-17 FORMAT (2X, '$$$$$$$$   Attention !!      ok_orolf  different  sur', /1X, &
-    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
-
-18 FORMAT (2X, '$$$$$$$$   Attention !!  ok_limitvrai  different  sur', /1X, &
-    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
-
-20 FORMAT (/2X, '$$$$$$$$   Attention !!    iflag_con  different  sur', /1X, &
-    10X, ' startphy = ', I3, 2X, ' et  run.def = ', I3)
-
-21 FORMAT (2X, '$$$$$$$$   Attention !!     nbapp_rad  different  sur', /1X, &
-    10X, ' startphy = ', I3, 2X, ' et  run.def = ', I3)
-
-22 FORMAT (2X, '$$$$$$$$   Attention !!        radpas  different  sur', /1X, &
-    10X, ' startphy = ', I3, 2X, ' et  run.def = ', I3)
-
-100 FORMAT (/)
-
-  RETURN
-END SUBROUTINE printflag
+link ../phylmd/printflag.F90
Index: LMDZ6/trunk/libf/phylmdiso/qcheck.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/qcheck.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/qcheck.F90	(revision 3940)
@@ -1,29 +1,1 @@
-FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
-  IMPLICIT none
-  !
-  ! Calculer et imprimer l'eau totale. A utiliser pour verifier
-  ! la conservation de l'eau
-  !
-  include "YOMCST.h"
-  INTEGER,INTENT(IN) :: klon,klev
-  REAL,INTENT(IN) :: paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
-  REAL,INTENT(IN) :: aire(klon)
-  REAL qtotal, zx, qcheck
-  INTEGER i, k
-  !
-  zx = 0.0
-  DO i = 1, klon
-     zx = zx + aire(i)
-  ENDDO
-  qtotal = 0.0
-  DO k = 1, klev
-     DO i = 1, klon
-        qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i) &
-             *(paprs(i,k)-paprs(i,k+1))/RG
-     ENDDO
-  ENDDO
-  !
-  qcheck = qtotal/zx
-  !
-END FUNCTION qcheck
-
+link ../phylmd/qcheck.F90
Index: LMDZ6/trunk/libf/phylmdiso/raddim.160.98.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.160.98.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.160.98.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=78,kflev=klev) ! 78*199
+link ../phylmd/raddim.160.98.h
Index: LMDZ6/trunk/libf/phylmdiso/raddim.192.143.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.192.143.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.192.143.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-       INTEGER kdlon, kflev
-      PARAMETER (kdlon=10,kflev=klev)
+link ../phylmd/raddim.192.143.h
Index: LMDZ6/trunk/libf/phylmdiso/raddim.32.24.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.32.24.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.32.24.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=klon,kflev=klev)
+link ../phylmd/raddim.32.24.h
Index: LMDZ6/trunk/libf/phylmdiso/raddim.48.32.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.48.32.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.48.32.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=149,kflev=klev)
+link ../phylmd/raddim.48.32.h
Index: LMDZ6/trunk/libf/phylmdiso/raddim.72.46.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.72.46.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.72.46.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=1621,kflev=klev)
+link ../phylmd/raddim.72.46.h
Index: LMDZ6/trunk/libf/phylmdiso/raddim.96.72.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.96.72.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.96.72.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=487,kflev=klev)
+link ../phylmd/raddim.96.72.h
Index: LMDZ6/trunk/libf/phylmdiso/raddim.defaut.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.defaut.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.defaut.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=klon,kflev=klev)
+link ../phylmd/raddim.defaut.h
Index: LMDZ6/trunk/libf/phylmdiso/raddim.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddim.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddim.h	(revision 3940)
@@ -1,5 +1,1 @@
-!
-! $Header$
-!
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=149,kflev=klev)
+link ../phylmd/raddim.h
Index: LMDZ6/trunk/libf/phylmdiso/raddimlw.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/raddimlw.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/raddimlw.h	(revision 3940)
@@ -1,11 +1,1 @@
-!
-! $Header$
-!
-      INTEGER NUA
-      PARAMETER (NUA=24)
-      INTEGER NTRA
-      PARAMETER (NTRA=15)
-      INTEGER Ninter
-      PARAMETER (Ninter=6)
-      INTEGER NG1, NG1P1
-      PARAMETER (NG1=2, NG1P1=NG1+1)
+link ../phylmd/raddimlw.h
Index: LMDZ6/trunk/libf/phylmdiso/radepsi.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/radepsi.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/radepsi.h	(revision 3940)
@@ -1,16 +1,1 @@
-!
-! $Header$
-!
-      REAL(KIND=8) ZEELOG, ZEPSC, ZEPSCO, ZEPSCQ, ZEPSCT, ZEPSCW
-      REAL(KIND=8) ZEPSEC, ZEPSCR
-      PARAMETER (ZEELOG = 1.E-07) !1.e-10 (not good for 32-bit machines)
-      PARAMETER (ZEPSC  = 1.E-20)
-      PARAMETER (ZEPSCO = 1.E-10)
-      PARAMETER (ZEPSCQ = 1.E-10)
-      PARAMETER (ZEPSCT = 1.E-20)
-      PARAMETER (ZEPSCW = 1.E-20)
-      PARAMETER (ZEPSEC = 1.0E-12)
-      PARAMETER (ZEPSCR = 1.0E-10)
-!
-      REAL(KIND=8) REPSCT
-      PARAMETER (REPSCT=1.0E-10)
+link ../phylmd/radepsi.h
Index: LMDZ6/trunk/libf/phylmdiso/radiation_AR4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/radiation_AR4.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/radiation_AR4.F90	(revision 3940)
@@ -1,5716 +1,1 @@
-! IM ctes ds clesphys.h   SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC,
-SUBROUTINE sw_lmdar4(psct, prmu0, pfrac, ppmb, pdp, ppsol, palbd, palbp, &
-    ptave, pwv, pqs, pozon, paer, pcldsw, ptau, pomega, pcg, pheat, pheat0, &
-    palbpla, ptopsw, psolsw, ptopsw0, psolsw0, zfsup, zfsdn, zfsup0, zfsdn0, &
-    tauae, pizae, cgae, ptaua, pomegaa, ptopswad, psolswad, ptopswai, &
-    psolswai, ok_ade, ok_aie)
-  USE dimphy
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-
-  ! ------------------------------------------------------------------
-
-  ! PURPOSE.
-  ! --------
-
-  ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
-  ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES ABSORBER AMOUNTS                 (SWU)
-  ! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL  (SW1S)
-  ! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL  (SW2S)
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-  ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! 95-01-01   J.-J. MORCRETTE  Direct/Diffuse Albedo
-  ! 03-11-27   J. QUAAS Introduce aerosol forcings (based on BOUCHER)
-  ! ------------------------------------------------------------------
-
-  ! * ARGUMENTS:
-
-  REAL (KIND=8) psct ! constante solaire (valeur conseillee: 1370)
-  ! IM ctes ds clesphys.h   REAL(KIND=8) RCO2  ! concentration CO2 (IPCC:
-  ! 353.E-06*44.011/28.97)
-  include "clesphys.h"
-
-  REAL (KIND=8) ppsol(kdlon) ! SURFACE PRESSURE (PA)
-  REAL (KIND=8) pdp(kdlon, kflev) ! LAYER THICKNESS (PA)
-  REAL (KIND=8) ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)
-
-  REAL (KIND=8) prmu0(kdlon) ! COSINE OF ZENITHAL ANGLE
-  REAL (KIND=8) pfrac(kdlon) ! fraction de la journee
-
-  REAL (KIND=8) ptave(kdlon, kflev) ! LAYER TEMPERATURE (K)
-  REAL (KIND=8) pwv(kdlon, kflev) ! SPECIFIC HUMIDITY (KG/KG)
-  REAL (KIND=8) pqs(kdlon, kflev) ! SATURATED WATER VAPOUR (KG/KG)
-  REAL (KIND=8) pozon(kdlon, kflev) ! OZONE CONCENTRATION (KG/KG)
-  REAL (KIND=8) paer(kdlon, kflev, 5) ! AEROSOLS' OPTICAL THICKNESS
-
-  REAL (KIND=8) palbd(kdlon, 2) ! albedo du sol (lumiere diffuse)
-  REAL (KIND=8) palbp(kdlon, 2) ! albedo du sol (lumiere parallele)
-
-  REAL (KIND=8) pcldsw(kdlon, kflev) ! CLOUD FRACTION
-  REAL (KIND=8) ptau(kdlon, 2, kflev) ! CLOUD OPTICAL THICKNESS
-  REAL (KIND=8) pcg(kdlon, 2, kflev) ! ASYMETRY FACTOR
-  REAL (KIND=8) pomega(kdlon, 2, kflev) ! SINGLE SCATTERING ALBEDO
-
-  REAL (KIND=8) pheat(kdlon, kflev) ! SHORTWAVE HEATING (K/DAY)
-  REAL (KIND=8) pheat0(kdlon, kflev) ! SHORTWAVE HEATING (K/DAY) clear-sky
-  REAL (KIND=8) palbpla(kdlon) ! PLANETARY ALBEDO
-  REAL (KIND=8) ptopsw(kdlon) ! SHORTWAVE FLUX AT T.O.A.
-  REAL (KIND=8) psolsw(kdlon) ! SHORTWAVE FLUX AT SURFACE
-  REAL (KIND=8) ptopsw0(kdlon) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
-  REAL (KIND=8) psolsw0(kdlon) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
-
-  ! * LOCAL VARIABLES:
-
-  REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
-
-  REAL (KIND=8) zoz(kdlon, kflev)
-  ! column-density of ozone in layer, in kilo-Dobsons
-
-  REAL (KIND=8) zaki(kdlon, 2)
-  REAL (KIND=8) zcld(kdlon, kflev)
-  REAL (KIND=8) zclear(kdlon)
-  REAL (KIND=8) zdsig(kdlon, kflev)
-  REAL (KIND=8) zfact(kdlon)
-  REAL (KIND=8) zfd(kdlon, kflev+1)
-  REAL (KIND=8) zfdown(kdlon, kflev+1)
-  REAL (KIND=8) zfu(kdlon, kflev+1)
-  REAL (KIND=8) zfup(kdlon, kflev+1)
-  REAL (KIND=8) zrmu(kdlon)
-  REAL (KIND=8) zsec(kdlon)
-  REAL (KIND=8) zud(kdlon, 5, kflev+1)
-  REAL (KIND=8) zcldsw0(kdlon, kflev)
-
-  REAL (KIND=8) zfsup(kdlon, kflev+1)
-  REAL (KIND=8) zfsdn(kdlon, kflev+1)
-  REAL (KIND=8) zfsup0(kdlon, kflev+1)
-  REAL (KIND=8) zfsdn0(kdlon, kflev+1)
-
-  INTEGER inu, jl, jk, i, k, kpl1
-
-  INTEGER swpas ! Every swpas steps, sw is calculated
-  PARAMETER (swpas=1)
-
-  INTEGER itapsw
-  LOGICAL appel1er
-  DATA itapsw/0/
-  DATA appel1er/.TRUE./
-  SAVE itapsw, appel1er
-  !$OMP THREADPRIVATE(appel1er)
-  !$OMP THREADPRIVATE(itapsw)
-  ! jq-Introduced for aerosol forcings
-  REAL (KIND=8) flag_aer
-  LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
-  REAL (KIND=8) tauae(kdlon, kflev, 2) ! aerosol optical properties
-  REAL (KIND=8) pizae(kdlon, kflev, 2) ! (see aeropt.F)
-  REAL (KIND=8) cgae(kdlon, kflev, 2) ! -"-
-  REAL (KIND=8) ptaua(kdlon, 2, kflev) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
-  REAL (KIND=8) pomegaa(kdlon, 2, kflev) ! SINGLE SCATTERING ALBEDO
-  REAL (KIND=8) ptopswad(kdlon) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
-  REAL (KIND=8) psolswad(kdlon) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
-  REAL (KIND=8) ptopswai(kdlon) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
-  REAL (KIND=8) psolswai(kdlon) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
-  ! jq - Fluxes including aerosol effects
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zfsupad(:, :)
-  !$OMP THREADPRIVATE(ZFSUPAD)
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zfsdnad(:, :)
-  !$OMP THREADPRIVATE(ZFSDNAD)
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zfsupai(:, :)
-  !$OMP THREADPRIVATE(ZFSUPAI)
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zfsdnai(:, :)
-  !$OMP THREADPRIVATE(ZFSDNAI)
-  LOGICAL initialized
-  ! ym      SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes
-  ! rv
-  SAVE flag_aer
-  !$OMP THREADPRIVATE(flag_aer)
-  DATA initialized/.FALSE./
-  SAVE initialized
-  !$OMP THREADPRIVATE(initialized)
-  ! jq-end
-  REAL tmp_
-
-  IF (.NOT. initialized) THEN
-    flag_aer = 0.
-    initialized = .TRUE.
-    ALLOCATE (zfsupad(kdlon,kflev+1))
-    ALLOCATE (zfsdnad(kdlon,kflev+1))
-    ALLOCATE (zfsupai(kdlon,kflev+1))
-    ALLOCATE (zfsdnai(kdlon,kflev+1))
-
-    zfsupad(:, :) = 0.
-    zfsdnad(:, :) = 0.
-    zfsupai(:, :) = 0.
-    zfsdnai(:, :) = 0.
-  END IF
-
-  IF (appel1er) THEN
-    WRITE (lunout, *) 'SW calling frequency : ', swpas
-    WRITE (lunout, *) '   In general, it should be 1'
-    appel1er = .FALSE.
-  END IF
-  ! ------------------------------------------------------------------
-  IF (mod(itapsw,swpas)==0) THEN
-
-    tmp_ = 1./(dobson_u*1E3*rg)
-    ! cdir collapse
-    DO jk = 1, kflev
-      DO jl = 1, kdlon
-        zcldsw0(jl, jk) = 0.0
-        zoz(jl, jk) = pozon(jl, jk)*tmp_*pdp(jl, jk)
-      END DO
-    END DO
-
-
-    ! clear-sky:
-    ! IM ctes ds clesphys.h  CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,
-    CALL swu_lmdar4(psct, zcldsw0, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
-      zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
-    inu = 1
-    CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
-      pcg, zcld, zclear, zcldsw0, zdsig, pomega, zoz, zrmu, zsec, ptau, zud, &
-      zfd, zfu)
-    inu = 2
-    CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
-      palbp, pcg, zcld, zclear, zcldsw0, zdsig, pomega, zoz, zrmu, zsec, &
-      ptau, zud, pwv, pqs, zfdown, zfup)
-    DO jk = 1, kflev + 1
-      DO jl = 1, kdlon
-        zfsup0(jl, jk) = (zfup(jl,jk)+zfu(jl,jk))*zfact(jl)
-        zfsdn0(jl, jk) = (zfdown(jl,jk)+zfd(jl,jk))*zfact(jl)
-      END DO
-    END DO
-
-    flag_aer = 0.0
-    CALL swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
-      zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
-    inu = 1
-    CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
-      pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, ptau, zud, &
-      zfd, zfu)
-    inu = 2
-    CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
-      palbp, pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, ptau, &
-      zud, pwv, pqs, zfdown, zfup)
-
-    ! cloudy-sky:
-
-    DO jk = 1, kflev + 1
-      DO jl = 1, kdlon
-        zfsup(jl, jk) = (zfup(jl,jk)+zfu(jl,jk))*zfact(jl)
-        zfsdn(jl, jk) = (zfdown(jl,jk)+zfd(jl,jk))*zfact(jl)
-      END DO
-    END DO
-
-
-    IF (ok_ade) THEN
-
-      ! cloudy-sky + aerosol dir OB
-      flag_aer = 1.0
-      CALL swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
-        zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
-      inu = 1
-      CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
-        pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, ptau, zud, &
-        zfd, zfu)
-      inu = 2
-      CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
-        palbp, pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, &
-        ptau, zud, pwv, pqs, zfdown, zfup)
-      DO jk = 1, kflev + 1
-        DO jl = 1, kdlon
-          zfsupad(jl, jk) = zfsup(jl, jk)
-          zfsdnad(jl, jk) = zfsdn(jl, jk)
-          zfsup(jl, jk) = (zfup(jl,jk)+zfu(jl,jk))*zfact(jl)
-          zfsdn(jl, jk) = (zfdown(jl,jk)+zfd(jl,jk))*zfact(jl)
-        END DO
-      END DO
-
-    END IF ! ok_ade
-
-    IF (ok_aie) THEN
-
-      ! jq   cloudy-sky + aerosol direct + aerosol indirect
-      flag_aer = 1.0
-      CALL swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
-        zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
-      inu = 1
-      CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
-        pcg, zcld, zclear, pcldsw, zdsig, pomegaa, zoz, zrmu, zsec, ptaua, &
-        zud, zfd, zfu)
-      inu = 2
-      CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
-        palbp, pcg, zcld, zclear, pcldsw, zdsig, pomegaa, zoz, zrmu, zsec, &
-        ptaua, zud, pwv, pqs, zfdown, zfup)
-      DO jk = 1, kflev + 1
-        DO jl = 1, kdlon
-          zfsupai(jl, jk) = zfsup(jl, jk)
-          zfsdnai(jl, jk) = zfsdn(jl, jk)
-          zfsup(jl, jk) = (zfup(jl,jk)+zfu(jl,jk))*zfact(jl)
-          zfsdn(jl, jk) = (zfdown(jl,jk)+zfd(jl,jk))*zfact(jl)
-        END DO
-      END DO
-    END IF ! ok_aie
-    ! jq -end
-
-    itapsw = 0
-  END IF
-  itapsw = itapsw + 1
-
-  DO k = 1, kflev
-    kpl1 = k + 1
-    DO i = 1, kdlon
-      pheat(i, k) = -(zfsup(i,kpl1)-zfsup(i,k)) - (zfsdn(i,k)-zfsdn(i,kpl1))
-      pheat(i, k) = pheat(i, k)*rday*rg/rcpd/pdp(i, k)
-      pheat0(i, k) = -(zfsup0(i,kpl1)-zfsup0(i,k)) - &
-        (zfsdn0(i,k)-zfsdn0(i,kpl1))
-      pheat0(i, k) = pheat0(i, k)*rday*rg/rcpd/pdp(i, k)
-    END DO
-  END DO
-  DO i = 1, kdlon
-    palbpla(i) = zfsup(i, kflev+1)/(zfsdn(i,kflev+1)+1.0E-20)
-
-    psolsw(i) = zfsdn(i, 1) - zfsup(i, 1)
-    ptopsw(i) = zfsdn(i, kflev+1) - zfsup(i, kflev+1)
-
-    psolsw0(i) = zfsdn0(i, 1) - zfsup0(i, 1)
-    ptopsw0(i) = zfsdn0(i, kflev+1) - zfsup0(i, kflev+1)
-    ! -OB
-    psolswad(i) = zfsdnad(i, 1) - zfsupad(i, 1)
-    ptopswad(i) = zfsdnad(i, kflev+1) - zfsupad(i, kflev+1)
-
-    psolswai(i) = zfsdnai(i, 1) - zfsupai(i, 1)
-    ptopswai(i) = zfsdnai(i, kflev+1) - zfsupai(i, kflev+1)
-    ! -fin
-  END DO
-
-  RETURN
-END SUBROUTINE sw_lmdar4
-
-! IM ctes ds clesphys.h   SUBROUTINE SWU
-! (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC,
-SUBROUTINE swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
-    paki, pcld, pclear, pdsig, pfact, prmu, psec, pud)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: zpdh2o, zpdumg, zprh2o, zprumg, rtdh2o, &
-    rtdumg, rth2o, rtumg
-  IMPLICIT NONE
-  include "radepsi.h"
-  include "radopt.h"
-  include "YOMCST.h"
-
-  ! * ARGUMENTS:
-
-  REAL (KIND=8) psct
-  ! IM ctes ds clesphys.h   REAL(KIND=8) RCO2
-  include "clesphys.h"
-  REAL (KIND=8) pcldsw(kdlon, kflev)
-  REAL (KIND=8) ppmb(kdlon, kflev+1)
-  REAL (KIND=8) ppsol(kdlon)
-  REAL (KIND=8) prmu0(kdlon)
-  REAL (KIND=8) pfrac(kdlon)
-  REAL (KIND=8) ptave(kdlon, kflev)
-  REAL (KIND=8) pwv(kdlon, kflev)
-
-  REAL (KIND=8) paki(kdlon, 2)
-  REAL (KIND=8) pcld(kdlon, kflev)
-  REAL (KIND=8) pclear(kdlon)
-  REAL (KIND=8) pdsig(kdlon, kflev)
-  REAL (KIND=8) pfact(kdlon)
-  REAL (KIND=8) prmu(kdlon)
-  REAL (KIND=8) psec(kdlon)
-  REAL (KIND=8) pud(kdlon, 5, kflev+1)
-
-  ! * LOCAL VARIABLES:
-
-  INTEGER iind(2)
-  REAL (KIND=8) zc1j(kdlon, kflev+1)
-  REAL (KIND=8) zclear(kdlon)
-  REAL (KIND=8) zcloud(kdlon)
-  REAL (KIND=8) zn175(kdlon)
-  REAL (KIND=8) zn190(kdlon)
-  REAL (KIND=8) zo175(kdlon)
-  REAL (KIND=8) zo190(kdlon)
-  REAL (KIND=8) zsign(kdlon)
-  REAL (KIND=8) zr(kdlon, 2)
-  REAL (KIND=8) zsigo(kdlon)
-  REAL (KIND=8) zud(kdlon, 2)
-  REAL (KIND=8) zrth, zrtu, zwh2o, zdsco2, zdsh2o, zfppw
-  INTEGER jl, jk, jkp1, jkl, jklp1, ja
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.     COMPUTES AMOUNTS OF ABSORBERS
-  ! -----------------------------
-
-
-  iind(1) = 1
-  iind(2) = 2
-
-  ! *         1.1    INITIALIZES QUANTITIES
-  ! ----------------------
-
-
-  DO jl = 1, kdlon
-    pud(jl, 1, kflev+1) = 0.
-    pud(jl, 2, kflev+1) = 0.
-    pud(jl, 3, kflev+1) = 0.
-    pud(jl, 4, kflev+1) = 0.
-    pud(jl, 5, kflev+1) = 0.
-    pfact(jl) = prmu0(jl)*pfrac(jl)*psct
-    prmu(jl) = sqrt(1224.*prmu0(jl)*prmu0(jl)+1.)/35.
-    psec(jl) = 1./prmu(jl)
-    zc1j(jl, kflev+1) = 0.
-  END DO
-
-  ! *          1.3    AMOUNTS OF ABSORBERS
-  ! --------------------
-
-
-  DO jl = 1, kdlon
-    zud(jl, 1) = 0.
-    zud(jl, 2) = 0.
-    zo175(jl) = ppsol(jl)**(zpdumg+1.)
-    zo190(jl) = ppsol(jl)**(zpdh2o+1.)
-    zsigo(jl) = ppsol(jl)
-    zclear(jl) = 1.
-    zcloud(jl) = 0.
-  END DO
-
-  DO jk = 1, kflev
-    jkp1 = jk + 1
-    jkl = kflev + 1 - jk
-    jklp1 = jkl + 1
-    DO jl = 1, kdlon
-      zrth = (rth2o/ptave(jl,jk))**rtdh2o
-      zrtu = (rtumg/ptave(jl,jk))**rtdumg
-      zwh2o = max(pwv(jl,jk), zepscq)
-      zsign(jl) = 100.*ppmb(jl, jkp1)
-      pdsig(jl, jk) = (zsigo(jl)-zsign(jl))/ppsol(jl)
-      zn175(jl) = zsign(jl)**(zpdumg+1.)
-      zn190(jl) = zsign(jl)**(zpdh2o+1.)
-      zdsco2 = zo175(jl) - zn175(jl)
-      zdsh2o = zo190(jl) - zn190(jl)
-      pud(jl, 1, jk) = 1./(10.*rg*(zpdh2o+1.))/(zprh2o**zpdh2o)*zdsh2o*zwh2o* &
-        zrth
-      pud(jl, 2, jk) = 1./(10.*rg*(zpdumg+1.))/(zprumg**zpdumg)*zdsco2*rco2* &
-        zrtu
-      zfppw = 1.6078*zwh2o/(1.+0.608*zwh2o)
-      pud(jl, 4, jk) = pud(jl, 1, jk)*zfppw
-      pud(jl, 5, jk) = pud(jl, 1, jk)*(1.-zfppw)
-      zud(jl, 1) = zud(jl, 1) + pud(jl, 1, jk)
-      zud(jl, 2) = zud(jl, 2) + pud(jl, 2, jk)
-      zsigo(jl) = zsign(jl)
-      zo175(jl) = zn175(jl)
-      zo190(jl) = zn190(jl)
-
-      IF (novlp==1) THEN
-        zclear(jl) = zclear(jl)*(1.-max(pcldsw(jl,jkl),zcloud(jl)))/(1.-min( &
-          zcloud(jl),1.-zepsec))
-        zc1j(jl, jkl) = 1.0 - zclear(jl)
-        zcloud(jl) = pcldsw(jl, jkl)
-      ELSE IF (novlp==2) THEN
-        zcloud(jl) = max(pcldsw(jl,jkl), zcloud(jl))
-        zc1j(jl, jkl) = zcloud(jl)
-      ELSE IF (novlp==3) THEN
-        zclear(jl) = zclear(jl)*(1.-pcldsw(jl,jkl))
-        zcloud(jl) = 1.0 - zclear(jl)
-        zc1j(jl, jkl) = zcloud(jl)
-      END IF
-    END DO
-  END DO
-  DO jl = 1, kdlon
-    pclear(jl) = 1. - zc1j(jl, 1)
-  END DO
-  DO jk = 1, kflev
-    DO jl = 1, kdlon
-      IF (pclear(jl)<1.) THEN
-        pcld(jl, jk) = pcldsw(jl, jk)/(1.-pclear(jl))
-      ELSE
-        pcld(jl, jk) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! *         1.4    COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
-  ! -----------------------------------------------
-
-
-  DO ja = 1, 2
-    DO jl = 1, kdlon
-      zud(jl, ja) = zud(jl, ja)*psec(jl)
-    END DO
-  END DO
-
-  CALL swtt1_lmdar4(2, 2, iind, zud, zr)
-
-  DO ja = 1, 2
-    DO jl = 1, kdlon
-      paki(jl, ja) = -log(zr(jl,ja))/zud(jl, ja)
-    END DO
-  END DO
-
-
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE swu_lmdar4
-SUBROUTINE sw1s_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
-    pcg, pcld, pclear, pcldsw, pdsig, pomega, poz, prmu, psec, ptau, pud, &
-    pfd, pfu)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: rsun, rray
-  USE infotrac_phy, ONLY: type_trac
-#ifdef REPROBUS
-  USE chem_rep, ONLY: rsuntime, ok_suntime
-  USE print_control_mod, ONLY: lunout
-#endif
-
-  IMPLICIT NONE
-
-  ! ------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-
-  ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
-  ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
-  ! CONTINUUM SCATTERING
-  ! 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-  ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! 94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
-  ! ------------------------------------------------------------------
-
-  ! * ARGUMENTS:
-
-  INTEGER knu
-  ! -OB
-  REAL (KIND=8) flag_aer
-  REAL (KIND=8) tauae(kdlon, kflev, 2)
-  REAL (KIND=8) pizae(kdlon, kflev, 2)
-  REAL (KIND=8) cgae(kdlon, kflev, 2)
-  REAL (KIND=8) paer(kdlon, kflev, 5)
-  REAL (KIND=8) palbd(kdlon, 2)
-  REAL (KIND=8) palbp(kdlon, 2)
-  REAL (KIND=8) pcg(kdlon, 2, kflev)
-  REAL (KIND=8) pcld(kdlon, kflev)
-  REAL (KIND=8) pcldsw(kdlon, kflev)
-  REAL (KIND=8) pclear(kdlon)
-  REAL (KIND=8) pdsig(kdlon, kflev)
-  REAL (KIND=8) pomega(kdlon, 2, kflev)
-  REAL (KIND=8) poz(kdlon, kflev)
-  REAL (KIND=8) prmu(kdlon)
-  REAL (KIND=8) psec(kdlon)
-  REAL (KIND=8) ptau(kdlon, 2, kflev)
-  REAL (KIND=8) pud(kdlon, 5, kflev+1)
-
-  REAL (KIND=8) pfd(kdlon, kflev+1)
-  REAL (KIND=8) pfu(kdlon, kflev+1)
-
-  ! * LOCAL VARIABLES:
-
-  INTEGER iind(4)
-
-  REAL (KIND=8) zcgaz(kdlon, kflev)
-  REAL (KIND=8) zdiff(kdlon)
-  REAL (KIND=8) zdirf(kdlon)
-  REAL (KIND=8) zpizaz(kdlon, kflev)
-  REAL (KIND=8) zrayl(kdlon)
-  REAL (KIND=8) zray1(kdlon, kflev+1)
-  REAL (KIND=8) zray2(kdlon, kflev+1)
-  REAL (KIND=8) zrefz(kdlon, 2, kflev+1)
-  REAL (KIND=8) zrj(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrj0(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrk(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrk0(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrmue(kdlon, kflev+1)
-  REAL (KIND=8) zrmu0(kdlon, kflev+1)
-  REAL (KIND=8) zr(kdlon, 4)
-  REAL (KIND=8) ztauaz(kdlon, kflev)
-  REAL (KIND=8) ztra1(kdlon, kflev+1)
-  REAL (KIND=8) ztra2(kdlon, kflev+1)
-  REAL (KIND=8) zw(kdlon, 4)
-
-  INTEGER jl, jk, k, jaj, ikm1, ikl
-
-  ! If running with Reporbus, overwrite default values of RSUN.
-  ! Otherwise keep default values from radiation_AR4_param module.
-  IF (type_trac=='repr') THEN
-#ifdef REPROBUS
-    IF (ok_suntime) THEN
-      rsun(1) = rsuntime(1)
-      rsun(2) = rsuntime(2)
-    END IF
-    WRITE (lunout, *) 'RSUN(1): ', rsun(1)
-#endif
-  END IF
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.     FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
-  ! ----------------------- ------------------
-
-
-
-  ! *         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
-  ! -----------------------------------------
-
-
-  DO jl = 1, kdlon
-    zrayl(jl) = rray(knu, 1) + prmu(jl)*(rray(knu,2)+prmu(jl)*(rray(knu, &
-      3)+prmu(jl)*(rray(knu,4)+prmu(jl)*(rray(knu,5)+prmu(jl)*rray(knu,6)))))
-  END DO
-
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.    CONTINUUM SCATTERING CALCULATIONS
-  ! ---------------------------------
-
-
-  ! *         2.1   CLEAR-SKY FRACTION OF THE COLUMN
-  ! --------------------------------
-
-
-  CALL swclr_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
-    zrayl, psec, zcgaz, zpizaz, zray1, zray2, zrefz, zrj0, zrk0, zrmu0, &
-    ztauaz, ztra1, ztra2)
-
-  ! *         2.2   CLOUDY FRACTION OF THE COLUMN
-  ! -----------------------------
-
-
-  CALL swr_lmdar4(knu, palbd, pcg, pcld, pdsig, pomega, zrayl, psec, ptau, &
-    zcgaz, zpizaz, zray1, zray2, zrefz, zrj, zrk, zrmue, ztauaz, ztra1, &
-    ztra2)
-
-  ! ------------------------------------------------------------------
-
-  ! *         3.    OZONE ABSORPTION
-  ! ----------------
-
-
-  iind(1) = 1
-  iind(2) = 3
-  iind(3) = 1
-  iind(4) = 3
-
-  ! *         3.1   DOWNWARD FLUXES
-  ! ---------------
-
-
-  jaj = 2
-
-  DO jl = 1, kdlon
-    zw(jl, 1) = 0.
-    zw(jl, 2) = 0.
-    zw(jl, 3) = 0.
-    zw(jl, 4) = 0.
-    pfd(jl, kflev+1) = ((1.-pclear(jl))*zrj(jl,jaj,kflev+1)+pclear(jl)*zrj0( &
-      jl,jaj,kflev+1))*rsun(knu)
-  END DO
-  DO jk = 1, kflev
-    ikl = kflev + 1 - jk
-    DO jl = 1, kdlon
-      zw(jl, 1) = zw(jl, 1) + pud(jl, 1, ikl)/zrmue(jl, ikl)
-      zw(jl, 2) = zw(jl, 2) + poz(jl, ikl)/zrmue(jl, ikl)
-      zw(jl, 3) = zw(jl, 3) + pud(jl, 1, ikl)/zrmu0(jl, ikl)
-      zw(jl, 4) = zw(jl, 4) + poz(jl, ikl)/zrmu0(jl, ikl)
-    END DO
-
-    CALL swtt1_lmdar4(knu, 4, iind, zw, zr)
-
-    DO jl = 1, kdlon
-      zdiff(jl) = zr(jl, 1)*zr(jl, 2)*zrj(jl, jaj, ikl)
-      zdirf(jl) = zr(jl, 3)*zr(jl, 4)*zrj0(jl, jaj, ikl)
-      pfd(jl, ikl) = ((1.-pclear(jl))*zdiff(jl)+pclear(jl)*zdirf(jl))* &
-        rsun(knu)
-    END DO
-  END DO
-
-  ! *         3.2   UPWARD FLUXES
-  ! -------------
-
-
-  DO jl = 1, kdlon
-    pfu(jl, 1) = ((1.-pclear(jl))*zdiff(jl)*palbd(jl,knu)+pclear(jl)*zdirf(jl &
-      )*palbp(jl,knu))*rsun(knu)
-  END DO
-
-  DO jk = 2, kflev + 1
-    ikm1 = jk - 1
-    DO jl = 1, kdlon
-      zw(jl, 1) = zw(jl, 1) + pud(jl, 1, ikm1)*1.66
-      zw(jl, 2) = zw(jl, 2) + poz(jl, ikm1)*1.66
-      zw(jl, 3) = zw(jl, 3) + pud(jl, 1, ikm1)*1.66
-      zw(jl, 4) = zw(jl, 4) + poz(jl, ikm1)*1.66
-    END DO
-
-    CALL swtt1_lmdar4(knu, 4, iind, zw, zr)
-
-    DO jl = 1, kdlon
-      zdiff(jl) = zr(jl, 1)*zr(jl, 2)*zrk(jl, jaj, jk)
-      zdirf(jl) = zr(jl, 3)*zr(jl, 4)*zrk0(jl, jaj, jk)
-      pfu(jl, jk) = ((1.-pclear(jl))*zdiff(jl)+pclear(jl)*zdirf(jl))* &
-        rsun(knu)
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE sw1s_lmdar4
-SUBROUTINE sw2s_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, paki, palbd, &
-    palbp, pcg, pcld, pclear, pcldsw, pdsig, pomega, poz, prmu, psec, ptau, &
-    pud, pwv, pqs, pfdown, pfup)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: rsun, rray
-  USE infotrac_phy, ONLY: type_trac
-#ifdef REPROBUS
-  USE chem_rep, ONLY: rsuntime, ok_suntime
-#endif
-
-  IMPLICIT NONE
-  include "radepsi.h"
-
-  ! ------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-
-  ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE
-  ! SECOND SPECTRAL INTERVAL FOLLOWING FOUQUART AND BONNEL (1980).
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO
-  ! CONTINUUM SCATTERING
-  ! 2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR
-  ! A GREY MOLECULAR ABSORPTION
-  ! 3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS
-  ! OF ABSORBERS
-  ! 4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS
-  ! 5. MULTIPLY BY OZONE TRANSMISSION FUNCTION
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-  ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! 94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
-  ! ------------------------------------------------------------------
-  ! * ARGUMENTS:
-
-  INTEGER knu
-  ! -OB
-  REAL (KIND=8) flag_aer
-  REAL (KIND=8) tauae(kdlon, kflev, 2)
-  REAL (KIND=8) pizae(kdlon, kflev, 2)
-  REAL (KIND=8) cgae(kdlon, kflev, 2)
-  REAL (KIND=8) paer(kdlon, kflev, 5)
-  REAL (KIND=8) paki(kdlon, 2)
-  REAL (KIND=8) palbd(kdlon, 2)
-  REAL (KIND=8) palbp(kdlon, 2)
-  REAL (KIND=8) pcg(kdlon, 2, kflev)
-  REAL (KIND=8) pcld(kdlon, kflev)
-  REAL (KIND=8) pcldsw(kdlon, kflev)
-  REAL (KIND=8) pclear(kdlon)
-  REAL (KIND=8) pdsig(kdlon, kflev)
-  REAL (KIND=8) pomega(kdlon, 2, kflev)
-  REAL (KIND=8) poz(kdlon, kflev)
-  REAL (KIND=8) pqs(kdlon, kflev)
-  REAL (KIND=8) prmu(kdlon)
-  REAL (KIND=8) psec(kdlon)
-  REAL (KIND=8) ptau(kdlon, 2, kflev)
-  REAL (KIND=8) pud(kdlon, 5, kflev+1)
-  REAL (KIND=8) pwv(kdlon, kflev)
-
-  REAL (KIND=8) pfdown(kdlon, kflev+1)
-  REAL (KIND=8) pfup(kdlon, kflev+1)
-
-  ! * LOCAL VARIABLES:
-
-  INTEGER iind2(2), iind3(3)
-  REAL (KIND=8) zcgaz(kdlon, kflev)
-  REAL (KIND=8) zfd(kdlon, kflev+1)
-  REAL (KIND=8) zfu(kdlon, kflev+1)
-  REAL (KIND=8) zg(kdlon)
-  REAL (KIND=8) zgg(kdlon)
-  REAL (KIND=8) zpizaz(kdlon, kflev)
-  REAL (KIND=8) zrayl(kdlon)
-  REAL (KIND=8) zray1(kdlon, kflev+1)
-  REAL (KIND=8) zray2(kdlon, kflev+1)
-  REAL (KIND=8) zref(kdlon)
-  REAL (KIND=8) zrefz(kdlon, 2, kflev+1)
-  REAL (KIND=8) zre1(kdlon)
-  REAL (KIND=8) zre2(kdlon)
-  REAL (KIND=8) zrj(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrj0(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrk(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrk0(kdlon, 6, kflev+1)
-  REAL (KIND=8) zrl(kdlon, 8)
-  REAL (KIND=8) zrmue(kdlon, kflev+1)
-  REAL (KIND=8) zrmu0(kdlon, kflev+1)
-  REAL (KIND=8) zrmuz(kdlon)
-  REAL (KIND=8) zrneb(kdlon)
-  REAL (KIND=8) zruef(kdlon, 8)
-  REAL (KIND=8) zr1(kdlon)
-  REAL (KIND=8) zr2(kdlon, 2)
-  REAL (KIND=8) zr3(kdlon, 3)
-  REAL (KIND=8) zr4(kdlon)
-  REAL (KIND=8) zr21(kdlon)
-  REAL (KIND=8) zr22(kdlon)
-  REAL (KIND=8) zs(kdlon)
-  REAL (KIND=8) ztauaz(kdlon, kflev)
-  REAL (KIND=8) zto1(kdlon)
-  REAL (KIND=8) ztr(kdlon, 2, kflev+1)
-  REAL (KIND=8) ztra1(kdlon, kflev+1)
-  REAL (KIND=8) ztra2(kdlon, kflev+1)
-  REAL (KIND=8) ztr1(kdlon)
-  REAL (KIND=8) ztr2(kdlon)
-  REAL (KIND=8) zw(kdlon)
-  REAL (KIND=8) zw1(kdlon)
-  REAL (KIND=8) zw2(kdlon, 2)
-  REAL (KIND=8) zw3(kdlon, 3)
-  REAL (KIND=8) zw4(kdlon)
-  REAL (KIND=8) zw5(kdlon)
-
-  INTEGER jl, jk, k, jaj, ikm1, ikl, jn, jabs, jkm1
-  INTEGER jref, jkl, jklp1, jajp, jkki, jkkp4, jn2j, iabs
-  REAL (KIND=8) zrmum1, zwh2o, zcneb, zaa, zbb, zrki, zre11
-
-  ! If running with Reporbus, overwrite default values of RSUN.
-  ! Otherwise keep default values from radiation_AR4_param module.
-  IF (type_trac=='repr') THEN
-#ifdef REPROBUS
-    IF (ok_suntime) THEN
-      rsun(1) = rsuntime(1)
-      rsun(2) = rsuntime(2)
-    END IF
-#endif
-  END IF
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.     SECOND SPECTRAL INTERVAL (0.68-4.00 MICRON)
-  ! -------------------------------------------
-
-
-
-  ! *         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
-  ! -----------------------------------------
-
-
-  DO jl = 1, kdlon
-    zrmum1 = 1. - prmu(jl)
-    zrayl(jl) = rray(knu, 1) + zrmum1*(rray(knu,2)+zrmum1*(rray(knu, &
-      3)+zrmum1*(rray(knu,4)+zrmum1*(rray(knu,5)+zrmum1*rray(knu,6)))))
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.    CONTINUUM SCATTERING CALCULATIONS
-  ! ---------------------------------
-
-
-  ! *         2.1   CLEAR-SKY FRACTION OF THE COLUMN
-  ! --------------------------------
-
-
-  CALL swclr_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
-    zrayl, psec, zcgaz, zpizaz, zray1, zray2, zrefz, zrj0, zrk0, zrmu0, &
-    ztauaz, ztra1, ztra2)
-
-  ! *         2.2   CLOUDY FRACTION OF THE COLUMN
-  ! -----------------------------
-
-
-  CALL swr_lmdar4(knu, palbd, pcg, pcld, pdsig, pomega, zrayl, psec, ptau, &
-    zcgaz, zpizaz, zray1, zray2, zrefz, zrj, zrk, zrmue, ztauaz, ztra1, &
-    ztra2)
-
-  ! ------------------------------------------------------------------
-
-  ! *         3.    SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION
-  ! ------------------------------------------------------
-
-
-  jn = 2
-
-  DO jabs = 1, 2
-    ! *         3.1  SURFACE CONDITIONS
-    ! ------------------
-
-
-    DO jl = 1, kdlon
-      zrefz(jl, 2, 1) = palbd(jl, knu)
-      zrefz(jl, 1, 1) = palbd(jl, knu)
-    END DO
-
-    ! *         3.2  INTRODUCING CLOUD EFFECTS
-    ! -------------------------
-
-
-    DO jk = 2, kflev + 1
-      jkm1 = jk - 1
-      ikl = kflev + 1 - jkm1
-      DO jl = 1, kdlon
-        zrneb(jl) = pcld(jl, jkm1)
-        IF (jabs==1 .AND. zrneb(jl)>2.*zeelog) THEN
-          zwh2o = max(pwv(jl,jkm1), zeelog)
-          zcneb = max(zeelog, min(zrneb(jl),1.-zeelog))
-          zbb = pud(jl, jabs, jkm1)*pqs(jl, jkm1)/zwh2o
-          zaa = max((pud(jl,jabs,jkm1)-zcneb*zbb)/(1.-zcneb), zeelog)
-        ELSE
-          zaa = pud(jl, jabs, jkm1)
-          zbb = zaa
-        END IF
-        zrki = paki(jl, jabs)
-        zs(jl) = exp(-zrki*zaa*1.66)
-        zg(jl) = exp(-zrki*zaa/zrmue(jl,jk))
-        ztr1(jl) = 0.
-        zre1(jl) = 0.
-        ztr2(jl) = 0.
-        zre2(jl) = 0.
-
-        zw(jl) = pomega(jl, knu, jkm1)
-        zto1(jl) = ptau(jl, knu, jkm1)/zw(jl) + ztauaz(jl, jkm1)/zpizaz(jl, &
-          jkm1) + zbb*zrki
-
-        zr21(jl) = ptau(jl, knu, jkm1) + ztauaz(jl, jkm1)
-        zr22(jl) = ptau(jl, knu, jkm1)/zr21(jl)
-        zgg(jl) = zr22(jl)*pcg(jl, knu, jkm1) + (1.-zr22(jl))*zcgaz(jl, jkm1)
-        zw(jl) = zr21(jl)/zto1(jl)
-        zref(jl) = zrefz(jl, 1, jkm1)
-        zrmuz(jl) = zrmue(jl, jk)
-      END DO
-
-      CALL swde_lmdar4(zgg, zref, zrmuz, zto1, zw, zre1, zre2, ztr1, ztr2)
-
-      DO jl = 1, kdlon
-
-        zrefz(jl, 2, jk) = (1.-zrneb(jl))*(zray1(jl,jkm1)+zrefz(jl,2,jkm1)* &
-          ztra1(jl,jkm1)*ztra2(jl,jkm1))*zg(jl)*zs(jl) + zrneb(jl)*zre1(jl)
-
-        ztr(jl, 2, jkm1) = zrneb(jl)*ztr1(jl) + (ztra1(jl,jkm1))*zg(jl)*(1.- &
-          zrneb(jl))
-
-        zrefz(jl, 1, jk) = (1.-zrneb(jl))*(zray1(jl,jkm1)+zrefz(jl,1,jkm1)* &
-          ztra1(jl,jkm1)*ztra2(jl,jkm1)/(1.-zray2(jl,jkm1)*zrefz(jl,1, &
-          jkm1)))*zg(jl)*zs(jl) + zrneb(jl)*zre2(jl)
-
-        ztr(jl, 1, jkm1) = zrneb(jl)*ztr2(jl) + (ztra1(jl,jkm1)/(1.-zray2(jl, &
-          jkm1)*zrefz(jl,1,jkm1)))*zg(jl)*(1.-zrneb(jl))
-
-      END DO
-    END DO
-
-    ! *         3.3  REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
-    ! -------------------------------------------------
-
-
-    DO jref = 1, 2
-
-      jn = jn + 1
-
-      DO jl = 1, kdlon
-        zrj(jl, jn, kflev+1) = 1.
-        zrk(jl, jn, kflev+1) = zrefz(jl, jref, kflev+1)
-      END DO
-
-      DO jk = 1, kflev
-        jkl = kflev + 1 - jk
-        jklp1 = jkl + 1
-        DO jl = 1, kdlon
-          zre11 = zrj(jl, jn, jklp1)*ztr(jl, jref, jkl)
-          zrj(jl, jn, jkl) = zre11
-          zrk(jl, jn, jkl) = zre11*zrefz(jl, jref, jkl)
-        END DO
-      END DO
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         4.    INVERT GREY AND CONTINUUM FLUXES
-  ! --------------------------------
-
-
-
-  ! *         4.1   UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES
-  ! ---------------------------------------------
-
-
-  DO jk = 1, kflev + 1
-    DO jaj = 1, 5, 2
-      jajp = jaj + 1
-      DO jl = 1, kdlon
-        zrj(jl, jaj, jk) = zrj(jl, jaj, jk) - zrj(jl, jajp, jk)
-        zrk(jl, jaj, jk) = zrk(jl, jaj, jk) - zrk(jl, jajp, jk)
-        zrj(jl, jaj, jk) = max(zrj(jl,jaj,jk), zeelog)
-        zrk(jl, jaj, jk) = max(zrk(jl,jaj,jk), zeelog)
-      END DO
-    END DO
-  END DO
-
-  DO jk = 1, kflev + 1
-    DO jaj = 2, 6, 2
-      DO jl = 1, kdlon
-        zrj(jl, jaj, jk) = max(zrj(jl,jaj,jk), zeelog)
-        zrk(jl, jaj, jk) = max(zrk(jl,jaj,jk), zeelog)
-      END DO
-    END DO
-  END DO
-
-  ! *         4.2    EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE
-  ! ---------------------------------------------
-
-
-  DO jk = 1, kflev + 1
-    jkki = 1
-    DO jaj = 1, 2
-      iind2(1) = jaj
-      iind2(2) = jaj
-      DO jn = 1, 2
-        jn2j = jn + 2*jaj
-        jkkp4 = jkki + 4
-
-        ! *         4.2.1  EFFECTIVE ABSORBER AMOUNTS
-        ! --------------------------
-
-
-        DO jl = 1, kdlon
-          zw2(jl, 1) = log(zrj(jl,jn,jk)/zrj(jl,jn2j,jk))/paki(jl, jaj)
-          zw2(jl, 2) = log(zrk(jl,jn,jk)/zrk(jl,jn2j,jk))/paki(jl, jaj)
-        END DO
-
-        ! *         4.2.2  TRANSMISSION FUNCTION
-        ! ---------------------
-
-
-        CALL swtt1_lmdar4(knu, 2, iind2, zw2, zr2)
-
-        DO jl = 1, kdlon
-          zrl(jl, jkki) = zr2(jl, 1)
-          zruef(jl, jkki) = zw2(jl, 1)
-          zrl(jl, jkkp4) = zr2(jl, 2)
-          zruef(jl, jkkp4) = zw2(jl, 2)
-        END DO
-
-        jkki = jkki + 1
-      END DO
-    END DO
-
-    ! *         4.3    UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION
-    ! ------------------------------------------------------
-
-
-    DO jl = 1, kdlon
-      pfdown(jl, jk) = zrj(jl, 1, jk)*zrl(jl, 1)*zrl(jl, 3) + &
-        zrj(jl, 2, jk)*zrl(jl, 2)*zrl(jl, 4)
-      pfup(jl, jk) = zrk(jl, 1, jk)*zrl(jl, 5)*zrl(jl, 7) + &
-        zrk(jl, 2, jk)*zrl(jl, 6)*zrl(jl, 8)
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         5.    MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES
-  ! ----------------------------------------
-
-
-
-  ! *         5.1   DOWNWARD FLUXES
-  ! ---------------
-
-
-  jaj = 2
-  iind3(1) = 1
-  iind3(2) = 2
-  iind3(3) = 3
-
-  DO jl = 1, kdlon
-    zw3(jl, 1) = 0.
-    zw3(jl, 2) = 0.
-    zw3(jl, 3) = 0.
-    zw4(jl) = 0.
-    zw5(jl) = 0.
-    zr4(jl) = 1.
-    zfd(jl, kflev+1) = zrj0(jl, jaj, kflev+1)
-  END DO
-  DO jk = 1, kflev
-    ikl = kflev + 1 - jk
-    DO jl = 1, kdlon
-      zw3(jl, 1) = zw3(jl, 1) + pud(jl, 1, ikl)/zrmu0(jl, ikl)
-      zw3(jl, 2) = zw3(jl, 2) + pud(jl, 2, ikl)/zrmu0(jl, ikl)
-      zw3(jl, 3) = zw3(jl, 3) + poz(jl, ikl)/zrmu0(jl, ikl)
-      zw4(jl) = zw4(jl) + pud(jl, 4, ikl)/zrmu0(jl, ikl)
-      zw5(jl) = zw5(jl) + pud(jl, 5, ikl)/zrmu0(jl, ikl)
-    END DO
-
-    CALL swtt1_lmdar4(knu, 3, iind3, zw3, zr3)
-
-    DO jl = 1, kdlon
-      ! ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
-      zfd(jl, ikl) = zr3(jl, 1)*zr3(jl, 2)*zr3(jl, 3)*zr4(jl)* &
-        zrj0(jl, jaj, ikl)
-    END DO
-  END DO
-
-  ! *         5.2   UPWARD FLUXES
-  ! -------------
-
-
-  DO jl = 1, kdlon
-    zfu(jl, 1) = zfd(jl, 1)*palbp(jl, knu)
-  END DO
-
-  DO jk = 2, kflev + 1
-    ikm1 = jk - 1
-    DO jl = 1, kdlon
-      zw3(jl, 1) = zw3(jl, 1) + pud(jl, 1, ikm1)*1.66
-      zw3(jl, 2) = zw3(jl, 2) + pud(jl, 2, ikm1)*1.66
-      zw3(jl, 3) = zw3(jl, 3) + poz(jl, ikm1)*1.66
-      zw4(jl) = zw4(jl) + pud(jl, 4, ikm1)*1.66
-      zw5(jl) = zw5(jl) + pud(jl, 5, ikm1)*1.66
-    END DO
-
-    CALL swtt1_lmdar4(knu, 3, iind3, zw3, zr3)
-
-    DO jl = 1, kdlon
-      ! ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
-      zfu(jl, jk) = zr3(jl, 1)*zr3(jl, 2)*zr3(jl, 3)*zr4(jl)* &
-        zrk0(jl, jaj, jk)
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         6.     INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION
-  ! --------------------------------------------------
-
-  iabs = 3
-
-  ! *         6.1    DOWNWARD FLUXES
-  ! ---------------
-
-  DO jl = 1, kdlon
-    zw1(jl) = 0.
-    zw4(jl) = 0.
-    zw5(jl) = 0.
-    zr1(jl) = 0.
-    pfdown(jl, kflev+1) = ((1.-pclear(jl))*pfdown(jl,kflev+1)+pclear(jl)*zfd( &
-      jl,kflev+1))*rsun(knu)
-  END DO
-
-  DO jk = 1, kflev
-    ikl = kflev + 1 - jk
-    DO jl = 1, kdlon
-      zw1(jl) = zw1(jl) + poz(jl, ikl)/zrmue(jl, ikl)
-      zw4(jl) = zw4(jl) + pud(jl, 4, ikl)/zrmue(jl, ikl)
-      zw5(jl) = zw5(jl) + pud(jl, 5, ikl)/zrmue(jl, ikl)
-      ! ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
-    END DO
-
-    CALL swtt_lmdar4(knu, iabs, zw1, zr1)
-
-    DO jl = 1, kdlon
-      pfdown(jl, ikl) = ((1.-pclear(jl))*zr1(jl)*zr4(jl)*pfdown(jl,ikl)+ &
-        pclear(jl)*zfd(jl,ikl))*rsun(knu)
-    END DO
-  END DO
-
-  ! *         6.2    UPWARD FLUXES
-  ! -------------
-
-  DO jl = 1, kdlon
-    pfup(jl, 1) = ((1.-pclear(jl))*zr1(jl)*zr4(jl)*pfup(jl,1)+pclear(jl)*zfu( &
-      jl,1))*rsun(knu)
-  END DO
-
-  DO jk = 2, kflev + 1
-    ikm1 = jk - 1
-    DO jl = 1, kdlon
-      zw1(jl) = zw1(jl) + poz(jl, ikm1)*1.66
-      zw4(jl) = zw4(jl) + pud(jl, 4, ikm1)*1.66
-      zw5(jl) = zw5(jl) + pud(jl, 5, ikm1)*1.66
-      ! ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
-    END DO
-
-    CALL swtt_lmdar4(knu, iabs, zw1, zr1)
-
-    DO jl = 1, kdlon
-      pfup(jl, jk) = ((1.-pclear(jl))*zr1(jl)*zr4(jl)*pfup(jl,jk)+pclear(jl)* &
-        zfu(jl,jk))*rsun(knu)
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE sw2s_lmdar4
-SUBROUTINE swclr_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbp, &
-    pdsig, prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, &
-    ptauaz, ptra1, ptra2)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: taua, rpiza, rcga
-  IMPLICIT NONE
-  include "radepsi.h"
-  include "radopt.h"
-
-  ! ------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
-  ! CLEAR-SKY COLUMN
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-  ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 94-11-15
-  ! ------------------------------------------------------------------
-  ! * ARGUMENTS:
-
-  INTEGER knu
-  ! -OB
-  REAL (KIND=8) flag_aer
-  REAL (KIND=8) tauae(kdlon, kflev, 2)
-  REAL (KIND=8) pizae(kdlon, kflev, 2)
-  REAL (KIND=8) cgae(kdlon, kflev, 2)
-  REAL (KIND=8) paer(kdlon, kflev, 5)
-  REAL (KIND=8) palbp(kdlon, 2)
-  REAL (KIND=8) pdsig(kdlon, kflev)
-  REAL (KIND=8) prayl(kdlon)
-  REAL (KIND=8) psec(kdlon)
-
-  REAL (KIND=8) pcgaz(kdlon, kflev)
-  REAL (KIND=8) ppizaz(kdlon, kflev)
-  REAL (KIND=8) pray1(kdlon, kflev+1)
-  REAL (KIND=8) pray2(kdlon, kflev+1)
-  REAL (KIND=8) prefz(kdlon, 2, kflev+1)
-  REAL (KIND=8) prj(kdlon, 6, kflev+1)
-  REAL (KIND=8) prk(kdlon, 6, kflev+1)
-  REAL (KIND=8) prmu0(kdlon, kflev+1)
-  REAL (KIND=8) ptauaz(kdlon, kflev)
-  REAL (KIND=8) ptra1(kdlon, kflev+1)
-  REAL (KIND=8) ptra2(kdlon, kflev+1)
-
-  ! * LOCAL VARIABLES:
-
-  REAL (KIND=8) zc0i(kdlon, kflev+1)
-  REAL (KIND=8) zcle0(kdlon, kflev)
-  REAL (KIND=8) zclear(kdlon)
-  REAL (KIND=8) zr21(kdlon)
-  REAL (KIND=8) zr23(kdlon)
-  REAL (KIND=8) zss0(kdlon)
-  REAL (KIND=8) zscat(kdlon)
-  REAL (KIND=8) ztr(kdlon, 2, kflev+1)
-
-  INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in
-  REAL (KIND=8) ztray, zgar, zratio, zff, zfacoa, zcorae
-  REAL (KIND=8) zmue, zgap, zww, zto, zden, zmu1, zden1
-  REAL (KIND=8) zbmu0, zbmu1, zre11
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
-  ! --------------------------------------------
-
-
-  ! cdir collapse
-  DO jk = 1, kflev + 1
-    DO ja = 1, 6
-      DO jl = 1, kdlon
-        prj(jl, ja, jk) = 0.
-        prk(jl, ja, jk) = 0.
-      END DO
-    END DO
-  END DO
-
-  DO jk = 1, kflev
-    ! -OB
-    ! DO 104 JL = 1, KDLON
-    ! PCGAZ(JL,JK) = 0.
-    ! PPIZAZ(JL,JK) =  0.
-    ! PTAUAZ(JL,JK) = 0.
-    ! 104  CONTINUE
-    ! -OB
-    ! DO 106 JAE=1,5
-    ! DO 105 JL = 1, KDLON
-    ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)
-    ! S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)
-    ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)
-    ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)
-    ! PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)
-    ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
-    ! 105  CONTINUE
-    ! 106  CONTINUE
-    ! -OB
-    DO jl = 1, kdlon
-      ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)
-      ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)
-      pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)
-    END DO
-
-    IF (flag_aer>0) THEN
-      ! -OB
-      DO jl = 1, kdlon
-        ! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
-        ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
-        ztray = prayl(jl)*pdsig(jl, jk)
-        zratio = ztray/(ztray+ptauaz(jl,jk))
-        zgar = pcgaz(jl, jk)
-        zff = zgar*zgar
-        ptauaz(jl, jk) = ztray + ptauaz(jl, jk)*(1.-ppizaz(jl,jk)*zff)
-        pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)
-        ppizaz(jl, jk) = zratio + (1.-zratio)*ppizaz(jl, jk)*(1.-zff)/(1.- &
-          ppizaz(jl,jk)*zff)
-      END DO
-    ELSE
-      DO jl = 1, kdlon
-        ztray = prayl(jl)*pdsig(jl, jk)
-        ptauaz(jl, jk) = ztray
-        pcgaz(jl, jk) = 0.
-        ppizaz(jl, jk) = 1. - repsct
-      END DO
-    END IF ! check flag_aer
-    ! 107  CONTINUE
-    ! PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)
-    ! $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)
-    ! 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)
-
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
-  ! ----------------------------------------------
-
-
-  DO jl = 1, kdlon
-    zr23(jl) = 0.
-    zc0i(jl, kflev+1) = 0.
-    zclear(jl) = 1.
-    zscat(jl) = 0.
-  END DO
-
-  jk = 1
-  jkl = kflev + 1 - jk
-  jklp1 = jkl + 1
-  DO jl = 1, kdlon
-    zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
-    zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
-    zr21(jl) = exp(-zcorae)
-    zss0(jl) = 1. - zr21(jl)
-    zcle0(jl, jkl) = zss0(jl)
-
-    IF (novlp==1) THEN
-      ! * maximum-random
-      zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
-        (1.0-min(zscat(jl),1.-zepsec))
-      zc0i(jl, jkl) = 1.0 - zclear(jl)
-      zscat(jl) = zss0(jl)
-    ELSE IF (novlp==2) THEN
-      ! * maximum
-      zscat(jl) = max(zss0(jl), zscat(jl))
-      zc0i(jl, jkl) = zscat(jl)
-    ELSE IF (novlp==3) THEN
-      ! * random
-      zclear(jl) = zclear(jl)*(1.0-zss0(jl))
-      zscat(jl) = 1.0 - zclear(jl)
-      zc0i(jl, jkl) = zscat(jl)
-    END IF
-  END DO
-
-  DO jk = 2, kflev
-    jkl = kflev + 1 - jk
-    jklp1 = jkl + 1
-    DO jl = 1, kdlon
-      zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
-      zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
-      zr21(jl) = exp(-zcorae)
-      zss0(jl) = 1. - zr21(jl)
-      zcle0(jl, jkl) = zss0(jl)
-
-      IF (novlp==1) THEN
-        ! * maximum-random
-        zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
-          (1.0-min(zscat(jl),1.-zepsec))
-        zc0i(jl, jkl) = 1.0 - zclear(jl)
-        zscat(jl) = zss0(jl)
-      ELSE IF (novlp==2) THEN
-        ! * maximum
-        zscat(jl) = max(zss0(jl), zscat(jl))
-        zc0i(jl, jkl) = zscat(jl)
-      ELSE IF (novlp==3) THEN
-        ! * random
-        zclear(jl) = zclear(jl)*(1.0-zss0(jl))
-        zscat(jl) = 1.0 - zclear(jl)
-        zc0i(jl, jkl) = zscat(jl)
-      END IF
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
-  ! -----------------------------------------------
-
-
-  DO jl = 1, kdlon
-    pray1(jl, kflev+1) = 0.
-    pray2(jl, kflev+1) = 0.
-    prefz(jl, 2, 1) = palbp(jl, knu)
-    prefz(jl, 1, 1) = palbp(jl, knu)
-    ptra1(jl, kflev+1) = 1.
-    ptra2(jl, kflev+1) = 1.
-  END DO
-
-  DO jk = 2, kflev + 1
-    jkm1 = jk - 1
-    DO jl = 1, kdlon
-
-      ! ------------------------------------------------------------------
-
-      ! *         3.1  EQUIVALENT ZENITH ANGLE
-      ! -----------------------
-
-
-      zmue = (1.-zc0i(jl,jk))*psec(jl) + zc0i(jl, jk)*1.66
-      prmu0(jl, jk) = 1./zmue
-
-      ! ------------------------------------------------------------------
-
-      ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
-      ! ----------------------------------------------------
-
-
-      zgap = pcgaz(jl, jkm1)
-      zbmu0 = 0.5 - 0.75*zgap/zmue
-      zww = ppizaz(jl, jkm1)
-      zto = ptauaz(jl, jkm1)
-      zden = 1. + (1.-zww+zbmu0*zww)*zto*zmue + (1-zww)*(1.-zww+2.*zbmu0*zww) &
-        *zto*zto*zmue*zmue
-      pray1(jl, jkm1) = zbmu0*zww*zto*zmue/zden
-      ptra1(jl, jkm1) = 1./zden
-
-      zmu1 = 0.5
-      zbmu1 = 0.5 - 0.75*zgap*zmu1
-      zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &
-        )*zto*zto/zmu1/zmu1
-      pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1
-      ptra2(jl, jkm1) = 1./zden1
-
-
-
-      prefz(jl, 1, jk) = (pray1(jl,jkm1)+prefz(jl,1,jkm1)*ptra1(jl,jkm1)* &
-        ptra2(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1,jkm1)))
-
-      ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
-        jkm1)))
-
-      prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)*ptra1(jl,jkm1)* &
-        ptra2(jl,jkm1))
-
-      ztr(jl, 2, jkm1) = ptra1(jl, jkm1)
-
-    END DO
-  END DO
-  DO jl = 1, kdlon
-    zmue = (1.-zc0i(jl,1))*psec(jl) + zc0i(jl, 1)*1.66
-    prmu0(jl, 1) = 1./zmue
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
-  ! -------------------------------------------------
-
-
-  IF (knu==1) THEN
-    jaj = 2
-    DO jl = 1, kdlon
-      prj(jl, jaj, kflev+1) = 1.
-      prk(jl, jaj, kflev+1) = prefz(jl, 1, kflev+1)
-    END DO
-
-    DO jk = 1, kflev
-      jkl = kflev + 1 - jk
-      jklp1 = jkl + 1
-      DO jl = 1, kdlon
-        zre11 = prj(jl, jaj, jklp1)*ztr(jl, 1, jkl)
-        prj(jl, jaj, jkl) = zre11
-        prk(jl, jaj, jkl) = zre11*prefz(jl, 1, jkl)
-      END DO
-    END DO
-
-  ELSE
-
-    DO jaj = 1, 2
-      DO jl = 1, kdlon
-        prj(jl, jaj, kflev+1) = 1.
-        prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)
-      END DO
-
-      DO jk = 1, kflev
-        jkl = kflev + 1 - jk
-        jklp1 = jkl + 1
-        DO jl = 1, kdlon
-          zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)
-          prj(jl, jaj, jkl) = zre11
-          prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)
-        END DO
-      END DO
-    END DO
-
-  END IF
-
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE swclr_lmdar4
-SUBROUTINE swr_lmdar4(knu, palbd, pcg, pcld, pdsig, pomega, prayl, psec, &
-    ptau, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmue, ptauaz, ptra1, &
-    ptra2)
-  USE dimphy
-  IMPLICIT NONE
-  include "radepsi.h"
-  include "radopt.h"
-
-  ! ------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
-  ! CONTINUUM SCATTERING
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL
-  ! OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION)
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-  ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! ------------------------------------------------------------------
-  ! * ARGUMENTS:
-
-  INTEGER knu
-  REAL (KIND=8) palbd(kdlon, 2)
-  REAL (KIND=8) pcg(kdlon, 2, kflev)
-  REAL (KIND=8) pcld(kdlon, kflev)
-  REAL (KIND=8) pdsig(kdlon, kflev)
-  REAL (KIND=8) pomega(kdlon, 2, kflev)
-  REAL (KIND=8) prayl(kdlon)
-  REAL (KIND=8) psec(kdlon)
-  REAL (KIND=8) ptau(kdlon, 2, kflev)
-
-  REAL (KIND=8) pray1(kdlon, kflev+1)
-  REAL (KIND=8) pray2(kdlon, kflev+1)
-  REAL (KIND=8) prefz(kdlon, 2, kflev+1)
-  REAL (KIND=8) prj(kdlon, 6, kflev+1)
-  REAL (KIND=8) prk(kdlon, 6, kflev+1)
-  REAL (KIND=8) prmue(kdlon, kflev+1)
-  REAL (KIND=8) pcgaz(kdlon, kflev)
-  REAL (KIND=8) ppizaz(kdlon, kflev)
-  REAL (KIND=8) ptauaz(kdlon, kflev)
-  REAL (KIND=8) ptra1(kdlon, kflev+1)
-  REAL (KIND=8) ptra2(kdlon, kflev+1)
-
-  ! * LOCAL VARIABLES:
-
-  REAL (KIND=8) zc1i(kdlon, kflev+1)
-  REAL (KIND=8) zcleq(kdlon, kflev)
-  REAL (KIND=8) zclear(kdlon)
-  REAL (KIND=8) zcloud(kdlon)
-  REAL (KIND=8) zgg(kdlon)
-  REAL (KIND=8) zref(kdlon)
-  REAL (KIND=8) zre1(kdlon)
-  REAL (KIND=8) zre2(kdlon)
-  REAL (KIND=8) zrmuz(kdlon)
-  REAL (KIND=8) zrneb(kdlon)
-  REAL (KIND=8) zr21(kdlon)
-  REAL (KIND=8) zr22(kdlon)
-  REAL (KIND=8) zr23(kdlon)
-  REAL (KIND=8) zss1(kdlon)
-  REAL (KIND=8) zto1(kdlon)
-  REAL (KIND=8) ztr(kdlon, 2, kflev+1)
-  REAL (KIND=8) ztr1(kdlon)
-  REAL (KIND=8) ztr2(kdlon)
-  REAL (KIND=8) zw(kdlon)
-
-  INTEGER jk, jl, ja, jkl, jklp1, jkm1, jaj
-  REAL (KIND=8) zfacoa, zfacoc, zcorae, zcorcd
-  REAL (KIND=8) zmue, zgap, zww, zto, zden, zden1
-  REAL (KIND=8) zmu1, zre11, zbmu0, zbmu1
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.    INITIALIZATION
-  ! --------------
-
-
-  DO jk = 1, kflev + 1
-    DO ja = 1, 6
-      DO jl = 1, kdlon
-        prj(jl, ja, jk) = 0.
-        prk(jl, ja, jk) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
-  ! ----------------------------------------------
-
-
-  DO jl = 1, kdlon
-    zr23(jl) = 0.
-    zc1i(jl, kflev+1) = 0.
-    zclear(jl) = 1.
-    zcloud(jl) = 0.
-  END DO
-
-  jk = 1
-  jkl = kflev + 1 - jk
-  jklp1 = jkl + 1
-  DO jl = 1, kdlon
-    zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
-    zfacoc = 1. - pomega(jl, knu, jkl)*pcg(jl, knu, jkl)*pcg(jl, knu, jkl)
-    zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
-    zcorcd = zfacoc*ptau(jl, knu, jkl)*psec(jl)
-    zr21(jl) = exp(-zcorae)
-    zr22(jl) = exp(-zcorcd)
-    zss1(jl) = pcld(jl, jkl)*(1.0-zr21(jl)*zr22(jl)) + &
-      (1.0-pcld(jl,jkl))*(1.0-zr21(jl))
-    zcleq(jl, jkl) = zss1(jl)
-
-    IF (novlp==1) THEN
-      ! * maximum-random
-      zclear(jl) = zclear(jl)*(1.0-max(zss1(jl),zcloud(jl)))/ &
-        (1.0-min(zcloud(jl),1.-zepsec))
-      zc1i(jl, jkl) = 1.0 - zclear(jl)
-      zcloud(jl) = zss1(jl)
-    ELSE IF (novlp==2) THEN
-      ! * maximum
-      zcloud(jl) = max(zss1(jl), zcloud(jl))
-      zc1i(jl, jkl) = zcloud(jl)
-    ELSE IF (novlp==3) THEN
-      ! * random
-      zclear(jl) = zclear(jl)*(1.0-zss1(jl))
-      zcloud(jl) = 1.0 - zclear(jl)
-      zc1i(jl, jkl) = zcloud(jl)
-    END IF
-  END DO
-
-  DO jk = 2, kflev
-    jkl = kflev + 1 - jk
-    jklp1 = jkl + 1
-    DO jl = 1, kdlon
-      zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
-      zfacoc = 1. - pomega(jl, knu, jkl)*pcg(jl, knu, jkl)*pcg(jl, knu, jkl)
-      zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
-      zcorcd = zfacoc*ptau(jl, knu, jkl)*psec(jl)
-      zr21(jl) = exp(-zcorae)
-      zr22(jl) = exp(-zcorcd)
-      zss1(jl) = pcld(jl, jkl)*(1.0-zr21(jl)*zr22(jl)) + &
-        (1.0-pcld(jl,jkl))*(1.0-zr21(jl))
-      zcleq(jl, jkl) = zss1(jl)
-
-      IF (novlp==1) THEN
-        ! * maximum-random
-        zclear(jl) = zclear(jl)*(1.0-max(zss1(jl),zcloud(jl)))/ &
-          (1.0-min(zcloud(jl),1.-zepsec))
-        zc1i(jl, jkl) = 1.0 - zclear(jl)
-        zcloud(jl) = zss1(jl)
-      ELSE IF (novlp==2) THEN
-        ! * maximum
-        zcloud(jl) = max(zss1(jl), zcloud(jl))
-        zc1i(jl, jkl) = zcloud(jl)
-      ELSE IF (novlp==3) THEN
-        ! * random
-        zclear(jl) = zclear(jl)*(1.0-zss1(jl))
-        zcloud(jl) = 1.0 - zclear(jl)
-        zc1i(jl, jkl) = zcloud(jl)
-      END IF
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
-  ! -----------------------------------------------
-
-
-  DO jl = 1, kdlon
-    pray1(jl, kflev+1) = 0.
-    pray2(jl, kflev+1) = 0.
-    prefz(jl, 2, 1) = palbd(jl, knu)
-    prefz(jl, 1, 1) = palbd(jl, knu)
-    ptra1(jl, kflev+1) = 1.
-    ptra2(jl, kflev+1) = 1.
-  END DO
-
-  DO jk = 2, kflev + 1
-    jkm1 = jk - 1
-    DO jl = 1, kdlon
-      zrneb(jl) = pcld(jl, jkm1)
-      zre1(jl) = 0.
-      ztr1(jl) = 0.
-      zre2(jl) = 0.
-      ztr2(jl) = 0.
-
-      ! ------------------------------------------------------------------
-
-      ! *         3.1  EQUIVALENT ZENITH ANGLE
-      ! -----------------------
-
-
-      zmue = (1.-zc1i(jl,jk))*psec(jl) + zc1i(jl, jk)*1.66
-      prmue(jl, jk) = 1./zmue
-
-      ! ------------------------------------------------------------------
-
-      ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
-      ! ----------------------------------------------------
-
-
-      zgap = pcgaz(jl, jkm1)
-      zbmu0 = 0.5 - 0.75*zgap/zmue
-      zww = ppizaz(jl, jkm1)
-      zto = ptauaz(jl, jkm1)
-      zden = 1. + (1.-zww+zbmu0*zww)*zto*zmue + (1-zww)*(1.-zww+2.*zbmu0*zww) &
-        *zto*zto*zmue*zmue
-      pray1(jl, jkm1) = zbmu0*zww*zto*zmue/zden
-      ptra1(jl, jkm1) = 1./zden
-      ! PRINT *,' LOOP 342 ** 3 ** JL=',JL,PRAY1(JL,JKM1),PTRA1(JL,JKM1)
-
-      zmu1 = 0.5
-      zbmu1 = 0.5 - 0.75*zgap*zmu1
-      zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &
-        )*zto*zto/zmu1/zmu1
-      pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1
-      ptra2(jl, jkm1) = 1./zden1
-
-      ! ------------------------------------------------------------------
-
-      ! *         3.3  EFFECT OF CLOUD LAYER
-      ! ---------------------
-
-
-      zw(jl) = pomega(jl, knu, jkm1)
-      zto1(jl) = ptau(jl, knu, jkm1)/zw(jl) + ptauaz(jl, jkm1)/ppizaz(jl, &
-        jkm1)
-      zr21(jl) = ptau(jl, knu, jkm1) + ptauaz(jl, jkm1)
-      zr22(jl) = ptau(jl, knu, jkm1)/zr21(jl)
-      zgg(jl) = zr22(jl)*pcg(jl, knu, jkm1) + (1.-zr22(jl))*pcgaz(jl, jkm1)
-      ! Modif PhD - JJM 19/03/96 pour erreurs arrondis
-      ! machine
-      ! PHD PROTECTION ZW(JL) = ZR21(JL) / ZTO1(JL)
-      IF (zw(jl)==1. .AND. ppizaz(jl,jkm1)==1.) THEN
-        zw(jl) = 1.
-      ELSE
-        zw(jl) = zr21(jl)/zto1(jl)
-      END IF
-      zref(jl) = prefz(jl, 1, jkm1)
-      zrmuz(jl) = prmue(jl, jk)
-    END DO
-
-    CALL swde_lmdar4(zgg, zref, zrmuz, zto1, zw, zre1, zre2, ztr1, ztr2)
-
-    DO jl = 1, kdlon
-
-      prefz(jl, 1, jk) = (1.-zrneb(jl))*(pray1(jl,jkm1)+prefz(jl,1,jkm1)* &
-        ptra1(jl,jkm1)*ptra2(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
-        jkm1))) + zrneb(jl)*zre2(jl)
-
-      ztr(jl, 1, jkm1) = zrneb(jl)*ztr2(jl) + (ptra1(jl,jkm1)/(1.-pray2(jl, &
-        jkm1)*prefz(jl,1,jkm1)))*(1.-zrneb(jl))
-
-      prefz(jl, 2, jk) = (1.-zrneb(jl))*(pray1(jl,jkm1)+prefz(jl,2,jkm1)* &
-        ptra1(jl,jkm1)*ptra2(jl,jkm1)) + zrneb(jl)*zre1(jl)
-
-      ztr(jl, 2, jkm1) = zrneb(jl)*ztr1(jl) + ptra1(jl, jkm1)*(1.-zrneb(jl))
-
-    END DO
-  END DO
-  DO jl = 1, kdlon
-    zmue = (1.-zc1i(jl,1))*psec(jl) + zc1i(jl, 1)*1.66
-    prmue(jl, 1) = 1./zmue
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
-  ! -------------------------------------------------
-
-
-  IF (knu==1) THEN
-    jaj = 2
-    DO jl = 1, kdlon
-      prj(jl, jaj, kflev+1) = 1.
-      prk(jl, jaj, kflev+1) = prefz(jl, 1, kflev+1)
-    END DO
-
-    DO jk = 1, kflev
-      jkl = kflev + 1 - jk
-      jklp1 = jkl + 1
-      DO jl = 1, kdlon
-        zre11 = prj(jl, jaj, jklp1)*ztr(jl, 1, jkl)
-        prj(jl, jaj, jkl) = zre11
-        prk(jl, jaj, jkl) = zre11*prefz(jl, 1, jkl)
-      END DO
-    END DO
-
-  ELSE
-
-    DO jaj = 1, 2
-      DO jl = 1, kdlon
-        prj(jl, jaj, kflev+1) = 1.
-        prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)
-      END DO
-
-      DO jk = 1, kflev
-        jkl = kflev + 1 - jk
-        jklp1 = jkl + 1
-        DO jl = 1, kdlon
-          zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)
-          prj(jl, jaj, jkl) = zre11
-          prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)
-        END DO
-      END DO
-    END DO
-
-  END IF
-
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE swr_lmdar4
-SUBROUTINE swde_lmdar4(pgg, pref, prmuz, pto1, pw, pre1, pre2, ptr1, ptr2)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! ------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
-  ! LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
-
-  ! METHOD.
-  ! -------
-
-  ! STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 88-12-15
-  ! ------------------------------------------------------------------
-  ! * ARGUMENTS:
-
-  REAL (KIND=8) pgg(kdlon) ! ASSYMETRY FACTOR
-  REAL (KIND=8) pref(kdlon) ! REFLECTIVITY OF THE UNDERLYING LAYER
-  REAL (KIND=8) prmuz(kdlon) ! COSINE OF SOLAR ZENITH ANGLE
-  REAL (KIND=8) pto1(kdlon) ! OPTICAL THICKNESS
-  REAL (KIND=8) pw(kdlon) ! SINGLE SCATTERING ALBEDO
-  REAL (KIND=8) pre1(kdlon) ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
-  REAL (KIND=8) pre2(kdlon) ! LAYER REFLECTIVITY
-  REAL (KIND=8) ptr1(kdlon) ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
-  REAL (KIND=8) ptr2(kdlon) ! LAYER TRANSMISSIVITY
-
-  ! * LOCAL VARIABLES:
-
-  INTEGER jl
-  REAL (KIND=8) zff, zgp, ztop, zwcp, zdt, zx1, zwm
-  REAL (KIND=8) zrm2, zrk, zx2, zrp, zalpha, zbeta, zarg
-  REAL (KIND=8) zexmu0, zarg2, zexkp, zexkm, zxp2p, zxm2p, zap2b, zam2b
-  REAL (KIND=8) za11, za12, za13, za21, za22, za23
-  REAL (KIND=8) zdena, zc1a, zc2a, zri0a, zri1a
-  REAL (KIND=8) zri0b, zri1b
-  REAL (KIND=8) zb21, zb22, zb23, zdenb, zc1b, zc2b
-  REAL (KIND=8) zri0c, zri1c, zri0d, zri1d
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.      DELTA-EDDINGTON CALCULATIONS
-
-
-  DO jl = 1, kdlon
-    ! *         1.1     SET UP THE DELTA-MODIFIED PARAMETERS
-
-
-    zff = pgg(jl)*pgg(jl)
-    zgp = pgg(jl)/(1.+pgg(jl))
-    ztop = (1.-pw(jl)*zff)*pto1(jl)
-    zwcp = (1-zff)*pw(jl)/(1.-pw(jl)*zff)
-    zdt = 2./3.
-    zx1 = 1. - zwcp*zgp
-    zwm = 1. - zwcp
-    zrm2 = prmuz(jl)*prmuz(jl)
-    zrk = sqrt(3.*zwm*zx1)
-    zx2 = 4.*(1.-zrk*zrk*zrm2)
-    zrp = zrk/zx1
-    zalpha = 3.*zwcp*zrm2*(1.+zgp*zwm)/zx2
-    zbeta = 3.*zwcp*prmuz(jl)*(1.+3.*zgp*zrm2*zwm)/zx2
-    zarg = min(ztop/prmuz(jl), 200._8)
-    zexmu0 = exp(-zarg)
-    zarg2 = min(zrk*ztop, 200._8)
-    zexkp = exp(zarg2)
-    zexkm = 1./zexkp
-    zxp2p = 1. + zdt*zrp
-    zxm2p = 1. - zdt*zrp
-    zap2b = zalpha + zdt*zbeta
-    zam2b = zalpha - zdt*zbeta
-
-    ! *         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER
-
-
-    za11 = zxp2p
-    za12 = zxm2p
-    za13 = zap2b
-    za22 = zxp2p*zexkp
-    za21 = zxm2p*zexkm
-    za23 = zam2b*zexmu0
-    zdena = za11*za22 - za21*za12
-    zc1a = (za22*za13-za12*za23)/zdena
-    zc2a = (za11*za23-za21*za13)/zdena
-    zri0a = zc1a + zc2a - zalpha
-    zri1a = zrp*(zc1a-zc2a) - zbeta
-    pre1(jl) = (zri0a-zdt*zri1a)/prmuz(jl)
-    zri0b = zc1a*zexkm + zc2a*zexkp - zalpha*zexmu0
-    zri1b = zrp*(zc1a*zexkm-zc2a*zexkp) - zbeta*zexmu0
-    ptr1(jl) = zexmu0 + (zri0b+zdt*zri1b)/prmuz(jl)
-
-    ! *         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER
-
-
-    zb21 = za21 - pref(jl)*zxp2p*zexkm
-    zb22 = za22 - pref(jl)*zxm2p*zexkp
-    zb23 = za23 - pref(jl)*zexmu0*(zap2b-prmuz(jl))
-    zdenb = za11*zb22 - zb21*za12
-    zc1b = (zb22*za13-za12*zb23)/zdenb
-    zc2b = (za11*zb23-zb21*za13)/zdenb
-    zri0c = zc1b + zc2b - zalpha
-    zri1c = zrp*(zc1b-zc2b) - zbeta
-    pre2(jl) = (zri0c-zdt*zri1c)/prmuz(jl)
-    zri0d = zc1b*zexkm + zc2b*zexkp - zalpha*zexmu0
-    zri1d = zrp*(zc1b*zexkm-zc2b*zexkp) - zbeta*zexmu0
-    ptr2(jl) = zexmu0 + (zri0d+zdt*zri1d)/prmuz(jl)
-
-  END DO
-  RETURN
-END SUBROUTINE swde_lmdar4
-SUBROUTINE swtt_lmdar4(knu, ka, pu, ptr)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: apad, bpad, d
-  IMPLICIT NONE
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-  ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
-  ! INTERVALS.
-
-  ! METHOD.
-  ! -------
-
-  ! TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
-  ! AND HORNER'S ALGORITHM.
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 88-12-15
-  ! -----------------------------------------------------------------------
-
-  ! * ARGUMENTS
-
-  INTEGER knu ! INDEX OF THE SPECTRAL INTERVAL
-  INTEGER ka ! INDEX OF THE ABSORBER
-  REAL (KIND=8) pu(kdlon) ! ABSORBER AMOUNT
-
-  REAL (KIND=8) ptr(kdlon) ! TRANSMISSION FUNCTION
-
-  ! * LOCAL VARIABLES:
-
-  REAL (KIND=8) zr1(kdlon), zr2(kdlon)
-  INTEGER jl, i, j
-
-  ! -----------------------------------------------------------------------
-
-  ! *         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
-
-
-  DO jl = 1, kdlon
-    zr1(jl) = apad(knu, ka, 1) + pu(jl)*(apad(knu,ka,2)+pu(jl)*(apad(knu,ka, &
-      3)+pu(jl)*(apad(knu,ka,4)+pu(jl)*(apad(knu,ka,5)+pu(jl)*(apad(knu,ka,6) &
-      +pu(jl)*(apad(knu,ka,7)))))))
-
-    zr2(jl) = bpad(knu, ka, 1) + pu(jl)*(bpad(knu,ka,2)+pu(jl)*(bpad(knu,ka, &
-      3)+pu(jl)*(bpad(knu,ka,4)+pu(jl)*(bpad(knu,ka,5)+pu(jl)*(bpad(knu,ka,6) &
-      +pu(jl)*(bpad(knu,ka,7)))))))
-
-    ! *         2.      ADD THE BACKGROUND TRANSMISSION
-
-
-
-    ptr(jl) = (zr1(jl)/zr2(jl))*(1.-d(knu,ka)) + d(knu, ka)
-  END DO
-
-  RETURN
-END SUBROUTINE swtt_lmdar4
-SUBROUTINE swtt1_lmdar4(knu, kabs, kind, pu, ptr)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: apad, bpad, d
-  IMPLICIT NONE
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-  ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
-  ! INTERVALS.
-
-  ! METHOD.
-  ! -------
-
-  ! TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
-  ! AND HORNER'S ALGORITHM.
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 95-01-20
-  ! -----------------------------------------------------------------------
-  ! * ARGUMENTS:
-
-  INTEGER knu ! INDEX OF THE SPECTRAL INTERVAL
-  INTEGER kabs ! NUMBER OF ABSORBERS
-  INTEGER kind(kabs) ! INDICES OF THE ABSORBERS
-  REAL (KIND=8) pu(kdlon, kabs) ! ABSORBER AMOUNT
-
-  REAL (KIND=8) ptr(kdlon, kabs) ! TRANSMISSION FUNCTION
-
-  ! * LOCAL VARIABLES:
-
-  REAL (KIND=8) zr1(kdlon)
-  REAL (KIND=8) zr2(kdlon)
-  REAL (KIND=8) zu(kdlon)
-  INTEGER jl, ja, i, j, ia
-
-  ! -----------------------------------------------------------------------
-
-  ! *         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
-
-
-  DO ja = 1, kabs
-    ia = kind(ja)
-    DO jl = 1, kdlon
-      zu(jl) = pu(jl, ja)
-      zr1(jl) = apad(knu, ia, 1) + zu(jl)*(apad(knu,ia,2)+zu(jl)*(apad(knu, &
-        ia,3)+zu(jl)*(apad(knu,ia,4)+zu(jl)*(apad(knu,ia,5)+zu(jl)*(apad(knu, &
-        ia,6)+zu(jl)*(apad(knu,ia,7)))))))
-
-      zr2(jl) = bpad(knu, ia, 1) + zu(jl)*(bpad(knu,ia,2)+zu(jl)*(bpad(knu, &
-        ia,3)+zu(jl)*(bpad(knu,ia,4)+zu(jl)*(bpad(knu,ia,5)+zu(jl)*(bpad(knu, &
-        ia,6)+zu(jl)*(bpad(knu,ia,7)))))))
-
-      ! *         2.      ADD THE BACKGROUND TRANSMISSION
-
-
-      ptr(jl, ja) = (zr1(jl)/zr2(jl))*(1.-d(knu,ia)) + d(knu, ia)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE swtt1_lmdar4
-! IM ctes ds clesphys.h   SUBROUTINE LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,
-SUBROUTINE lw_lmdar4(ppmb, pdp, ppsol, pdt0, pemis, ptl, ptave, pwv, pozon, &
-    paer, pcldld, pcldlu, pview, pcolr, pcolr0, ptoplw, psollw, ptoplw0, &
-    psollw0, psollwdown, &         ! IM  .
-                                   ! psollwdown,psollwdownclr,
-  ! IM  .              ptoplwdown,ptoplwdownclr)
-    plwup, plwdn, plwup0, plwdn0)
-  USE dimphy
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-  include "raddimlw.h"
-  include "YOMCST.h"
-
-  ! -----------------------------------------------------------------------
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
-  ! ABSORBERS.
-  ! 2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
-  ! GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
-  ! 3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
-  ! TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
-  ! BOUNDARIES.
-  ! 4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
-  ! 5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES.
-
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! -----------------------------------------------------------------------
-  ! IM ctes ds clesphys.h
-  ! REAL(KIND=8) RCO2   ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97)
-  ! REAL(KIND=8) RCH4   ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97)
-  ! REAL(KIND=8) RN2O   ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97)
-  ! REAL(KIND=8) RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12*
-  ! 137.3686/28.97)
-  ! REAL(KIND=8) RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12*
-  ! 120.9140/28.97)
-  include "clesphys.h"
-  REAL (KIND=8) pcldld(kdlon, kflev) ! DOWNWARD EFFECTIVE CLOUD COVER
-  REAL (KIND=8) pcldlu(kdlon, kflev) ! UPWARD EFFECTIVE CLOUD COVER
-  REAL (KIND=8) pdp(kdlon, kflev) ! LAYER PRESSURE THICKNESS (Pa)
-  REAL (KIND=8) pdt0(kdlon) ! SURFACE TEMPERATURE DISCONTINUITY (K)
-  REAL (KIND=8) pemis(kdlon) ! SURFACE EMISSIVITY
-  REAL (KIND=8) ppmb(kdlon, kflev+1) ! HALF LEVEL PRESSURE (mb)
-  REAL (KIND=8) ppsol(kdlon) ! SURFACE PRESSURE (Pa)
-  REAL (KIND=8) pozon(kdlon, kflev) ! O3 mass fraction
-  REAL (KIND=8) ptl(kdlon, kflev+1) ! HALF LEVEL TEMPERATURE (K)
-  REAL (KIND=8) paer(kdlon, kflev, 5) ! OPTICAL THICKNESS OF THE AEROSOLS
-  REAL (KIND=8) ptave(kdlon, kflev) ! LAYER TEMPERATURE (K)
-  REAL (KIND=8) pview(kdlon) ! COSECANT OF VIEWING ANGLE
-  REAL (KIND=8) pwv(kdlon, kflev) ! SPECIFIC HUMIDITY (kg/kg)
-
-  REAL (KIND=8) pcolr(kdlon, kflev) ! LONG-WAVE TENDENCY (K/day)
-  REAL (KIND=8) pcolr0(kdlon, kflev) ! LONG-WAVE TENDENCY (K/day) clear-sky
-  REAL (KIND=8) ptoplw(kdlon) ! LONGWAVE FLUX AT T.O.A.
-  REAL (KIND=8) psollw(kdlon) ! LONGWAVE FLUX AT SURFACE
-  REAL (KIND=8) ptoplw0(kdlon) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
-  REAL (KIND=8) psollw0(kdlon) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
-  ! Rajout LF
-  REAL (KIND=8) psollwdown(kdlon) ! LONGWAVE downwards flux at surface
-  ! Rajout IM
-  ! IM   real(kind=8) psollwdownclr(kdlon) ! LONGWAVE CS downwards flux at
-  ! surface
-  ! IM   real(kind=8) ptoplwdown(kdlon)    ! LONGWAVE downwards flux at
-  ! T.O.A.
-  ! IM   real(kind=8) ptoplwdownclr(kdlon) ! LONGWAVE CS downwards flux at
-  ! T.O.A.
-  ! IM
-  REAL (KIND=8) plwup(kdlon, kflev+1) ! LW up total sky
-  REAL (KIND=8) plwup0(kdlon, kflev+1) ! LW up clear sky
-  REAL (KIND=8) plwdn(kdlon, kflev+1) ! LW down total sky
-  REAL (KIND=8) plwdn0(kdlon, kflev+1) ! LW down clear sky
-  ! -------------------------------------------------------------------------
-  REAL (KIND=8) zabcu(kdlon, nua, 3*kflev+1)
-
-  REAL (KIND=8) zoz(kdlon, kflev)
-  ! equivalent pressure of ozone in a layer, in Pa
-
-  ! ym      REAL(KIND=8) ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up;
-  ! 2:down)
-  ! ym      REAL(KIND=8) ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
-  ! ym      REAL(KIND=8) ZBINT(KDLON,KFLEV+1)            ! Intermediate
-  ! variable
-  ! ym      REAL(KIND=8) ZBSUI(KDLON)                    ! Intermediate
-  ! variable
-  ! ym      REAL(KIND=8) ZCTS(KDLON,KFLEV)               ! Intermediate
-  ! variable
-  ! ym      REAL(KIND=8) ZCNTRB(KDLON,KFLEV+1,KFLEV+1)   ! Intermediate
-  ! variable
-  ! ym      SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zflux(:, :, :) ! RADIATIVE FLUXES (1:up; 2:down)
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zfluc(:, :, :) ! CLEAR-SKY RADIATIVE FLUXES
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zbint(:, :) ! Intermediate variable
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zbsui(:) ! Intermediate variable
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zcts(:, :) ! Intermediate variable
-  REAL (KIND=8), ALLOCATABLE, SAVE :: zcntrb(:, :, :) ! Intermediate variable
-  !$OMP THREADPRIVATE(ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB)
-
-  INTEGER ilim, i, k, kpl1
-
-  INTEGER lw0pas ! Every lw0pas steps, clear-sky is done
-  PARAMETER (lw0pas=1)
-  INTEGER lwpas ! Every lwpas steps, cloudy-sky is done
-  PARAMETER (lwpas=1)
-
-  INTEGER itaplw0, itaplw
-  LOGICAL appel1er
-  SAVE appel1er, itaplw0, itaplw
-  !$OMP THREADPRIVATE(appel1er, itaplw0, itaplw)
-  DATA appel1er/.TRUE./
-  DATA itaplw0, itaplw/0, 0/
-
-  ! ------------------------------------------------------------------
-  IF (appel1er) THEN
-    WRITE (lunout, *) 'LW clear-sky calling frequency: ', lw0pas
-    WRITE (lunout, *) 'LW cloudy-sky calling frequency: ', lwpas
-    WRITE (lunout, *) '   In general, they should be 1'
-    ! ym
-    ALLOCATE (zflux(kdlon,2,kflev+1))
-    ALLOCATE (zfluc(kdlon,2,kflev+1))
-    ALLOCATE (zbint(kdlon,kflev+1))
-    ALLOCATE (zbsui(kdlon))
-    ALLOCATE (zcts(kdlon,kflev))
-    ALLOCATE (zcntrb(kdlon,kflev+1,kflev+1))
-    appel1er = .FALSE.
-  END IF
-
-  IF (mod(itaplw0,lw0pas)==0) THEN
-    ! Compute equivalent pressure of ozone from mass fraction:
-    DO k = 1, kflev
-      DO i = 1, kdlon
-        zoz(i, k) = pozon(i, k)*pdp(i, k)
-      END DO
-    END DO
-    ! IM ctes ds clesphys.h   CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12,
-    CALL lwu_lmdar4(paer, pdp, ppmb, ppsol, zoz, ptave, pview, pwv, zabcu)
-    CALL lwbv_lmdar4(ilim, pdp, pdt0, pemis, ppmb, ptl, ptave, zabcu, zfluc, &
-      zbint, zbsui, zcts, zcntrb)
-    itaplw0 = 0
-  END IF
-  itaplw0 = itaplw0 + 1
-
-  IF (mod(itaplw,lwpas)==0) THEN
-    CALL lwc_lmdar4(ilim, pcldld, pcldlu, pemis, zfluc, zbint, zbsui, zcts, &
-      zcntrb, zflux)
-    itaplw = 0
-  END IF
-  itaplw = itaplw + 1
-
-  DO k = 1, kflev
-    kpl1 = k + 1
-    DO i = 1, kdlon
-      pcolr(i, k) = zflux(i, 1, kpl1) + zflux(i, 2, kpl1) - zflux(i, 1, k) - &
-        zflux(i, 2, k)
-      pcolr(i, k) = pcolr(i, k)*rday*rg/rcpd/pdp(i, k)
-      pcolr0(i, k) = zfluc(i, 1, kpl1) + zfluc(i, 2, kpl1) - zfluc(i, 1, k) - &
-        zfluc(i, 2, k)
-      pcolr0(i, k) = pcolr0(i, k)*rday*rg/rcpd/pdp(i, k)
-    END DO
-  END DO
-  DO i = 1, kdlon
-    psollw(i) = -zflux(i, 1, 1) - zflux(i, 2, 1)
-    ptoplw(i) = zflux(i, 1, kflev+1) + zflux(i, 2, kflev+1)
-
-    psollw0(i) = -zfluc(i, 1, 1) - zfluc(i, 2, 1)
-    ptoplw0(i) = zfluc(i, 1, kflev+1) + zfluc(i, 2, kflev+1)
-    psollwdown(i) = -zflux(i, 2, 1)
-
-    ! IM attention aux signes !; LWtop >0, LWdn < 0
-    DO k = 1, kflev + 1
-      plwup(i, k) = zflux(i, 1, k)
-      plwup0(i, k) = zfluc(i, 1, k)
-      plwdn(i, k) = zflux(i, 2, k)
-      plwdn0(i, k) = zfluc(i, 2, k)
-    END DO
-  END DO
-  ! ------------------------------------------------------------------
-  RETURN
-END SUBROUTINE lw_lmdar4
-! IM ctes ds clesphys.h   SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12,
-SUBROUTINE lwu_lmdar4(paer, pdp, ppmb, ppsol, poz, ptave, pview, pwv, pabcu)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: tref, rt1, raer, at, bt, oct
-  USE infotrac_phy, ONLY: type_trac
-#ifdef REPROBUS
-  USE chem_rep, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
-#endif
-
-  IMPLICIT NONE
-  include "raddimlw.h"
-  include "YOMCST.h"
-  include "radepsi.h"
-  include "radopt.h"
-
-  ! PURPOSE.
-  ! --------
-  ! COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
-  ! TEMPERATURE EFFECTS
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
-  ! ABSORBERS.
-
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! Voigt lines (loop 404 modified) - JJM & PhD - 01/96
-  ! -----------------------------------------------------------------------
-  ! * ARGUMENTS:
-  ! IM ctes ds clesphys.h
-  ! REAL(KIND=8) RCO2
-  ! REAL(KIND=8) RCH4, RN2O, RCFC11, RCFC12
-  include "clesphys.h"
-  REAL (KIND=8) paer(kdlon, kflev, 5)
-  REAL (KIND=8) pdp(kdlon, kflev)
-  REAL (KIND=8) ppmb(kdlon, kflev+1)
-  REAL (KIND=8) ppsol(kdlon)
-  REAL (KIND=8) poz(kdlon, kflev)
-  REAL (KIND=8) ptave(kdlon, kflev)
-  REAL (KIND=8) pview(kdlon)
-  REAL (KIND=8) pwv(kdlon, kflev)
-
-  REAL (KIND=8) pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS
-
-  ! -----------------------------------------------------------------------
-  ! * LOCAL VARIABLES:
-  REAL (KIND=8) zably(kdlon, nua, 3*kflev+1)
-  REAL (KIND=8) zduc(kdlon, 3*kflev+1)
-  REAL (KIND=8) zphio(kdlon)
-  REAL (KIND=8) zpsc2(kdlon)
-  REAL (KIND=8) zpsc3(kdlon)
-  REAL (KIND=8) zpsh1(kdlon)
-  REAL (KIND=8) zpsh2(kdlon)
-  REAL (KIND=8) zpsh3(kdlon)
-  REAL (KIND=8) zpsh4(kdlon)
-  REAL (KIND=8) zpsh5(kdlon)
-  REAL (KIND=8) zpsh6(kdlon)
-  REAL (KIND=8) zpsio(kdlon)
-  REAL (KIND=8) ztcon(kdlon)
-  REAL (KIND=8) zphm6(kdlon)
-  REAL (KIND=8) zpsm6(kdlon)
-  REAL (KIND=8) zphn6(kdlon)
-  REAL (KIND=8) zpsn6(kdlon)
-  REAL (KIND=8) zssig(kdlon, 3*kflev+1)
-  REAL (KIND=8) ztavi(kdlon)
-  REAL (KIND=8) zuaer(kdlon, ninter)
-  REAL (KIND=8) zxoz(kdlon)
-  REAL (KIND=8) zxwv(kdlon)
-
-  INTEGER jl, jk, jkj, jkjr, jkjp, ig1
-  INTEGER jki, jkip1, ja, jj
-  INTEGER jkl, jkp1, jkk, jkjpn
-  INTEGER jae1, jae2, jae3, jae, jjpn
-  INTEGER ir, jc, jcp1
-  REAL (KIND=8) zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
-  REAL (KIND=8) zfppw, ztx, ztx2, zzably
-  REAL (KIND=8) zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
-  REAL (KIND=8) zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
-  REAL (KIND=8) zcac8, zcbc8
-  REAL (KIND=8) zalup, zdiff
-
-  REAL (KIND=8) pvgco2, pvgh2o, pvgo3
-
-  REAL (KIND=8) r10e ! DECIMAL/NATURAL LOG.FACTOR
-  PARAMETER (r10e=0.4342945)
-
-  ! -----------------------------------------------------------------------
-
-  IF (levoigt) THEN
-    pvgco2 = 60.
-    pvgh2o = 30.
-    pvgo3 = 400.
-  ELSE
-    pvgco2 = 0.
-    pvgh2o = 0.
-    pvgo3 = 0.
-  END IF
-
-  ! *         2.    PRESSURE OVER GAUSS SUB-LEVELS
-  ! ------------------------------
-
-
-  DO jl = 1, kdlon
-    zssig(jl, 1) = ppmb(jl, 1)*100.
-  END DO
-
-  DO jk = 1, kflev
-    jkj = (jk-1)*ng1p1 + 1
-    jkjr = jkj
-    jkjp = jkj + ng1p1
-    DO jl = 1, kdlon
-      zssig(jl, jkjp) = ppmb(jl, jk+1)*100.
-    END DO
-    DO ig1 = 1, ng1
-      jkj = jkj + 1
-      DO jl = 1, kdlon
-        zssig(jl, jkj) = (zssig(jl,jkjr)+zssig(jl,jkjp))*0.5 + &
-          rt1(ig1)*(zssig(jl,jkjp)-zssig(jl,jkjr))*0.5
-      END DO
-    END DO
-  END DO
-
-  ! -----------------------------------------------------------------------
-
-
-  ! *         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
-  ! --------------------------------------------------
-
-
-  DO jki = 1, 3*kflev
-    jkip1 = jki + 1
-    DO jl = 1, kdlon
-      zably(jl, 5, jki) = (zssig(jl,jki)+zssig(jl,jkip1))*0.5
-      zably(jl, 3, jki) = (zssig(jl,jki)-zssig(jl,jkip1))/(10.*rg)
-    END DO
-  END DO
-
-  DO jk = 1, kflev
-    jkp1 = jk + 1
-    jkl = kflev + 1 - jk
-    DO jl = 1, kdlon
-      zxwv(jl) = max(pwv(jl,jk), zepscq)
-      zxoz(jl) = max(poz(jl,jk)/pdp(jl,jk), zepsco)
-    END DO
-    jkj = (jk-1)*ng1p1 + 1
-    jkjpn = jkj + ng1
-    DO jkk = jkj, jkjpn
-      DO jl = 1, kdlon
-        zdpm = zably(jl, 3, jkk)
-        zupm = zably(jl, 5, jkk)*zdpm/101325.
-        zupmco2 = (zably(jl,5,jkk)+pvgco2)*zdpm/101325.
-        zupmh2o = (zably(jl,5,jkk)+pvgh2o)*zdpm/101325.
-        zupmo3 = (zably(jl,5,jkk)+pvgo3)*zdpm/101325.
-        zduc(jl, jkk) = zdpm
-        zably(jl, 12, jkk) = zxoz(jl)*zdpm
-        zably(jl, 13, jkk) = zxoz(jl)*zupmo3
-        zu6 = zxwv(jl)*zupm
-        zfppw = 1.6078*zxwv(jl)/(1.+0.608*zxwv(jl))
-        zably(jl, 6, jkk) = zxwv(jl)*zupmh2o
-        zably(jl, 11, jkk) = zu6*zfppw
-        zably(jl, 10, jkk) = zu6*(1.-zfppw)
-        zably(jl, 9, jkk) = rco2*zupmco2
-        zably(jl, 8, jkk) = rco2*zdpm
-      END DO
-    END DO
-  END DO
-
-  ! -----------------------------------------------------------------------
-
-
-  ! *         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
-  ! --------------------------------------------------
-
-
-  DO ja = 1, nua
-    DO jl = 1, kdlon
-      pabcu(jl, ja, 3*kflev+1) = 0.
-    END DO
-  END DO
-
-  DO jk = 1, kflev
-    jj = (jk-1)*ng1p1 + 1
-    jjpn = jj + ng1
-    jkl = kflev + 1 - jk
-
-    ! *         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
-    ! --------------------------------------------------
-
-
-    jae1 = 3*kflev + 1 - jj
-    jae2 = 3*kflev + 1 - (jj+1)
-    jae3 = 3*kflev + 1 - jjpn
-    DO jae = 1, 5
-      DO jl = 1, kdlon
-        zuaer(jl, jae) = (raer(jae,1)*paer(jl,jkl,1)+raer(jae,2)*paer(jl,jkl, &
-          2)+raer(jae,3)*paer(jl,jkl,3)+raer(jae,4)*paer(jl,jkl,4)+ &
-          raer(jae,5)*paer(jl,jkl,5))/(zduc(jl,jae1)+zduc(jl,jae2)+zduc(jl, &
-          jae3))
-      END DO
-    END DO
-
-    ! *         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
-    ! --------------------------------------------------
-
-
-    DO jl = 1, kdlon
-      ztavi(jl) = ptave(jl, jkl)
-      ztcon(jl) = exp(6.08*(296./ztavi(jl)-1.))
-      ztx = ztavi(jl) - tref
-      ztx2 = ztx*ztx
-      zzably = zably(jl, 6, jae1) + zably(jl, 6, jae2) + zably(jl, 6, jae3)
-      zup = min(max(0.5*r10e*log(zzably)+5.,0._8), 6._8)
-      zcah1 = at(1, 1) + zup*(at(1,2)+zup*(at(1,3)))
-      zcbh1 = bt(1, 1) + zup*(bt(1,2)+zup*(bt(1,3)))
-      zpsh1(jl) = exp(zcah1*ztx+zcbh1*ztx2)
-      zcah2 = at(2, 1) + zup*(at(2,2)+zup*(at(2,3)))
-      zcbh2 = bt(2, 1) + zup*(bt(2,2)+zup*(bt(2,3)))
-      zpsh2(jl) = exp(zcah2*ztx+zcbh2*ztx2)
-      zcah3 = at(3, 1) + zup*(at(3,2)+zup*(at(3,3)))
-      zcbh3 = bt(3, 1) + zup*(bt(3,2)+zup*(bt(3,3)))
-      zpsh3(jl) = exp(zcah3*ztx+zcbh3*ztx2)
-      zcah4 = at(4, 1) + zup*(at(4,2)+zup*(at(4,3)))
-      zcbh4 = bt(4, 1) + zup*(bt(4,2)+zup*(bt(4,3)))
-      zpsh4(jl) = exp(zcah4*ztx+zcbh4*ztx2)
-      zcah5 = at(5, 1) + zup*(at(5,2)+zup*(at(5,3)))
-      zcbh5 = bt(5, 1) + zup*(bt(5,2)+zup*(bt(5,3)))
-      zpsh5(jl) = exp(zcah5*ztx+zcbh5*ztx2)
-      zcah6 = at(6, 1) + zup*(at(6,2)+zup*(at(6,3)))
-      zcbh6 = bt(6, 1) + zup*(bt(6,2)+zup*(bt(6,3)))
-      zpsh6(jl) = exp(zcah6*ztx+zcbh6*ztx2)
-      zphm6(jl) = exp(-5.81E-4*ztx-1.13E-6*ztx2)
-      zpsm6(jl) = exp(-5.57E-4*ztx-3.30E-6*ztx2)
-      zphn6(jl) = exp(-3.46E-5*ztx+2.05E-7*ztx2)
-      zpsn6(jl) = exp(3.70E-3*ztx-2.30E-6*ztx2)
-    END DO
-
-    DO jl = 1, kdlon
-      ztavi(jl) = ptave(jl, jkl)
-      ztx = ztavi(jl) - tref
-      ztx2 = ztx*ztx
-      zzably = zably(jl, 9, jae1) + zably(jl, 9, jae2) + zably(jl, 9, jae3)
-      zalup = r10e*log(zzably)
-      zup = max(0._8, 5.0+0.5*zalup)
-      zpsc2(jl) = (ztavi(jl)/tref)**zup
-      zcac8 = at(8, 1) + zup*(at(8,2)+zup*(at(8,3)))
-      zcbc8 = bt(8, 1) + zup*(bt(8,2)+zup*(bt(8,3)))
-      zpsc3(jl) = exp(zcac8*ztx+zcbc8*ztx2)
-      zphio(jl) = exp(oct(1)*ztx+oct(2)*ztx2)
-      zpsio(jl) = exp(2.*(oct(3)*ztx+oct(4)*ztx2))
-    END DO
-
-    DO jkk = jj, jjpn
-      jc = 3*kflev + 1 - jkk
-      jcp1 = jc + 1
-      DO jl = 1, kdlon
-        zdiff = pview(jl)
-        pabcu(jl, 10, jc) = pabcu(jl, 10, jcp1) + zably(jl, 10, jc)*zdiff
-        pabcu(jl, 11, jc) = pabcu(jl, 11, jcp1) + zably(jl, 11, jc)*ztcon(jl) &
-          *zdiff
-
-        pabcu(jl, 12, jc) = pabcu(jl, 12, jcp1) + zably(jl, 12, jc)*zphio(jl) &
-          *zdiff
-        pabcu(jl, 13, jc) = pabcu(jl, 13, jcp1) + zably(jl, 13, jc)*zpsio(jl) &
-          *zdiff
-
-        pabcu(jl, 7, jc) = pabcu(jl, 7, jcp1) + zably(jl, 9, jc)*zpsc2(jl)* &
-          zdiff
-        pabcu(jl, 8, jc) = pabcu(jl, 8, jcp1) + zably(jl, 9, jc)*zpsc3(jl)* &
-          zdiff
-        pabcu(jl, 9, jc) = pabcu(jl, 9, jcp1) + zably(jl, 9, jc)*zpsc3(jl)* &
-          zdiff
-
-        pabcu(jl, 1, jc) = pabcu(jl, 1, jcp1) + zably(jl, 6, jc)*zpsh1(jl)* &
-          zdiff
-        pabcu(jl, 2, jc) = pabcu(jl, 2, jcp1) + zably(jl, 6, jc)*zpsh2(jl)* &
-          zdiff
-        pabcu(jl, 3, jc) = pabcu(jl, 3, jcp1) + zably(jl, 6, jc)*zpsh5(jl)* &
-          zdiff
-        pabcu(jl, 4, jc) = pabcu(jl, 4, jcp1) + zably(jl, 6, jc)*zpsh3(jl)* &
-          zdiff
-        pabcu(jl, 5, jc) = pabcu(jl, 5, jcp1) + zably(jl, 6, jc)*zpsh4(jl)* &
-          zdiff
-        pabcu(jl, 6, jc) = pabcu(jl, 6, jcp1) + zably(jl, 6, jc)*zpsh6(jl)* &
-          zdiff
-
-        pabcu(jl, 14, jc) = pabcu(jl, 14, jcp1) + zuaer(jl, 1)*zduc(jl, jc)* &
-          zdiff
-        pabcu(jl, 15, jc) = pabcu(jl, 15, jcp1) + zuaer(jl, 2)*zduc(jl, jc)* &
-          zdiff
-        pabcu(jl, 16, jc) = pabcu(jl, 16, jcp1) + zuaer(jl, 3)*zduc(jl, jc)* &
-          zdiff
-        pabcu(jl, 17, jc) = pabcu(jl, 17, jcp1) + zuaer(jl, 4)*zduc(jl, jc)* &
-          zdiff
-        pabcu(jl, 18, jc) = pabcu(jl, 18, jcp1) + zuaer(jl, 5)*zduc(jl, jc)* &
-          zdiff
-
-
-
-        IF (type_trac=='repr') THEN
-#ifdef REPROBUS
-          IF (ok_rtime2d) THEN
-            pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
-              zably(jl, 8, jc)*rch42d(jl, jc)/rco2*zphm6(jl)*zdiff
-            pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
-              zably(jl, 9, jc)*rch42d(jl, jc)/rco2*zpsm6(jl)*zdiff
-            pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
-              zably(jl, 8, jc)*rn2o2d(jl, jc)/rco2*zphn6(jl)*zdiff
-            pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
-              zably(jl, 9, jc)*rn2o2d(jl, jc)/rco2*zpsn6(jl)*zdiff
-
-            pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
-              zably(jl, 8, jc)*rcfc112d(jl, jc)/rco2*zdiff
-            pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
-              zably(jl, 8, jc)*rcfc122d(jl, jc)/rco2*zdiff
-          ELSE
-              ! Same calculation as for type_trac /= repr
-            pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
-              zably(jl, 8, jc)*rch4/rco2*zphm6(jl)*zdiff
-            pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
-              zably(jl, 9, jc)*rch4/rco2*zpsm6(jl)*zdiff
-            pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
-              zably(jl, 8, jc)*rn2o/rco2*zphn6(jl)*zdiff
-            pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
-              zably(jl, 9, jc)*rn2o/rco2*zpsn6(jl)*zdiff
-
-            pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
-              zably(jl, 8, jc)*rcfc11/rco2*zdiff
-            pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
-              zably(jl, 8, jc)*rcfc12/rco2*zdiff
-          END IF
-#endif
-        ELSE
-          pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
-            zably(jl, 8, jc)*rch4/rco2*zphm6(jl)*zdiff
-          pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
-            zably(jl, 9, jc)*rch4/rco2*zpsm6(jl)*zdiff
-          pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
-            zably(jl, 8, jc)*rn2o/rco2*zphn6(jl)*zdiff
-          pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
-            zably(jl, 9, jc)*rn2o/rco2*zpsn6(jl)*zdiff
-
-          pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
-            zably(jl, 8, jc)*rcfc11/rco2*zdiff
-          pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
-            zably(jl, 8, jc)*rcfc12/rco2*zdiff
-        END IF
-
-      END DO
-    END DO
-
-  END DO
-
-
-  RETURN
-END SUBROUTINE lwu_lmdar4
-SUBROUTINE lwbv_lmdar4(klim, pdp, pdt0, pemis, ppmb, ptl, ptave, pabcu, &
-    pfluc, pbint, pbsui, pcts, pcntrb)
-  USE dimphy
-  IMPLICIT NONE
-  include "raddimlw.h"
-  include "YOMCST.h"
-
-  ! PURPOSE.
-  ! --------
-  ! TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
-  ! VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
-  ! SAVING
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
-  ! GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
-  ! 2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
-  ! TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
-  ! BOUNDARIES.
-  ! 3. COMPUTES THE CLEAR-SKY COOLING RATES.
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
-  ! MEMORY)
-  ! -----------------------------------------------------------------------
-  ! * ARGUMENTS:
-  INTEGER klim
-
-  REAL (KIND=8) pdp(kdlon, kflev)
-  REAL (KIND=8) pdt0(kdlon)
-  REAL (KIND=8) pemis(kdlon)
-  REAL (KIND=8) ppmb(kdlon, kflev+1)
-  REAL (KIND=8) ptl(kdlon, kflev+1)
-  REAL (KIND=8) ptave(kdlon, kflev)
-
-  REAL (KIND=8) pfluc(kdlon, 2, kflev+1)
-
-  REAL (KIND=8) pabcu(kdlon, nua, 3*kflev+1)
-  REAL (KIND=8) pbint(kdlon, kflev+1)
-  REAL (KIND=8) pbsui(kdlon)
-  REAL (KIND=8) pcts(kdlon, kflev)
-  REAL (KIND=8) pcntrb(kdlon, kflev+1, kflev+1)
-
-  ! -------------------------------------------------------------------------
-
-  ! * LOCAL VARIABLES:
-  REAL (KIND=8) zb(kdlon, ninter, kflev+1)
-  REAL (KIND=8) zbsur(kdlon, ninter)
-  REAL (KIND=8) zbtop(kdlon, ninter)
-  REAL (KIND=8) zdbsl(kdlon, ninter, kflev*2)
-  REAL (KIND=8) zga(kdlon, 8, 2, kflev)
-  REAL (KIND=8) zgb(kdlon, 8, 2, kflev)
-  REAL (KIND=8) zgasur(kdlon, 8, 2)
-  REAL (KIND=8) zgbsur(kdlon, 8, 2)
-  REAL (KIND=8) zgatop(kdlon, 8, 2)
-  REAL (KIND=8) zgbtop(kdlon, 8, 2)
-
-  INTEGER nuaer, ntraer
-  ! ------------------------------------------------------------------
-  ! * COMPUTES PLANCK FUNCTIONS:
-  CALL lwb_lmdar4(pdt0, ptave, ptl, zb, pbint, pbsui, zbsur, zbtop, zdbsl, &
-    zga, zgb, zgasur, zgbsur, zgatop, zgbtop)
-  ! ------------------------------------------------------------------
-  ! * PERFORMS THE VERTICAL INTEGRATION:
-  nuaer = nua
-  ntraer = ntra
-  CALL lwv_lmdar4(nuaer, ntraer, klim, pabcu, zb, pbint, pbsui, zbsur, zbtop, &
-    zdbsl, pemis, ppmb, ptave, zga, zgb, zgasur, zgbsur, zgatop, zgbtop, &
-    pcntrb, pcts, pfluc)
-  ! ------------------------------------------------------------------
-  RETURN
-END SUBROUTINE lwbv_lmdar4
-SUBROUTINE lwc_lmdar4(klim, pcldld, pcldlu, pemis, pfluc, pbint, pbsuin, &
-    pcts, pcntrb, pflux)
-  USE dimphy
-  IMPLICIT NONE
-  include "radepsi.h"
-  include "radopt.h"
-
-  ! PURPOSE.
-  ! --------
-  ! INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
-  ! RADIANCES
-
-  ! EXPLICIT ARGUMENTS :
-  ! --------------------
-  ! ==== INPUTS ===
-  ! PBINT  : (KDLON,0:KFLEV)     ; HALF LEVEL PLANCK FUNCTION
-  ! PBSUIN : (KDLON)             ; SURFACE PLANCK FUNCTION
-  ! PCLDLD : (KDLON,KFLEV)       ; DOWNWARD EFFECTIVE CLOUD FRACTION
-  ! PCLDLU : (KDLON,KFLEV)       ; UPWARD EFFECTIVE CLOUD FRACTION
-  ! PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE
-  ! PCTS   : (KDLON,KFLEV)       ; CLEAR-SKY LAYER COOLING-TO-SPACE
-  ! PEMIS  : (KDLON)             ; SURFACE EMISSIVITY
-  ! PFLUC
-  ! ==== OUTPUTS ===
-  ! PFLUX(KDLON,2,KFLEV)         ; RADIATIVE FLUXES :
-  ! 1  ==>  UPWARD   FLUX TOTAL
-  ! 2  ==>  DOWNWARD FLUX TOTAL
-
-  ! METHOD.
-  ! -------
-
-  ! 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
-  ! 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
-  ! 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
-  ! CLOUDS
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! Voigt lines (loop 231 to 233)  - JJM & PhD - 01/96
-  ! -----------------------------------------------------------------------
-  ! * ARGUMENTS:
-  INTEGER klim
-  REAL (KIND=8) pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
-  REAL (KIND=8) pbint(kdlon, kflev+1) ! HALF LEVEL PLANCK FUNCTION
-  REAL (KIND=8) pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
-  REAL (KIND=8) pcntrb(kdlon, kflev+1, kflev+1) !CLEAR-SKY ENERGY EXCHANGE
-  REAL (KIND=8) pcts(kdlon, kflev) ! CLEAR-SKY LAYER COOLING-TO-SPACE
-
-  REAL (KIND=8) pcldld(kdlon, kflev)
-  REAL (KIND=8) pcldlu(kdlon, kflev)
-  REAL (KIND=8) pemis(kdlon)
-
-  REAL (KIND=8) pflux(kdlon, 2, kflev+1)
-  ! -----------------------------------------------------------------------
-  ! * LOCAL VARIABLES:
-  INTEGER imx(kdlon), imxp(kdlon)
-
-  REAL (KIND=8) zclear(kdlon), zcloud(kdlon), zdnf(kdlon, kflev+1, kflev+1), &
-    zfd(kdlon), zfn10(kdlon), zfu(kdlon), zupf(kdlon, kflev+1, kflev+1)
-  REAL (KIND=8) zclm(kdlon, kflev+1, kflev+1)
-
-  INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1
-  INTEGER jk1, jk2, jkc, jkcp1, jcloud
-  INTEGER imxm1, imxp1
-  REAL (KIND=8) zcfrac
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.     INITIALIZATION
-  ! --------------
-
-
-  imaxc = 0
-
-  DO jl = 1, kdlon
-    imx(jl) = 0
-    imxp(jl) = 0
-    zcloud(jl) = 0.
-  END DO
-
-  ! *         1.1    SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
-  ! -------------------------------------------
-
-
-  DO jk = 1, kflev
-    DO jl = 1, kdlon
-      imx1 = imx(jl)
-      imx2 = jk
-      IF (pcldlu(jl,jk)>zepsc) THEN
-        imxp(jl) = imx2
-      ELSE
-        imxp(jl) = imx1
-      END IF
-      imaxc = max(imxp(jl), imaxc)
-      imx(jl) = imxp(jl)
-    END DO
-  END DO
-  ! GM*******
-  imaxc = kflev
-  ! GM*******
-
-  DO jk = 1, kflev + 1
-    DO jl = 1, kdlon
-      pflux(jl, 1, jk) = pfluc(jl, 1, jk)
-      pflux(jl, 2, jk) = pfluc(jl, 2, jk)
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
-  ! ---------------------------------------
-
-  IF (imaxc>0) THEN
-
-    imxp1 = imaxc + 1
-    imxm1 = imaxc - 1
-
-    ! *         2.0     INITIALIZE TO CLEAR-SKY FLUXES
-    ! ------------------------------
-
-
-    DO jk1 = 1, kflev + 1
-      DO jk2 = 1, kflev + 1
-        DO jl = 1, kdlon
-          zupf(jl, jk2, jk1) = pfluc(jl, 1, jk1)
-          zdnf(jl, jk2, jk1) = pfluc(jl, 2, jk1)
-        END DO
-      END DO
-    END DO
-
-    ! *         2.1     FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
-    ! ----------------------------------------------
-
-
-    DO jkc = 1, imaxc
-      jcloud = jkc
-      jkcp1 = jcloud + 1
-
-      ! *         2.1.1   ABOVE THE CLOUD
-      ! ---------------
-
-
-      DO jk = jkcp1, kflev + 1
-        jkm1 = jk - 1
-        DO jl = 1, kdlon
-          zfu(jl) = 0.
-        END DO
-        IF (jk>jkcp1) THEN
-          DO jkj = jkcp1, jkm1
-            DO jl = 1, kdlon
-              zfu(jl) = zfu(jl) + pcntrb(jl, jk, jkj)
-            END DO
-          END DO
-        END IF
-
-        DO jl = 1, kdlon
-          zupf(jl, jkcp1, jk) = pbint(jl, jk) - zfu(jl)
-        END DO
-      END DO
-
-      ! *         2.1.2   BELOW THE CLOUD
-      ! ---------------
-
-
-      DO jk = 1, jcloud
-        jkp1 = jk + 1
-        DO jl = 1, kdlon
-          zfd(jl) = 0.
-        END DO
-
-        IF (jk<jcloud) THEN
-          DO jkj = jkp1, jcloud
-            DO jl = 1, kdlon
-              zfd(jl) = zfd(jl) + pcntrb(jl, jk, jkj)
-            END DO
-          END DO
-        END IF
-        DO jl = 1, kdlon
-          zdnf(jl, jkcp1, jk) = -pbint(jl, jk) - zfd(jl)
-        END DO
-      END DO
-
-    END DO
-
-    ! *         2.2     CLOUD COVER MATRIX
-    ! ------------------
-
-    ! *    ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
-    ! HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
-
-
-    DO jk1 = 1, kflev + 1
-      DO jk2 = 1, kflev + 1
-        DO jl = 1, kdlon
-          zclm(jl, jk1, jk2) = 0.
-        END DO
-      END DO
-    END DO
-
-    ! *         2.4     CLOUD COVER BELOW THE LEVEL OF CALCULATION
-    ! ------------------------------------------
-
-
-    DO jk1 = 2, kflev + 1
-      DO jl = 1, kdlon
-        zclear(jl) = 1.
-        zcloud(jl) = 0.
-      END DO
-      DO jk = jk1 - 1, 1, -1
-        DO jl = 1, kdlon
-          IF (novlp==1) THEN
-            ! * maximum-random
-            zclear(jl) = zclear(jl)*(1.0-max(pcldlu(jl, &
-              jk),zcloud(jl)))/(1.0-min(zcloud(jl),1.-zepsec))
-            zclm(jl, jk1, jk) = 1.0 - zclear(jl)
-            zcloud(jl) = pcldlu(jl, jk)
-          ELSE IF (novlp==2) THEN
-            ! * maximum
-            zcloud(jl) = max(zcloud(jl), pcldlu(jl,jk))
-            zclm(jl, jk1, jk) = zcloud(jl)
-          ELSE IF (novlp==3) THEN
-            ! * random
-            zclear(jl) = zclear(jl)*(1.0-pcldlu(jl,jk))
-            zcloud(jl) = 1.0 - zclear(jl)
-            zclm(jl, jk1, jk) = zcloud(jl)
-          END IF
-        END DO
-      END DO
-    END DO
-
-    ! *         2.5     CLOUD COVER ABOVE THE LEVEL OF CALCULATION
-    ! ------------------------------------------
-
-
-    DO jk1 = 1, kflev
-      DO jl = 1, kdlon
-        zclear(jl) = 1.
-        zcloud(jl) = 0.
-      END DO
-      DO jk = jk1, kflev
-        DO jl = 1, kdlon
-          IF (novlp==1) THEN
-            ! * maximum-random
-            zclear(jl) = zclear(jl)*(1.0-max(pcldld(jl, &
-              jk),zcloud(jl)))/(1.0-min(zcloud(jl),1.-zepsec))
-            zclm(jl, jk1, jk) = 1.0 - zclear(jl)
-            zcloud(jl) = pcldld(jl, jk)
-          ELSE IF (novlp==2) THEN
-            ! * maximum
-            zcloud(jl) = max(zcloud(jl), pcldld(jl,jk))
-            zclm(jl, jk1, jk) = zcloud(jl)
-          ELSE IF (novlp==3) THEN
-            ! * random
-            zclear(jl) = zclear(jl)*(1.0-pcldld(jl,jk))
-            zcloud(jl) = 1.0 - zclear(jl)
-            zclm(jl, jk1, jk) = zcloud(jl)
-          END IF
-        END DO
-      END DO
-    END DO
-
-    ! *         3.      FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
-    ! ----------------------------------------------
-
-
-    ! *         3.1     DOWNWARD FLUXES
-    ! ---------------
-
-
-    DO jl = 1, kdlon
-      pflux(jl, 2, kflev+1) = 0.
-    END DO
-
-    DO jk1 = kflev, 1, -1
-
-      ! *                 CONTRIBUTION FROM CLEAR-SKY FRACTION
-
-      DO jl = 1, kdlon
-        zfd(jl) = (1.-zclm(jl,jk1,kflev))*zdnf(jl, 1, jk1)
-      END DO
-
-      ! *                 CONTRIBUTION FROM ADJACENT CLOUD
-
-      DO jl = 1, kdlon
-        zfd(jl) = zfd(jl) + zclm(jl, jk1, jk1)*zdnf(jl, jk1+1, jk1)
-      END DO
-
-      ! *                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-
-      DO jk = kflev - 1, jk1, -1
-        DO jl = 1, kdlon
-          zcfrac = zclm(jl, jk1, jk+1) - zclm(jl, jk1, jk)
-          zfd(jl) = zfd(jl) + zcfrac*zdnf(jl, jk+2, jk1)
-        END DO
-      END DO
-
-      DO jl = 1, kdlon
-        pflux(jl, 2, jk1) = zfd(jl)
-      END DO
-
-    END DO
-
-    ! *         3.2     UPWARD FLUX AT THE SURFACE
-    ! --------------------------
-
-
-    DO jl = 1, kdlon
-      pflux(jl, 1, 1) = pemis(jl)*pbsuin(jl) - (1.-pemis(jl))*pflux(jl, 2, 1)
-    END DO
-
-    ! *         3.3     UPWARD FLUXES
-    ! -------------
-
-
-    DO jk1 = 2, kflev + 1
-
-      ! *                 CONTRIBUTION FROM CLEAR-SKY FRACTION
-
-      DO jl = 1, kdlon
-        zfu(jl) = (1.-zclm(jl,jk1,1))*zupf(jl, 1, jk1)
-      END DO
-
-      ! *                 CONTRIBUTION FROM ADJACENT CLOUD
-
-      DO jl = 1, kdlon
-        zfu(jl) = zfu(jl) + zclm(jl, jk1, jk1-1)*zupf(jl, jk1, jk1)
-      END DO
-
-      ! *                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-
-      DO jk = 2, jk1 - 1
-        DO jl = 1, kdlon
-          zcfrac = zclm(jl, jk1, jk-1) - zclm(jl, jk1, jk)
-          zfu(jl) = zfu(jl) + zcfrac*zupf(jl, jk, jk1)
-        END DO
-      END DO
-
-      DO jl = 1, kdlon
-        pflux(jl, 1, jk1) = zfu(jl)
-      END DO
-
-    END DO
-
-
-  END IF
-
-  ! *         2.3     END OF CLOUD EFFECT COMPUTATIONS
-
-
-  IF (.NOT. levoigt) THEN
-    DO jl = 1, kdlon
-      zfn10(jl) = pflux(jl, 1, klim) + pflux(jl, 2, klim)
-    END DO
-    DO jk = klim + 1, kflev + 1
-      DO jl = 1, kdlon
-        zfn10(jl) = zfn10(jl) + pcts(jl, jk-1)
-        pflux(jl, 1, jk) = zfn10(jl)
-        pflux(jl, 2, jk) = 0.0
-      END DO
-    END DO
-  END IF
-
-  RETURN
-END SUBROUTINE lwc_lmdar4
-SUBROUTINE lwb_lmdar4(pdt0, ptave, ptl, pb, pbint, pbsuin, pbsur, pbtop, &
-    pdbsl, pga, pgb, pgasur, pgbsur, pgatop, pgbtop)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: tintp, xp, ga, gb
-  IMPLICIT NONE
-  include "raddimlw.h"
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! COMPUTES PLANCK FUNCTIONS
-
-  ! EXPLICIT ARGUMENTS :
-  ! --------------------
-  ! ==== INPUTS ===
-  ! PDT0   : (KDLON)             ; SURFACE TEMPERATURE DISCONTINUITY
-  ! PTAVE  : (KDLON,KFLEV)       ; TEMPERATURE
-  ! PTL    : (KDLON,0:KFLEV)     ; HALF LEVEL TEMPERATURE
-  ! ==== OUTPUTS ===
-  ! PB     : (KDLON,Ninter,KFLEV+1); SPECTRAL HALF LEVEL PLANCK FUNCTION
-  ! PBINT  : (KDLON,KFLEV+1)     ; HALF LEVEL PLANCK FUNCTION
-  ! PBSUIN : (KDLON)             ; SURFACE PLANCK FUNCTION
-  ! PBSUR  : (KDLON,Ninter)        ; SURFACE SPECTRAL PLANCK FUNCTION
-  ! PBTOP  : (KDLON,Ninter)        ; TOP SPECTRAL PLANCK FUNCTION
-  ! PDBSL  : (KDLON,Ninter,KFLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT
-  ! PGA    : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
-  ! PGB    : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
-  ! PGASUR, PGBSUR (KDLON,8,2)   ; SURFACE PADE APPROXIMANTS
-  ! PGATOP, PGBTOP (KDLON,8,2)   ; T.O.A. PADE APPROXIMANTS
-
-  ! IMPLICIT ARGUMENTS :   NONE
-  ! --------------------
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS
-  ! FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS           "
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-
-  ! -----------------------------------------------------------------------
-
-  ! ARGUMENTS:
-
-  REAL (KIND=8) pdt0(kdlon)
-  REAL (KIND=8) ptave(kdlon, kflev)
-  REAL (KIND=8) ptl(kdlon, kflev+1)
-
-  REAL (KIND=8) pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION
-  REAL (KIND=8) pbint(kdlon, kflev+1) ! HALF LEVEL PLANCK FUNCTION
-  REAL (KIND=8) pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
-  REAL (KIND=8) pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
-  REAL (KIND=8) pbtop(kdlon, ninter) ! TOP SPECTRAL PLANCK FUNCTION
-  REAL (KIND=8) pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
-  REAL (KIND=8) pga(kdlon, 8, 2, kflev) ! dB/dT-weighted LAYER PADE APPROXIMANTS
-  REAL (KIND=8) pgb(kdlon, 8, 2, kflev) ! dB/dT-weighted LAYER PADE APPROXIMANTS
-  REAL (KIND=8) pgasur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
-  REAL (KIND=8) pgbsur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
-  REAL (KIND=8) pgatop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
-  REAL (KIND=8) pgbtop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
-
-  ! -------------------------------------------------------------------------
-  ! *  LOCAL VARIABLES:
-  INTEGER indb(kdlon), inds(kdlon)
-  REAL (KIND=8) zblay(kdlon, kflev), zblev(kdlon, kflev+1)
-  REAL (KIND=8) zres(kdlon), zres2(kdlon), zti(kdlon), zti2(kdlon)
-
-  INTEGER jk, jl, ic, jnu, jf, jg
-  INTEGER jk1, jk2
-  INTEGER k, j, ixtox, indto, ixtx, indt
-  INTEGER indsu, indtp
-  REAL (KIND=8) zdsto1, zdstox, zdst1, zdstx
-
-  ! * Quelques parametres:
-  REAL (KIND=8) tstand
-  PARAMETER (tstand=250.0)
-  REAL (KIND=8) tstp
-  PARAMETER (tstp=12.5)
-  INTEGER mxixt
-  PARAMETER (mxixt=10)
-
-  ! * Used Data Block:
-  ! REAL*8 TINTP(11)
-  ! SAVE TINTP
-  ! c$OMP THREADPRIVATE(TINTP)
-  ! REAL*8 GA(11,16,3), GB(11,16,3)
-  ! SAVE GA, GB
-  ! c$OMP THREADPRIVATE(GA, GB)
-  ! REAL*8 XP(6,6)
-  ! SAVE XP
-  ! c$OMP THREADPRIVATE(XP)
-
-  ! DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250.,
-  ! S             262.5, 275., 287.5, 300., 312.5 /
-  ! -----------------------------------------------------------------------
-  ! -- WATER VAPOR -- INT.1 -- 0- 500 CM-1 -- FROM ABS225 ----------------
-
-
-
-
-  ! -- R.D. -- G = - 0.2 SLA
-
-
-  ! ----- INTERVAL = 1 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 1, 1,IC),IC=1,3) /
-  ! S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/
-  ! DATA (GB( 1, 1,IC),IC=1,3) /
-  ! S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/
-  ! DATA (GA( 1, 2,IC),IC=1,3) /
-  ! S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/
-  ! DATA (GB( 1, 2,IC),IC=1,3) /
-  ! S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 2, 1,IC),IC=1,3) /
-  ! S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/
-  ! DATA (GB( 2, 1,IC),IC=1,3) /
-  ! S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/
-  ! DATA (GA( 2, 2,IC),IC=1,3) /
-  ! S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/
-  ! DATA (GB( 2, 2,IC),IC=1,3) /
-  ! S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 3, 1,IC),IC=1,3) /
-  ! S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/
-  ! DATA (GB( 3, 1,IC),IC=1,3) /
-  ! S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/
-  ! DATA (GA( 3, 2,IC),IC=1,3) /
-  ! S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/
-  ! DATA (GB( 3, 2,IC),IC=1,3) /
-  ! S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 4, 1,IC),IC=1,3) /
-  ! S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/
-  ! DATA (GB( 4, 1,IC),IC=1,3) /
-  ! S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/
-  ! DATA (GA( 4, 2,IC),IC=1,3) /
-  ! S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/
-  ! DATA (GB( 4, 2,IC),IC=1,3) /
-  ! S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 5, 1,IC),IC=1,3) /
-  ! S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/
-  ! DATA (GB( 5, 1,IC),IC=1,3) /
-  ! S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/
-  ! DATA (GA( 5, 2,IC),IC=1,3) /
-  ! S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/
-  ! DATA (GB( 5, 2,IC),IC=1,3) /
-  ! S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 6, 1,IC),IC=1,3) /
-  ! S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/
-  ! DATA (GB( 6, 1,IC),IC=1,3) /
-  ! S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/
-  ! DATA (GA( 6, 2,IC),IC=1,3) /
-  ! S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/
-  ! DATA (GB( 6, 2,IC),IC=1,3) /
-  ! S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 7, 1,IC),IC=1,3) /
-  ! S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/
-  ! DATA (GB( 7, 1,IC),IC=1,3) /
-  ! S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/
-  ! DATA (GA( 7, 2,IC),IC=1,3) /
-  ! S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/
-  ! DATA (GB( 7, 2,IC),IC=1,3) /
-  ! S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 8, 1,IC),IC=1,3) /
-  ! S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/
-  ! DATA (GB( 8, 1,IC),IC=1,3) /
-  ! S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/
-  ! DATA (GA( 8, 2,IC),IC=1,3) /
-  ! S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/
-  ! DATA (GB( 8, 2,IC),IC=1,3) /
-  ! S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 9, 1,IC),IC=1,3) /
-  ! S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/
-  ! DATA (GB( 9, 1,IC),IC=1,3) /
-  ! S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/
-  ! DATA (GA( 9, 2,IC),IC=1,3) /
-  ! S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/
-  ! DATA (GB( 9, 2,IC),IC=1,3) /
-  ! S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA(10, 1,IC),IC=1,3) /
-  ! S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/
-  ! DATA (GB(10, 1,IC),IC=1,3) /
-  ! S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/
-  ! DATA (GA(10, 2,IC),IC=1,3) /
-  ! S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/
-  ! DATA (GB(10, 2,IC),IC=1,3) /
-  ! S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 1 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA(11, 1,IC),IC=1,3) /
-  ! S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/
-  ! DATA (GB(11, 1,IC),IC=1,3) /
-  ! S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/
-  ! DATA (GA(11, 2,IC),IC=1,3) /
-  ! S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/
-  ! DATA (GB(11, 2,IC),IC=1,3) /
-  ! S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/
-
-
-
-  ! --- WATER VAPOR --- INTERVAL 2 -- 500-800 CM-1--- FROM ABS225 ---------
-
-
-
-
-  ! --- R.D.  ---  G = 0.02 + 0.50 / ( 1 + 4.5 U )
-
-
-  ! ----- INTERVAL = 2 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 1, 3,IC),IC=1,3) /
-  ! S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/
-  ! DATA (GB( 1, 3,IC),IC=1,3) /
-  ! S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/
-  ! DATA (GA( 1, 4,IC),IC=1,3) /
-  ! S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/
-  ! DATA (GB( 1, 4,IC),IC=1,3) /
-  ! S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 2, 3,IC),IC=1,3) /
-  ! S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/
-  ! DATA (GB( 2, 3,IC),IC=1,3) /
-  ! S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/
-  ! DATA (GA( 2, 4,IC),IC=1,3) /
-  ! S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/
-  ! DATA (GB( 2, 4,IC),IC=1,3) /
-  ! S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 3, 3,IC),IC=1,3) /
-  ! S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/
-  ! DATA (GB( 3, 3,IC),IC=1,3) /
-  ! S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/
-  ! DATA (GA( 3, 4,IC),IC=1,3) /
-  ! S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/
-  ! DATA (GB( 3, 4,IC),IC=1,3) /
-  ! S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 4, 3,IC),IC=1,3) /
-  ! S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/
-  ! DATA (GB( 4, 3,IC),IC=1,3) /
-  ! S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/
-  ! DATA (GA( 4, 4,IC),IC=1,3) /
-  ! S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/
-  ! DATA (GB( 4, 4,IC),IC=1,3) /
-  ! S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 5, 3,IC),IC=1,3) /
-  ! S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/
-  ! DATA (GB( 5, 3,IC),IC=1,3) /
-  ! S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/
-  ! DATA (GA( 5, 4,IC),IC=1,3) /
-  ! S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/
-  ! DATA (GB( 5, 4,IC),IC=1,3) /
-  ! S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 6, 3,IC),IC=1,3) /
-  ! S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/
-  ! DATA (GB( 6, 3,IC),IC=1,3) /
-  ! S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/
-  ! DATA (GA( 6, 4,IC),IC=1,3) /
-  ! S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/
-  ! DATA (GB( 6, 4,IC),IC=1,3) /
-  ! S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 7, 3,IC),IC=1,3) /
-  ! S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/
-  ! DATA (GB( 7, 3,IC),IC=1,3) /
-  ! S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/
-  ! DATA (GA( 7, 4,IC),IC=1,3) /
-  ! S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/
-  ! DATA (GB( 7, 4,IC),IC=1,3) /
-  ! S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 8, 3,IC),IC=1,3) /
-  ! S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/
-  ! DATA (GB( 8, 3,IC),IC=1,3) /
-  ! S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/
-  ! DATA (GA( 8, 4,IC),IC=1,3) /
-  ! S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/
-  ! DATA (GB( 8, 4,IC),IC=1,3) /
-  ! S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 9, 3,IC),IC=1,3) /
-  ! S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/
-  ! DATA (GB( 9, 3,IC),IC=1,3) /
-  ! S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/
-  ! DATA (GA( 9, 4,IC),IC=1,3) /
-  ! S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/
-  ! DATA (GB( 9, 4,IC),IC=1,3) /
-  ! S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA(10, 3,IC),IC=1,3) /
-  ! S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/
-  ! DATA (GB(10, 3,IC),IC=1,3) /
-  ! S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/
-  ! DATA (GA(10, 4,IC),IC=1,3) /
-  ! S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/
-  ! DATA (GB(10, 4,IC),IC=1,3) /
-  ! S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA(11, 3,IC),IC=1,3) /
-  ! S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/
-  ! DATA (GB(11, 3,IC),IC=1,3) /
-  ! S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/
-  ! DATA (GA(11, 4,IC),IC=1,3) /
-  ! S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/
-  ! DATA (GB(11, 4,IC),IC=1,3) /
-  ! S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/
-
-
-
-
-
-
-  ! - WATER VAPOR - INT. 3 -- 800-970 + 1110-1250 CM-1 -- FIT FROM 215 IS -
-
-
-  ! -- WATER VAPOR LINES IN THE WINDOW REGION (800-1250 CM-1)
-
-
-
-  ! --- G = 3.875E-03 ---------------
-
-  ! ----- INTERVAL = 3 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 1, 7,IC),IC=1,3) /
-  ! S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/
-  ! DATA (GB( 1, 7,IC),IC=1,3) /
-  ! S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/
-  ! DATA (GA( 1, 8,IC),IC=1,3) /
-  ! S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/
-  ! DATA (GB( 1, 8,IC),IC=1,3) /
-  ! S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 2, 7,IC),IC=1,3) /
-  ! S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/
-  ! DATA (GB( 2, 7,IC),IC=1,3) /
-  ! S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/
-  ! DATA (GA( 2, 8,IC),IC=1,3) /
-  ! S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/
-  ! DATA (GB( 2, 8,IC),IC=1,3) /
-  ! S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 3, 7,IC),IC=1,3) /
-  ! S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/
-  ! DATA (GB( 3, 7,IC),IC=1,3) /
-  ! S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/
-  ! DATA (GA( 3, 8,IC),IC=1,3) /
-  ! S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/
-  ! DATA (GB( 3, 8,IC),IC=1,3) /
-  ! S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 4, 7,IC),IC=1,3) /
-  ! S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/
-  ! DATA (GB( 4, 7,IC),IC=1,3) /
-  ! S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/
-  ! DATA (GA( 4, 8,IC),IC=1,3) /
-  ! S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/
-  ! DATA (GB( 4, 8,IC),IC=1,3) /
-  ! S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 5, 7,IC),IC=1,3) /
-  ! S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/
-  ! DATA (GB( 5, 7,IC),IC=1,3) /
-  ! S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/
-  ! DATA (GA( 5, 8,IC),IC=1,3) /
-  ! S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/
-  ! DATA (GB( 5, 8,IC),IC=1,3) /
-  ! S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 6, 7,IC),IC=1,3) /
-  ! S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/
-  ! DATA (GB( 6, 7,IC),IC=1,3) /
-  ! S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/
-  ! DATA (GA( 6, 8,IC),IC=1,3) /
-  ! S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/
-  ! DATA (GB( 6, 8,IC),IC=1,3) /
-  ! S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 7, 7,IC),IC=1,3) /
-  ! S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/
-  ! DATA (GB( 7, 7,IC),IC=1,3) /
-  ! S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/
-  ! DATA (GA( 7, 8,IC),IC=1,3) /
-  ! S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/
-  ! DATA (GB( 7, 8,IC),IC=1,3) /
-  ! S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 8, 7,IC),IC=1,3) /
-  ! S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/
-  ! DATA (GB( 8, 7,IC),IC=1,3) /
-  ! S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/
-  ! DATA (GA( 8, 8,IC),IC=1,3) /
-  ! S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/
-  ! DATA (GB( 8, 8,IC),IC=1,3) /
-  ! S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 9, 7,IC),IC=1,3) /
-  ! S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/
-  ! DATA (GB( 9, 7,IC),IC=1,3) /
-  ! S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/
-  ! DATA (GA( 9, 8,IC),IC=1,3) /
-  ! S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/
-  ! DATA (GB( 9, 8,IC),IC=1,3) /
-  ! S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA(10, 7,IC),IC=1,3) /
-  ! S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/
-  ! DATA (GB(10, 7,IC),IC=1,3) /
-  ! S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/
-  ! DATA (GA(10, 8,IC),IC=1,3) /
-  ! S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/
-  ! DATA (GB(10, 8,IC),IC=1,3) /
-  ! S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 3 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA(11, 7,IC),IC=1,3) /
-  ! S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/
-  ! DATA (GB(11, 7,IC),IC=1,3) /
-  ! S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/
-  ! DATA (GA(11, 8,IC),IC=1,3) /
-  ! S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/
-  ! DATA (GB(11, 8,IC),IC=1,3) /
-  ! S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/
-
-
-  ! -- WATER VAPOR -- 970-1110 CM-1 ----------------------------------------
-
-  ! -- G = 3.6E-03
-
-  ! ----- INTERVAL = 4 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 1, 9,IC),IC=1,3) /
-  ! S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/
-  ! DATA (GB( 1, 9,IC),IC=1,3) /
-  ! S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/
-  ! DATA (GA( 1,10,IC),IC=1,3) /
-  ! S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/
-  ! DATA (GB( 1,10,IC),IC=1,3) /
-  ! S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 2, 9,IC),IC=1,3) /
-  ! S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/
-  ! DATA (GB( 2, 9,IC),IC=1,3) /
-  ! S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/
-  ! DATA (GA( 2,10,IC),IC=1,3) /
-  ! S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/
-  ! DATA (GB( 2,10,IC),IC=1,3) /
-  ! S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 3, 9,IC),IC=1,3) /
-  ! S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/
-  ! DATA (GB( 3, 9,IC),IC=1,3) /
-  ! S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/
-  ! DATA (GA( 3,10,IC),IC=1,3) /
-  ! S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/
-  ! DATA (GB( 3,10,IC),IC=1,3) /
-  ! S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 4, 9,IC),IC=1,3) /
-  ! S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/
-  ! DATA (GB( 4, 9,IC),IC=1,3) /
-  ! S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/
-  ! DATA (GA( 4,10,IC),IC=1,3) /
-  ! S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/
-  ! DATA (GB( 4,10,IC),IC=1,3) /
-  ! S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 5, 9,IC),IC=1,3) /
-  ! S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/
-  ! DATA (GB( 5, 9,IC),IC=1,3) /
-  ! S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/
-  ! DATA (GA( 5,10,IC),IC=1,3) /
-  ! S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/
-  ! DATA (GB( 5,10,IC),IC=1,3) /
-  ! S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 6, 9,IC),IC=1,3) /
-  ! S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/
-  ! DATA (GB( 6, 9,IC),IC=1,3) /
-  ! S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/
-  ! DATA (GA( 6,10,IC),IC=1,3) /
-  ! S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/
-  ! DATA (GB( 6,10,IC),IC=1,3) /
-  ! S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 7, 9,IC),IC=1,3) /
-  ! S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/
-  ! DATA (GB( 7, 9,IC),IC=1,3) /
-  ! S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/
-  ! DATA (GA( 7,10,IC),IC=1,3) /
-  ! S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/
-  ! DATA (GB( 7,10,IC),IC=1,3) /
-  ! S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 8, 9,IC),IC=1,3) /
-  ! S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/
-  ! DATA (GB( 8, 9,IC),IC=1,3) /
-  ! S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/
-  ! DATA (GA( 8,10,IC),IC=1,3) /
-  ! S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/
-  ! DATA (GB( 8,10,IC),IC=1,3) /
-  ! S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA( 9, 9,IC),IC=1,3) /
-  ! S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/
-  ! DATA (GB( 9, 9,IC),IC=1,3) /
-  ! S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/
-  ! DATA (GA( 9,10,IC),IC=1,3) /
-  ! S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/
-  ! DATA (GB( 9,10,IC),IC=1,3) /
-  ! S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA(10, 9,IC),IC=1,3) /
-  ! S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/
-  ! DATA (GB(10, 9,IC),IC=1,3) /
-  ! S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/
-  ! DATA (GA(10,10,IC),IC=1,3) /
-  ! S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/
-  ! DATA (GB(10,10,IC),IC=1,3) /
-  ! S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   28   37   45
-  ! DATA (GA(11, 9,IC),IC=1,3) /
-  ! S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/
-  ! DATA (GB(11, 9,IC),IC=1,3) /
-  ! S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/
-  ! DATA (GA(11,10,IC),IC=1,3) /
-  ! S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/
-  ! DATA (GB(11,10,IC),IC=1,3) /
-  ! S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/
-
-
-
-  ! -- H2O -- WEAKER PARTS OF THE STRONG BANDS  -- FROM ABS225 ----
-
-  ! -- WATER VAPOR --- 350 - 500 CM-1
-
-  ! -- G = - 0.2*SLA, 0.0 +0.5/(1+0.5U)
-
-  ! ----- INTERVAL = 5 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 1, 5,IC),IC=1,3) /
-  ! S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/
-  ! DATA (GB( 1, 5,IC),IC=1,3) /
-  ! S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/
-  ! DATA (GA( 1, 6,IC),IC=1,3) /
-  ! S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/
-  ! DATA (GB( 1, 6,IC),IC=1,3) /
-  ! S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 2, 5,IC),IC=1,3) /
-  ! S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/
-  ! DATA (GB( 2, 5,IC),IC=1,3) /
-  ! S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/
-  ! DATA (GA( 2, 6,IC),IC=1,3) /
-  ! S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/
-  ! DATA (GB( 2, 6,IC),IC=1,3) /
-  ! S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 3, 5,IC),IC=1,3) /
-  ! S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/
-  ! DATA (GB( 3, 5,IC),IC=1,3) /
-  ! S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/
-  ! DATA (GA( 3, 6,IC),IC=1,3) /
-  ! S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/
-  ! DATA (GB( 3, 6,IC),IC=1,3) /
-  ! S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 4, 5,IC),IC=1,3) /
-  ! S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/
-  ! DATA (GB( 4, 5,IC),IC=1,3) /
-  ! S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/
-  ! DATA (GA( 4, 6,IC),IC=1,3) /
-  ! S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/
-  ! DATA (GB( 4, 6,IC),IC=1,3) /
-  ! S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 5, 5,IC),IC=1,3) /
-  ! S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/
-  ! DATA (GB( 5, 5,IC),IC=1,3) /
-  ! S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/
-  ! DATA (GA( 5, 6,IC),IC=1,3) /
-  ! S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/
-  ! DATA (GB( 5, 6,IC),IC=1,3) /
-  ! S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 6, 5,IC),IC=1,3) /
-  ! S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/
-  ! DATA (GB( 6, 5,IC),IC=1,3) /
-  ! S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/
-  ! DATA (GA( 6, 6,IC),IC=1,3) /
-  ! S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/
-  ! DATA (GB( 6, 6,IC),IC=1,3) /
-  ! S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 7, 5,IC),IC=1,3) /
-  ! S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/
-  ! DATA (GB( 7, 5,IC),IC=1,3) /
-  ! S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/
-  ! DATA (GA( 7, 6,IC),IC=1,3) /
-  ! S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/
-  ! DATA (GB( 7, 6,IC),IC=1,3) /
-  ! S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 8, 5,IC),IC=1,3) /
-  ! S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/
-  ! DATA (GB( 8, 5,IC),IC=1,3) /
-  ! S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/
-  ! DATA (GA( 8, 6,IC),IC=1,3) /
-  ! S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/
-  ! DATA (GB( 8, 6,IC),IC=1,3) /
-  ! S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 9, 5,IC),IC=1,3) /
-  ! S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/
-  ! DATA (GB( 9, 5,IC),IC=1,3) /
-  ! S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/
-  ! DATA (GA( 9, 6,IC),IC=1,3) /
-  ! S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/
-  ! DATA (GB( 9, 6,IC),IC=1,3) /
-  ! S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA(10, 5,IC),IC=1,3) /
-  ! S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/
-  ! DATA (GB(10, 5,IC),IC=1,3) /
-  ! S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/
-  ! DATA (GA(10, 6,IC),IC=1,3) /
-  ! S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/
-  ! DATA (GB(10, 6,IC),IC=1,3) /
-  ! S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/
-
-  ! ----- INTERVAL = 5 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA(11, 5,IC),IC=1,3) /
-  ! S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/
-  ! DATA (GB(11, 5,IC),IC=1,3) /
-  ! S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/
-  ! DATA (GA(11, 6,IC),IC=1,3) /
-  ! S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/
-  ! DATA (GB(11, 6,IC),IC=1,3) /
-  ! S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/
-
-
-
-
-  ! - WATER VAPOR - WINGS OF VIBRATION-ROTATION BAND - 1250-1450+1880-2820 -
-  ! --- G = 0.0
-
-
-  ! ----- INTERVAL = 6 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 1,11,IC),IC=1,3) /
-  ! S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/
-  ! DATA (GB( 1,11,IC),IC=1,3) /
-  ! S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/
-  ! DATA (GA( 1,12,IC),IC=1,3) /
-  ! S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/
-  ! DATA (GB( 1,12,IC),IC=1,3) /
-  ! S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 2,11,IC),IC=1,3) /
-  ! S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/
-  ! DATA (GB( 2,11,IC),IC=1,3) /
-  ! S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/
-  ! DATA (GA( 2,12,IC),IC=1,3) /
-  ! S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/
-  ! DATA (GB( 2,12,IC),IC=1,3) /
-  ! S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 3,11,IC),IC=1,3) /
-  ! S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/
-  ! DATA (GB( 3,11,IC),IC=1,3) /
-  ! S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/
-  ! DATA (GA( 3,12,IC),IC=1,3) /
-  ! S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/
-  ! DATA (GB( 3,12,IC),IC=1,3) /
-  ! S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 4,11,IC),IC=1,3) /
-  ! S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/
-  ! DATA (GB( 4,11,IC),IC=1,3) /
-  ! S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/
-  ! DATA (GA( 4,12,IC),IC=1,3) /
-  ! S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/
-  ! DATA (GB( 4,12,IC),IC=1,3) /
-  ! S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 5,11,IC),IC=1,3) /
-  ! S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/
-  ! DATA (GB( 5,11,IC),IC=1,3) /
-  ! S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/
-  ! DATA (GA( 5,12,IC),IC=1,3) /
-  ! S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/
-  ! DATA (GB( 5,12,IC),IC=1,3) /
-  ! S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 6,11,IC),IC=1,3) /
-  ! S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/
-  ! DATA (GB( 6,11,IC),IC=1,3) /
-  ! S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/
-  ! DATA (GA( 6,12,IC),IC=1,3) /
-  ! S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/
-  ! DATA (GB( 6,12,IC),IC=1,3) /
-  ! S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 7,11,IC),IC=1,3) /
-  ! S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/
-  ! DATA (GB( 7,11,IC),IC=1,3) /
-  ! S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/
-  ! DATA (GA( 7,12,IC),IC=1,3) /
-  ! S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/
-  ! DATA (GB( 7,12,IC),IC=1,3) /
-  ! S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 8,11,IC),IC=1,3) /
-  ! S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/
-  ! DATA (GB( 8,11,IC),IC=1,3) /
-  ! S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/
-  ! DATA (GA( 8,12,IC),IC=1,3) /
-  ! S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/
-  ! DATA (GB( 8,12,IC),IC=1,3) /
-  ! S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA( 9,11,IC),IC=1,3) /
-  ! S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/
-  ! DATA (GB( 9,11,IC),IC=1,3) /
-  ! S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/
-  ! DATA (GA( 9,12,IC),IC=1,3) /
-  ! S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/
-  ! DATA (GB( 9,12,IC),IC=1,3) /
-  ! S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA(10,11,IC),IC=1,3) /
-  ! S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/
-  ! DATA (GB(10,11,IC),IC=1,3) /
-  ! S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/
-  ! DATA (GA(10,12,IC),IC=1,3) /
-  ! S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/
-  ! DATA (GB(10,12,IC),IC=1,3) /
-  ! S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 6 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 35 40 45
-  ! DATA (GA(11,11,IC),IC=1,3) /
-  ! S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/
-  ! DATA (GB(11,11,IC),IC=1,3) /
-  ! S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/
-  ! DATA (GA(11,12,IC),IC=1,3) /
-  ! S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/
-  ! DATA (GB(11,12,IC),IC=1,3) /
-  ! S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/
-
-
-
-
-
-  ! -- END WATER VAPOR
-
-
-  ! -- CO2 -- INT.2 -- 500-800 CM-1 --- FROM ABS225 ----------------------
-
-
-
-  ! -- FIU = 0.8 + MAX(0.35,(7-IU)*0.9)  , X/T,  9
-
-  ! ----- INTERVAL = 2 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 1,13,IC),IC=1,3) /
-  ! S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/
-  ! DATA (GB( 1,13,IC),IC=1,3) /
-  ! S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/
-  ! DATA (GA( 1,14,IC),IC=1,3) /
-  ! S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/
-  ! DATA (GB( 1,14,IC),IC=1,3) /
-  ! S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 2,13,IC),IC=1,3) /
-  ! S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/
-  ! DATA (GB( 2,13,IC),IC=1,3) /
-  ! S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/
-  ! DATA (GA( 2,14,IC),IC=1,3) /
-  ! S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/
-  ! DATA (GB( 2,14,IC),IC=1,3) /
-  ! S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 3,13,IC),IC=1,3) /
-  ! S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/
-  ! DATA (GB( 3,13,IC),IC=1,3) /
-  ! S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/
-  ! DATA (GA( 3,14,IC),IC=1,3) /
-  ! S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/
-  ! DATA (GB( 3,14,IC),IC=1,3) /
-  ! S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 4,13,IC),IC=1,3) /
-  ! S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/
-  ! DATA (GB( 4,13,IC),IC=1,3) /
-  ! S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/
-  ! DATA (GA( 4,14,IC),IC=1,3) /
-  ! S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/
-  ! DATA (GB( 4,14,IC),IC=1,3) /
-  ! S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 5,13,IC),IC=1,3) /
-  ! S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/
-  ! DATA (GB( 5,13,IC),IC=1,3) /
-  ! S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/
-  ! DATA (GA( 5,14,IC),IC=1,3) /
-  ! S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/
-  ! DATA (GB( 5,14,IC),IC=1,3) /
-  ! S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 6,13,IC),IC=1,3) /
-  ! S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/
-  ! DATA (GB( 6,13,IC),IC=1,3) /
-  ! S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/
-  ! DATA (GA( 6,14,IC),IC=1,3) /
-  ! S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/
-  ! DATA (GB( 6,14,IC),IC=1,3) /
-  ! S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 7,13,IC),IC=1,3) /
-  ! S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/
-  ! DATA (GB( 7,13,IC),IC=1,3) /
-  ! S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/
-  ! DATA (GA( 7,14,IC),IC=1,3) /
-  ! S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/
-  ! DATA (GB( 7,14,IC),IC=1,3) /
-  ! S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 8,13,IC),IC=1,3) /
-  ! S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/
-  ! DATA (GB( 8,13,IC),IC=1,3) /
-  ! S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/
-  ! DATA (GA( 8,14,IC),IC=1,3) /
-  ! S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/
-  ! DATA (GB( 8,14,IC),IC=1,3) /
-  ! S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA( 9,13,IC),IC=1,3) /
-  ! S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/
-  ! DATA (GB( 9,13,IC),IC=1,3) /
-  ! S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/
-  ! DATA (GA( 9,14,IC),IC=1,3) /
-  ! S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/
-  ! DATA (GB( 9,14,IC),IC=1,3) /
-  ! S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA(10,13,IC),IC=1,3) /
-  ! S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/
-  ! DATA (GB(10,13,IC),IC=1,3) /
-  ! S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/
-  ! DATA (GA(10,14,IC),IC=1,3) /
-  ! S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/
-  ! DATA (GB(10,14,IC),IC=1,3) /
-  ! S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/
-
-  ! ----- INTERVAL = 2 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION   1 30 38 45
-  ! DATA (GA(11,13,IC),IC=1,3) /
-  ! S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/
-  ! DATA (GB(11,13,IC),IC=1,3) /
-  ! S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/
-  ! DATA (GA(11,14,IC),IC=1,3) /
-  ! S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/
-  ! DATA (GB(11,14,IC),IC=1,3) /
-  ! S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/
-
-
-
-
-
-
-
-
-
-
-  ! -- CARBON DIOXIDE LINES IN THE WINDOW REGION (800-1250 CM-1)
-
-
-  ! -- G = 0.0
-
-
-  ! ----- INTERVAL = 4 ----- T =  187.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 1,15,IC),IC=1,3) /
-  ! S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/
-  ! DATA (GB( 1,15,IC),IC=1,3) /
-  ! S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/
-  ! DATA (GA( 1,16,IC),IC=1,3) /
-  ! S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/
-  ! DATA (GB( 1,16,IC),IC=1,3) /
-  ! S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  200.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 2,15,IC),IC=1,3) /
-  ! S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/
-  ! DATA (GB( 2,15,IC),IC=1,3) /
-  ! S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/
-  ! DATA (GA( 2,16,IC),IC=1,3) /
-  ! S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/
-  ! DATA (GB( 2,16,IC),IC=1,3) /
-  ! S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  212.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 3,15,IC),IC=1,3) /
-  ! S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/
-  ! DATA (GB( 3,15,IC),IC=1,3) /
-  ! S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/
-  ! DATA (GA( 3,16,IC),IC=1,3) /
-  ! S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/
-  ! DATA (GB( 3,16,IC),IC=1,3) /
-  ! S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  225.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 4,15,IC),IC=1,3) /
-  ! S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/
-  ! DATA (GB( 4,15,IC),IC=1,3) /
-  ! S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/
-  ! DATA (GA( 4,16,IC),IC=1,3) /
-  ! S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/
-  ! DATA (GB( 4,16,IC),IC=1,3) /
-  ! S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  237.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 5,15,IC),IC=1,3) /
-  ! S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/
-  ! DATA (GB( 5,15,IC),IC=1,3) /
-  ! S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/
-  ! DATA (GA( 5,16,IC),IC=1,3) /
-  ! S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/
-  ! DATA (GB( 5,16,IC),IC=1,3) /
-  ! S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  250.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 6,15,IC),IC=1,3) /
-  ! S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/
-  ! DATA (GB( 6,15,IC),IC=1,3) /
-  ! S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/
-  ! DATA (GA( 6,16,IC),IC=1,3) /
-  ! S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/
-  ! DATA (GB( 6,16,IC),IC=1,3) /
-  ! S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  262.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 7,15,IC),IC=1,3) /
-  ! S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/
-  ! DATA (GB( 7,15,IC),IC=1,3) /
-  ! S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/
-  ! DATA (GA( 7,16,IC),IC=1,3) /
-  ! S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/
-  ! DATA (GB( 7,16,IC),IC=1,3) /
-  ! S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  275.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 8,15,IC),IC=1,3) /
-  ! S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/
-  ! DATA (GB( 8,15,IC),IC=1,3) /
-  ! S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/
-  ! DATA (GA( 8,16,IC),IC=1,3) /
-  ! S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/
-  ! DATA (GB( 8,16,IC),IC=1,3) /
-  ! S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  287.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA( 9,15,IC),IC=1,3) /
-  ! S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/
-  ! DATA (GB( 9,15,IC),IC=1,3) /
-  ! S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/
-  ! DATA (GA( 9,16,IC),IC=1,3) /
-  ! S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/
-  ! DATA (GB( 9,16,IC),IC=1,3) /
-  ! S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  300.0
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA(10,15,IC),IC=1,3) /
-  ! S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/
-  ! DATA (GB(10,15,IC),IC=1,3) /
-  ! S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/
-  ! DATA (GA(10,16,IC),IC=1,3) /
-  ! S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/
-  ! DATA (GB(10,16,IC),IC=1,3) /
-  ! S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/
-
-  ! ----- INTERVAL = 4 ----- T =  312.5
-
-  ! -- INDICES FOR PADE APPROXIMATION     1   15   29   45
-  ! DATA (GA(11,15,IC),IC=1,3) /
-  ! S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/
-  ! DATA (GB(11,15,IC),IC=1,3) /
-  ! S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/
-  ! DATA (GA(11,16,IC),IC=1,3) /
-  ! S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/
-  ! DATA (GB(11,16,IC),IC=1,3) /
-  ! S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/
-
-  ! ------------------------------------------------------------------
-  ! DATA (( XP(  J,K),J=1,6),       K=1,6) /
-  ! S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03,
-  ! S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03,
-  ! S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03,
-  ! S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02,
-  ! S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03,
-  ! S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02,
-  ! S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03,
-  ! S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02,
-  ! S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02,
-  ! S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01,
-  ! S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03,
-  ! S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 /
-
-
-
-  ! *         1.0     PLANCK FUNCTIONS AND GRADIENTS
-  ! ------------------------------
-
-
-  ! cdir collapse
-  DO jk = 1, kflev + 1
-    DO jl = 1, kdlon
-      pbint(jl, jk) = 0.
-    END DO
-  END DO
-  DO jl = 1, kdlon
-    pbsuin(jl) = 0.
-  END DO
-
-  DO jnu = 1, ninter
-
-    ! *         1.1   LEVELS FROM SURFACE TO KFLEV
-    ! ----------------------------
-
-
-    DO jk = 1, kflev
-      DO jl = 1, kdlon
-        zti(jl) = (ptl(jl,jk)-tstand)/tstand
-        zres(jl) = xp(1, jnu) + zti(jl)*(xp(2,jnu)+zti(jl)*(xp(3, &
-          jnu)+zti(jl)*(xp(4,jnu)+zti(jl)*(xp(5,jnu)+zti(jl)*(xp(6,jnu))))))
-        pbint(jl, jk) = pbint(jl, jk) + zres(jl)
-        pb(jl, jnu, jk) = zres(jl)
-        zblev(jl, jk) = zres(jl)
-        zti2(jl) = (ptave(jl,jk)-tstand)/tstand
-        zres2(jl) = xp(1, jnu) + zti2(jl)*(xp(2,jnu)+zti2(jl)*(xp(3, &
-          jnu)+zti2(jl)*(xp(4,jnu)+zti2(jl)*(xp(5,jnu)+zti2(jl)*(xp(6,jnu)))) &
-          ))
-        zblay(jl, jk) = zres2(jl)
-      END DO
-    END DO
-
-    ! *         1.2   TOP OF THE ATMOSPHERE AND SURFACE
-    ! ---------------------------------
-
-
-    DO jl = 1, kdlon
-      zti(jl) = (ptl(jl,kflev+1)-tstand)/tstand
-      zti2(jl) = (ptl(jl,1)+pdt0(jl)-tstand)/tstand
-      zres(jl) = xp(1, jnu) + zti(jl)*(xp(2,jnu)+zti(jl)*(xp(3, &
-        jnu)+zti(jl)*(xp(4,jnu)+zti(jl)*(xp(5,jnu)+zti(jl)*(xp(6,jnu))))))
-      zres2(jl) = xp(1, jnu) + zti2(jl)*(xp(2,jnu)+zti2(jl)*(xp(3, &
-        jnu)+zti2(jl)*(xp(4,jnu)+zti2(jl)*(xp(5,jnu)+zti2(jl)*(xp(6,jnu))))))
-      pbint(jl, kflev+1) = pbint(jl, kflev+1) + zres(jl)
-      pb(jl, jnu, kflev+1) = zres(jl)
-      zblev(jl, kflev+1) = zres(jl)
-      pbtop(jl, jnu) = zres(jl)
-      pbsur(jl, jnu) = zres2(jl)
-      pbsuin(jl) = pbsuin(jl) + zres2(jl)
-    END DO
-
-    ! *         1.3   GRADIENTS IN SUB-LAYERS
-    ! -----------------------
-
-
-    DO jk = 1, kflev
-      jk2 = 2*jk
-      jk1 = jk2 - 1
-      DO jl = 1, kdlon
-        pdbsl(jl, jnu, jk1) = zblay(jl, jk) - zblev(jl, jk)
-        pdbsl(jl, jnu, jk2) = zblev(jl, jk+1) - zblay(jl, jk)
-      END DO
-    END DO
-
-  END DO
-
-  ! *         2.0   CHOOSE THE RELEVANT SETS OF PADE APPROXIMANTS
-  ! ---------------------------------------------
-
-
-
-
-  DO jl = 1, kdlon
-    zdsto1 = (ptl(jl,kflev+1)-tintp(1))/tstp
-    ixtox = max(1, min(mxixt,int(zdsto1+1.)))
-    zdstox = (ptl(jl,kflev+1)-tintp(ixtox))/tstp
-    IF (zdstox<0.5) THEN
-      indto = ixtox
-    ELSE
-      indto = ixtox + 1
-    END IF
-    indb(jl) = indto
-    zdst1 = (ptl(jl,1)-tintp(1))/tstp
-    ixtx = max(1, min(mxixt,int(zdst1+1.)))
-    zdstx = (ptl(jl,1)-tintp(ixtx))/tstp
-    IF (zdstx<0.5) THEN
-      indt = ixtx
-    ELSE
-      indt = ixtx + 1
-    END IF
-    inds(jl) = indt
-  END DO
-
-  DO jf = 1, 2
-    DO jg = 1, 8
-      DO jl = 1, kdlon
-        indsu = inds(jl)
-        pgasur(jl, jg, jf) = ga(indsu, 2*jg-1, jf)
-        pgbsur(jl, jg, jf) = gb(indsu, 2*jg-1, jf)
-        indtp = indb(jl)
-        pgatop(jl, jg, jf) = ga(indtp, 2*jg-1, jf)
-        pgbtop(jl, jg, jf) = gb(indtp, 2*jg-1, jf)
-      END DO
-    END DO
-  END DO
-
-  DO jk = 1, kflev
-    DO jl = 1, kdlon
-      zdst1 = (ptave(jl,jk)-tintp(1))/tstp
-      ixtx = max(1, min(mxixt,int(zdst1+1.)))
-      zdstx = (ptave(jl,jk)-tintp(ixtx))/tstp
-      IF (zdstx<0.5) THEN
-        indt = ixtx
-      ELSE
-        indt = ixtx + 1
-      END IF
-      indb(jl) = indt
-    END DO
-
-    DO jf = 1, 2
-      DO jg = 1, 8
-        DO jl = 1, kdlon
-          indt = indb(jl)
-          pga(jl, jg, jf, jk) = ga(indt, 2*jg, jf)
-          pgb(jl, jg, jf, jk) = gb(indt, 2*jg, jf)
-        END DO
-      END DO
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE lwb_lmdar4
-SUBROUTINE lwv_lmdar4(kuaer, ktraer, klim, pabcu, pb, pbint, pbsuin, pbsur, &
-    pbtop, pdbsl, pemis, ppmb, ptave, pga, pgb, pgasur, pgbsur, pgatop, &
-    pgbtop, pcntrb, pcts, pfluc)
-  USE dimphy
-  IMPLICIT NONE
-  include "raddimlw.h"
-  include "YOMCST.h"
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
-  ! FLUXES OR RADIANCES
-
-  ! METHOD.
-  ! -------
-
-  ! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
-  ! CONTRIBUTIONS BY -  THE NEARBY LAYERS
-  ! -  THE DISTANT LAYERS
-  ! -  THE BOUNDARY TERMS
-  ! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! -----------------------------------------------------------------------
-
-  ! * ARGUMENTS:
-  INTEGER kuaer, ktraer, klim
-
-  REAL (KIND=8) pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS
-  REAL (KIND=8) pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
-  REAL (KIND=8) pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
-  REAL (KIND=8) pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
-  REAL (KIND=8) pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
-  REAL (KIND=8) pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
-  REAL (KIND=8) pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
-  REAL (KIND=8) pemis(kdlon) ! SURFACE EMISSIVITY
-  REAL (KIND=8) ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)
-  REAL (KIND=8) ptave(kdlon, kflev) ! TEMPERATURE
-  REAL (KIND=8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS
-
-  REAL (KIND=8) pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
-  REAL (KIND=8) pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
-  REAL (KIND=8) pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
-  ! -----------------------------------------------------------------------
-  ! LOCAL VARIABLES:
-  REAL (KIND=8) zadjd(kdlon, kflev+1)
-  REAL (KIND=8) zadju(kdlon, kflev+1)
-  REAL (KIND=8) zdbdt(kdlon, ninter, kflev)
-  REAL (KIND=8) zdisd(kdlon, kflev+1)
-  REAL (KIND=8) zdisu(kdlon, kflev+1)
-
-  INTEGER jk, jl
-  ! -----------------------------------------------------------------------
-
-  DO jk = 1, kflev + 1
-    DO jl = 1, kdlon
-      zadjd(jl, jk) = 0.
-      zadju(jl, jk) = 0.
-      zdisd(jl, jk) = 0.
-      zdisu(jl, jk) = 0.
-    END DO
-  END DO
-
-  DO jk = 1, kflev
-    DO jl = 1, kdlon
-      pcts(jl, jk) = 0.
-    END DO
-  END DO
-
-  ! * CONTRIBUTION FROM ADJACENT LAYERS
-
-  CALL lwvn_lmdar4(kuaer, ktraer, pabcu, pdbsl, pga, pgb, zadjd, zadju, &
-    pcntrb, zdbdt)
-  ! * CONTRIBUTION FROM DISTANT LAYERS
-
-  CALL lwvd_lmdar4(kuaer, ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, &
-    zdisu)
-
-  ! * EXCHANGE WITH THE BOUNDARIES
-
-  CALL lwvb_lmdar4(kuaer, ktraer, klim, pabcu, zadjd, zadju, pb, pbint, &
-    pbsuin, pbsur, pbtop, zdisd, zdisu, pemis, ppmb, pga, pgb, pgasur, &
-    pgbsur, pgatop, pgbtop, pcts, pfluc)
-
-
-  RETURN
-END SUBROUTINE lwv_lmdar4
-SUBROUTINE lwvb_lmdar4(kuaer, ktraer, klim, pabcu, padjd, padju, pb, pbint, &
-    pbsui, pbsur, pbtop, pdisd, pdisu, pemis, ppmb, pga, pgb, pgasur, pgbsur, &
-    pgatop, pgbtop, pcts, pfluc)
-  USE dimphy
-  IMPLICIT NONE
-  include "raddimlw.h"
-  include "radopt.h"
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
-  ! INTEGRATION
-
-  ! METHOD.
-  ! -------
-
-  ! 1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
-  ! ATMOSPHERE
-  ! 2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND
-  ! TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA
-  ! 3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! Voigt lines (loop 2413 to 2427)  - JJM & PhD - 01/96
-  ! -----------------------------------------------------------------------
-
-  ! *       0.1   ARGUMENTS
-  ! ---------
-
-  INTEGER kuaer, ktraer, klim
-
-  REAL (KIND=8) pabcu(kdlon, nua, 3*kflev+1) ! ABSORBER AMOUNTS
-  REAL (KIND=8) padjd(kdlon, kflev+1) ! CONTRIBUTION BY ADJACENT LAYERS
-  REAL (KIND=8) padju(kdlon, kflev+1) ! CONTRIBUTION BY ADJACENT LAYERS
-  REAL (KIND=8) pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
-  REAL (KIND=8) pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
-  REAL (KIND=8) pbsur(kdlon, ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
-  REAL (KIND=8) pbsui(kdlon) ! SURFACE PLANCK FUNCTION
-  REAL (KIND=8) pbtop(kdlon, ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
-  REAL (KIND=8) pdisd(kdlon, kflev+1) ! CONTRIBUTION BY DISTANT LAYERS
-  REAL (KIND=8) pdisu(kdlon, kflev+1) ! CONTRIBUTION BY DISTANT LAYERS
-  REAL (KIND=8) pemis(kdlon) ! SURFACE EMISSIVITY
-  REAL (KIND=8) ppmb(kdlon, kflev+1) ! PRESSURE MB
-  REAL (KIND=8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgasur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
-  REAL (KIND=8) pgbsur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
-  REAL (KIND=8) pgatop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
-  REAL (KIND=8) pgbtop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
-
-  REAL (KIND=8) pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
-  REAL (KIND=8) pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
-
-  ! * LOCAL VARIABLES:
-
-  REAL (KIND=8) zbgnd(kdlon)
-  REAL (KIND=8) zfd(kdlon)
-  REAL (KIND=8) zfn10(kdlon)
-  REAL (KIND=8) zfu(kdlon)
-  REAL (KIND=8) ztt(kdlon, ntra)
-  REAL (KIND=8) ztt1(kdlon, ntra)
-  REAL (KIND=8) ztt2(kdlon, ntra)
-  REAL (KIND=8) zuu(kdlon, nua)
-  REAL (KIND=8) zcnsol(kdlon)
-  REAL (KIND=8) zcntop(kdlon)
-
-  INTEGER jk, jl, ja
-  INTEGER jstra, jstru
-  INTEGER ind1, ind2, ind3, ind4, in, jlim
-  REAL (KIND=8) zctstr
-
-  ! -----------------------------------------------------------------------
-
-  ! *         1.    INITIALIZATION
-  ! --------------
-
-
-
-  ! *         1.2     INITIALIZE TRANSMISSION FUNCTIONS
-  ! ---------------------------------
-
-
-  DO ja = 1, ntra
-    DO jl = 1, kdlon
-      ztt(jl, ja) = 1.0
-      ztt1(jl, ja) = 1.0
-      ztt2(jl, ja) = 1.0
-    END DO
-  END DO
-
-  DO ja = 1, nua
-    DO jl = 1, kdlon
-      zuu(jl, ja) = 1.0
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.      VERTICAL INTEGRATION
-  ! --------------------
-
-
-  ind1 = 0
-  ind3 = 0
-  ind4 = 1
-  ind2 = 1
-
-  ! *         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE
-  ! -----------------------------------
-
-
-  DO jk = 1, kflev
-    in = (jk-1)*ng1p1 + 1
-
-    DO ja = 1, kuaer
-      DO jl = 1, kdlon
-        zuu(jl, ja) = pabcu(jl, ja, in)
-      END DO
-    END DO
-
-
-    CALL lwtt_lmdar4(pgatop(1,1,1), pgbtop(1,1,1), zuu, ztt)
-
-    DO jl = 1, kdlon
-      zcntop(jl) = pbtop(jl, 1)*ztt(jl, 1)*ztt(jl, 10) + &
-        pbtop(jl, 2)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
-        pbtop(jl, 3)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
-        pbtop(jl, 4)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
-        pbtop(jl, 5)*ztt(jl, 3)*ztt(jl, 14) + pbtop(jl, 6)*ztt(jl, 6)*ztt(jl, &
-        15)
-      zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
-      pfluc(jl, 2, jk) = zfd(jl)
-    END DO
-
-  END DO
-
-  jk = kflev + 1
-  in = (jk-1)*ng1p1 + 1
-
-  DO jl = 1, kdlon
-    zcntop(jl) = pbtop(jl, 1) + pbtop(jl, 2) + pbtop(jl, 3) + pbtop(jl, 4) + &
-      pbtop(jl, 5) + pbtop(jl, 6)
-    zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
-    pfluc(jl, 2, jk) = zfd(jl)
-  END DO
-
-  ! *         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
-  ! ---------------------------------------
-
-
-
-  ! *         2.4.1   INITIALIZATION
-  ! --------------
-
-
-  jlim = kflev
-
-  IF (.NOT. levoigt) THEN
-    DO jk = kflev, 1, -1
-      IF (ppmb(1,jk)<10.0) THEN
-        jlim = jk
-      END IF
-    END DO
-  END IF
-  klim = jlim
-
-  IF (.NOT. levoigt) THEN
-    DO ja = 1, ktraer
-      DO jl = 1, kdlon
-        ztt1(jl, ja) = 1.0
-      END DO
-    END DO
-
-    ! *         2.4.2   LOOP OVER LAYERS ABOVE 10 HPA
-    ! -----------------------------
-
-
-    DO jstra = kflev, jlim, -1
-      jstru = (jstra-1)*ng1p1 + 1
-
-      DO ja = 1, kuaer
-        DO jl = 1, kdlon
-          zuu(jl, ja) = pabcu(jl, ja, jstru)
-        END DO
-      END DO
-
-
-      CALL lwtt_lmdar4(pga(1,1,1,jstra), pgb(1,1,1,jstra), zuu, ztt)
-
-      DO jl = 1, kdlon
-        zctstr = (pb(jl,1,jstra)+pb(jl,1,jstra+1))* &
-          (ztt1(jl,1)*ztt1(jl,10)-ztt(jl,1)*ztt(jl,10)) + &
-          (pb(jl,2,jstra)+pb(jl,2,jstra+1))*(ztt1(jl,2)*ztt1(jl,7)*ztt1(jl,11 &
-          )-ztt(jl,2)*ztt(jl,7)*ztt(jl,11)) + (pb(jl,3,jstra)+pb(jl,3,jstra+1 &
-          ))*(ztt1(jl,4)*ztt1(jl,8)*ztt1(jl,12)-ztt(jl,4)*ztt(jl,8)*ztt(jl,12 &
-          )) + (pb(jl,4,jstra)+pb(jl,4,jstra+1))*(ztt1(jl,5)*ztt1(jl,9)*ztt1( &
-          jl,13)-ztt(jl,5)*ztt(jl,9)*ztt(jl,13)) + (pb(jl,5,jstra)+pb(jl,5, &
-          jstra+1))*(ztt1(jl,3)*ztt1(jl,14)-ztt(jl,3)*ztt(jl,14)) + &
-          (pb(jl,6,jstra)+pb(jl,6,jstra+1))*(ztt1(jl,6)*ztt1(jl,15)-ztt(jl,6) &
-          *ztt(jl,15))
-        pcts(jl, jstra) = zctstr*0.5
-      END DO
-      DO ja = 1, ktraer
-        DO jl = 1, kdlon
-          ztt1(jl, ja) = ztt(jl, ja)
-        END DO
-      END DO
-    END DO
-  END IF
-  ! Mise a zero de securite pour PCTS en cas de LEVOIGT
-  IF (levoigt) THEN
-    DO jstra = 1, kflev
-      DO jl = 1, kdlon
-        pcts(jl, jstra) = 0.
-      END DO
-    END DO
-  END IF
-
-  ! *         2.5     EXCHANGE WITH LOWER LIMIT
-  ! -------------------------
-
-
-  DO jl = 1, kdlon
-    zbgnd(jl) = pbsui(jl)*pemis(jl) - (1.-pemis(jl))*pfluc(jl, 2, 1) - &
-      pbint(jl, 1)
-  END DO
-
-  jk = 1
-  in = (jk-1)*ng1p1 + 1
-
-  DO jl = 1, kdlon
-    zcnsol(jl) = pbsur(jl, 1) + pbsur(jl, 2) + pbsur(jl, 3) + pbsur(jl, 4) + &
-      pbsur(jl, 5) + pbsur(jl, 6)
-    zcnsol(jl) = zcnsol(jl)*zbgnd(jl)/pbsui(jl)
-    zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
-    pfluc(jl, 1, jk) = zfu(jl)
-  END DO
-
-  DO jk = 2, kflev + 1
-    in = (jk-1)*ng1p1 + 1
-
-
-    DO ja = 1, kuaer
-      DO jl = 1, kdlon
-        zuu(jl, ja) = pabcu(jl, ja, 1) - pabcu(jl, ja, in)
-      END DO
-    END DO
-
-
-    CALL lwtt_lmdar4(pgasur(1,1,1), pgbsur(1,1,1), zuu, ztt)
-
-    DO jl = 1, kdlon
-      zcnsol(jl) = pbsur(jl, 1)*ztt(jl, 1)*ztt(jl, 10) + &
-        pbsur(jl, 2)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
-        pbsur(jl, 3)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
-        pbsur(jl, 4)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
-        pbsur(jl, 5)*ztt(jl, 3)*ztt(jl, 14) + pbsur(jl, 6)*ztt(jl, 6)*ztt(jl, &
-        15)
-      zcnsol(jl) = zcnsol(jl)*zbgnd(jl)/pbsui(jl)
-      zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
-      pfluc(jl, 1, jk) = zfu(jl)
-    END DO
-
-
-  END DO
-
-  ! *         2.7     CLEAR-SKY FLUXES
-  ! ----------------
-
-
-  IF (.NOT. levoigt) THEN
-    DO jl = 1, kdlon
-      zfn10(jl) = pfluc(jl, 1, jlim) + pfluc(jl, 2, jlim)
-    END DO
-    DO jk = jlim + 1, kflev + 1
-      DO jl = 1, kdlon
-        zfn10(jl) = zfn10(jl) + pcts(jl, jk-1)
-        pfluc(jl, 1, jk) = zfn10(jl)
-        pfluc(jl, 2, jk) = 0.
-      END DO
-    END DO
-  END IF
-
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE lwvb_lmdar4
-SUBROUTINE lwvd_lmdar4(kuaer, ktraer, pabcu, pdbdt, pga, pgb, pcntrb, pdisd, &
-    pdisu)
-  USE dimphy
-  IMPLICIT NONE
-  include "raddimlw.h"
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS
-
-  ! METHOD.
-  ! -------
-
-  ! 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
-  ! CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! -----------------------------------------------------------------------
-  ! * ARGUMENTS:
-
-  INTEGER kuaer, ktraer
-
-  REAL (KIND=8) pabcu(kdlon, nua, 3*kflev+1) ! ABSORBER AMOUNTS
-  REAL (KIND=8) pdbdt(kdlon, ninter, kflev) ! LAYER PLANCK FUNCTION GRADIENT
-  REAL (KIND=8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-
-  REAL (KIND=8) pcntrb(kdlon, kflev+1, kflev+1) ! ENERGY EXCHANGE MATRIX
-  REAL (KIND=8) pdisd(kdlon, kflev+1) !  CONTRIBUTION BY DISTANT LAYERS
-  REAL (KIND=8) pdisu(kdlon, kflev+1) !  CONTRIBUTION BY DISTANT LAYERS
-
-  ! * LOCAL VARIABLES:
-
-  REAL (KIND=8) zglayd(kdlon)
-  REAL (KIND=8) zglayu(kdlon)
-  REAL (KIND=8) ztt(kdlon, ntra)
-  REAL (KIND=8) ztt1(kdlon, ntra)
-  REAL (KIND=8) ztt2(kdlon, ntra)
-
-  INTEGER jl, jk, ja, ikp1, ikn, ikd1, jkj, ikd2
-  INTEGER ikjp1, ikm1, ikj, jlk, iku1, ijkl, iku2
-  INTEGER ind1, ind2, ind3, ind4, itt
-  REAL (KIND=8) zww, zdzxdg, zdzxmg
-
-  ! *         1.    INITIALIZATION
-  ! --------------
-
-
-  ! *         1.1     INITIALIZE LAYER CONTRIBUTIONS
-  ! ------------------------------
-
-
-  DO jk = 1, kflev + 1
-    DO jl = 1, kdlon
-      pdisd(jl, jk) = 0.
-      pdisu(jl, jk) = 0.
-    END DO
-  END DO
-
-  ! *         1.2     INITIALIZE TRANSMISSION FUNCTIONS
-  ! ---------------------------------
-
-
-
-  DO ja = 1, ntra
-    DO jl = 1, kdlon
-      ztt(jl, ja) = 1.0
-      ztt1(jl, ja) = 1.0
-      ztt2(jl, ja) = 1.0
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.      VERTICAL INTEGRATION
-  ! --------------------
-
-
-  ind1 = 0
-  ind3 = 0
-  ind4 = 1
-  ind2 = 1
-
-  ! *         2.2     CONTRIBUTION FROM DISTANT LAYERS
-  ! ---------------------------------
-
-
-
-  ! *         2.2.1   DISTANT AND ABOVE LAYERS
-  ! ------------------------
-
-
-
-
-  ! *         2.2.2   FIRST UPPER LEVEL
-  ! -----------------
-
-
-  DO jk = 1, kflev - 1
-    ikp1 = jk + 1
-    ikn = (jk-1)*ng1p1 + 1
-    ikd1 = jk*ng1p1 + 1
-
-    CALL lwttm_lmdar4(pga(1,1,1,jk), pgb(1,1,1,jk), pabcu(1,1,ikn), &
-      pabcu(1,1,ikd1), ztt1)
-
-    ! *         2.2.3   HIGHER UP
-    ! ---------
-
-
-    itt = 1
-    DO jkj = ikp1, kflev
-      IF (itt==1) THEN
-        itt = 2
-      ELSE
-        itt = 1
-      END IF
-      ikjp1 = jkj + 1
-      ikd2 = jkj*ng1p1 + 1
-
-      IF (itt==1) THEN
-        CALL lwttm_lmdar4(pga(1,1,1,jkj), pgb(1,1,1,jkj), pabcu(1,1,ikn), &
-          pabcu(1,1,ikd2), ztt1)
-      ELSE
-        CALL lwttm_lmdar4(pga(1,1,1,jkj), pgb(1,1,1,jkj), pabcu(1,1,ikn), &
-          pabcu(1,1,ikd2), ztt2)
-      END IF
-
-      DO ja = 1, ktraer
-        DO jl = 1, kdlon
-          ztt(jl, ja) = (ztt1(jl,ja)+ztt2(jl,ja))*0.5
-        END DO
-      END DO
-
-      DO jl = 1, kdlon
-        zww = pdbdt(jl, 1, jkj)*ztt(jl, 1)*ztt(jl, 10) + &
-          pdbdt(jl, 2, jkj)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
-          pdbdt(jl, 3, jkj)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
-          pdbdt(jl, 4, jkj)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
-          pdbdt(jl, 5, jkj)*ztt(jl, 3)*ztt(jl, 14) + &
-          pdbdt(jl, 6, jkj)*ztt(jl, 6)*ztt(jl, 15)
-        zglayd(jl) = zww
-        zdzxdg = zglayd(jl)
-        pdisd(jl, jk) = pdisd(jl, jk) + zdzxdg
-        pcntrb(jl, jk, ikjp1) = zdzxdg
-      END DO
-
-
-    END DO
-  END DO
-
-  ! *         2.2.4   DISTANT AND BELOW LAYERS
-  ! ------------------------
-
-
-
-
-  ! *         2.2.5   FIRST LOWER LEVEL
-  ! -----------------
-
-
-  DO jk = 3, kflev + 1
-    ikn = (jk-1)*ng1p1 + 1
-    ikm1 = jk - 1
-    ikj = jk - 2
-    iku1 = ikj*ng1p1 + 1
-
-
-    CALL lwttm_lmdar4(pga(1,1,1,ikj), pgb(1,1,1,ikj), pabcu(1,1,iku1), &
-      pabcu(1,1,ikn), ztt1)
-
-    ! *         2.2.6   DOWN BELOW
-    ! ----------
-
-
-    itt = 1
-    DO jlk = 1, ikj
-      IF (itt==1) THEN
-        itt = 2
-      ELSE
-        itt = 1
-      END IF
-      ijkl = ikm1 - jlk
-      iku2 = (ijkl-1)*ng1p1 + 1
-
-
-      IF (itt==1) THEN
-        CALL lwttm_lmdar4(pga(1,1,1,ijkl), pgb(1,1,1,ijkl), pabcu(1,1,iku2), &
-          pabcu(1,1,ikn), ztt1)
-      ELSE
-        CALL lwttm_lmdar4(pga(1,1,1,ijkl), pgb(1,1,1,ijkl), pabcu(1,1,iku2), &
-          pabcu(1,1,ikn), ztt2)
-      END IF
-
-      DO ja = 1, ktraer
-        DO jl = 1, kdlon
-          ztt(jl, ja) = (ztt1(jl,ja)+ztt2(jl,ja))*0.5
-        END DO
-      END DO
-
-      DO jl = 1, kdlon
-        zww = pdbdt(jl, 1, ijkl)*ztt(jl, 1)*ztt(jl, 10) + &
-          pdbdt(jl, 2, ijkl)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
-          pdbdt(jl, 3, ijkl)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
-          pdbdt(jl, 4, ijkl)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
-          pdbdt(jl, 5, ijkl)*ztt(jl, 3)*ztt(jl, 14) + &
-          pdbdt(jl, 6, ijkl)*ztt(jl, 6)*ztt(jl, 15)
-        zglayu(jl) = zww
-        zdzxmg = zglayu(jl)
-        pdisu(jl, jk) = pdisu(jl, jk) + zdzxmg
-        pcntrb(jl, jk, ijkl) = zdzxmg
-      END DO
-
-
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE lwvd_lmdar4
-SUBROUTINE lwvn_lmdar4(kuaer, ktraer, pabcu, pdbsl, pga, pgb, padjd, padju, &
-    pcntrb, pdbdt)
-  USE dimphy
-  USE radiation_ar4_param, ONLY: wg1
-  IMPLICIT NONE
-  include "raddimlw.h"
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
-  ! TO GIVE LONGWAVE FLUXES OR RADIANCES
-
-  ! METHOD.
-  ! -------
-
-  ! 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
-  ! CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 89-07-14
-  ! -----------------------------------------------------------------------
-
-  ! * ARGUMENTS:
-
-  INTEGER kuaer, ktraer
-
-  REAL (KIND=8) pabcu(kdlon, nua, 3*kflev+1) ! ABSORBER AMOUNTS
-  REAL (KIND=8) pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
-  REAL (KIND=8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
-
-  REAL (KIND=8) padjd(kdlon, kflev+1) ! CONTRIBUTION OF ADJACENT LAYERS
-  REAL (KIND=8) padju(kdlon, kflev+1) ! CONTRIBUTION OF ADJACENT LAYERS
-  REAL (KIND=8) pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
-  REAL (KIND=8) pdbdt(kdlon, ninter, kflev) !  LAYER PLANCK FUNCTION GRADIENT
-
-  ! * LOCAL ARRAYS:
-
-  REAL (KIND=8) zglayd(kdlon)
-  REAL (KIND=8) zglayu(kdlon)
-  REAL (KIND=8) ztt(kdlon, ntra)
-  REAL (KIND=8) ztt1(kdlon, ntra)
-  REAL (KIND=8) ztt2(kdlon, ntra)
-  REAL (KIND=8) zuu(kdlon, nua)
-
-  INTEGER jk, jl, ja, im12, ind, inu, ixu, jg
-  INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu
-  REAL (KIND=8) zwtr
-
-  ! -----------------------------------------------------------------------
-
-  ! *         1.    INITIALIZATION
-  ! --------------
-
-
-  ! *         1.1     INITIALIZE LAYER CONTRIBUTIONS
-  ! ------------------------------
-
-
-  DO jk = 1, kflev + 1
-    DO jl = 1, kdlon
-      padjd(jl, jk) = 0.
-      padju(jl, jk) = 0.
-    END DO
-  END DO
-
-  ! *         1.2     INITIALIZE TRANSMISSION FUNCTIONS
-  ! ---------------------------------
-
-
-  DO ja = 1, ntra
-    DO jl = 1, kdlon
-      ztt(jl, ja) = 1.0
-      ztt1(jl, ja) = 1.0
-      ztt2(jl, ja) = 1.0
-    END DO
-  END DO
-
-  DO ja = 1, nua
-    DO jl = 1, kdlon
-      zuu(jl, ja) = 0.
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.      VERTICAL INTEGRATION
-  ! --------------------
-
-
-
-  ! *         2.1     CONTRIBUTION FROM ADJACENT LAYERS
-  ! ---------------------------------
-
-
-  DO jk = 1, kflev
-    ! *         2.1.1   DOWNWARD LAYERS
-    ! ---------------
-
-
-    im12 = 2*(jk-1)
-    ind = (jk-1)*ng1p1 + 1
-    ixd = ind
-    inu = jk*ng1p1 + 1
-    ixu = ind
-
-    DO jl = 1, kdlon
-      zglayd(jl) = 0.
-      zglayu(jl) = 0.
-    END DO
-
-    DO jg = 1, ng1
-      ibs = im12 + jg
-      idd = ixd + jg
-      DO ja = 1, kuaer
-        DO jl = 1, kdlon
-          zuu(jl, ja) = pabcu(jl, ja, ind) - pabcu(jl, ja, idd)
-        END DO
-      END DO
-
-
-      CALL lwtt_lmdar4(pga(1,1,1,jk), pgb(1,1,1,jk), zuu, ztt)
-
-      DO jl = 1, kdlon
-        zwtr = pdbsl(jl, 1, ibs)*ztt(jl, 1)*ztt(jl, 10) + &
-          pdbsl(jl, 2, ibs)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
-          pdbsl(jl, 3, ibs)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
-          pdbsl(jl, 4, ibs)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
-          pdbsl(jl, 5, ibs)*ztt(jl, 3)*ztt(jl, 14) + &
-          pdbsl(jl, 6, ibs)*ztt(jl, 6)*ztt(jl, 15)
-        zglayd(jl) = zglayd(jl) + zwtr*wg1(jg)
-      END DO
-
-      ! *         2.1.2   DOWNWARD LAYERS
-      ! ---------------
-
-
-      imu = ixu + jg
-      DO ja = 1, kuaer
-        DO jl = 1, kdlon
-          zuu(jl, ja) = pabcu(jl, ja, imu) - pabcu(jl, ja, inu)
-        END DO
-      END DO
-
-
-      CALL lwtt_lmdar4(pga(1,1,1,jk), pgb(1,1,1,jk), zuu, ztt)
-
-      DO jl = 1, kdlon
-        zwtr = pdbsl(jl, 1, ibs)*ztt(jl, 1)*ztt(jl, 10) + &
-          pdbsl(jl, 2, ibs)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
-          pdbsl(jl, 3, ibs)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
-          pdbsl(jl, 4, ibs)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
-          pdbsl(jl, 5, ibs)*ztt(jl, 3)*ztt(jl, 14) + &
-          pdbsl(jl, 6, ibs)*ztt(jl, 6)*ztt(jl, 15)
-        zglayu(jl) = zglayu(jl) + zwtr*wg1(jg)
-      END DO
-
-    END DO
-
-    DO jl = 1, kdlon
-      padjd(jl, jk) = zglayd(jl)
-      pcntrb(jl, jk, jk+1) = zglayd(jl)
-      padju(jl, jk+1) = zglayu(jl)
-      pcntrb(jl, jk+1, jk) = zglayu(jl)
-      pcntrb(jl, jk, jk) = 0.0
-    END DO
-
-  END DO
-
-  DO jk = 1, kflev
-    jk2 = 2*jk
-    jk1 = jk2 - 1
-    DO jnu = 1, ninter
-      DO jl = 1, kdlon
-        pdbdt(jl, jnu, jk) = pdbsl(jl, jnu, jk1) + pdbsl(jl, jnu, jk2)
-      END DO
-    END DO
-  END DO
-
-  RETURN
-
-END SUBROUTINE lwvn_lmdar4
-SUBROUTINE lwtt_lmdar4(pga, pgb, puu, ptt)
-  USE dimphy
-  IMPLICIT NONE
-  include "raddimlw.h"
-
-  ! -----------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-  ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
-  ! INTERVALS.
-
-  ! METHOD.
-  ! -------
-
-  ! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
-  ! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
-  ! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
-  ! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
-  ! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 88-12-15
-
-  ! -----------------------------------------------------------------------
-  REAL (KIND=8) o1h, o2h
-  PARAMETER (o1h=2230.)
-  PARAMETER (o2h=100.)
-  REAL (KIND=8) rpialf0
-  PARAMETER (rpialf0=2.0)
-
-  ! * ARGUMENTS:
-
-  REAL (KIND=8) puu(kdlon, nua)
-  REAL (KIND=8) ptt(kdlon, ntra)
-  REAL (KIND=8) pga(kdlon, 8, 2)
-  REAL (KIND=8) pgb(kdlon, 8, 2)
-
-  ! * LOCAL VARIABLES:
-
-  REAL (KIND=8) zz, zxd, zxn
-  REAL (KIND=8) zpu, zpu10, zpu11, zpu12, zpu13
-  REAL (KIND=8) zeu, zeu10, zeu11, zeu12, zeu13
-  REAL (KIND=8) zx, zy, zsq1, zsq2, zvxy, zuxy
-  REAL (KIND=8) zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
-  REAL (KIND=8) zsqn21, zodn21, zsqh42, zodh42
-  REAL (KIND=8) zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
-  REAL (KIND=8) zuu11, zuu12, za11, za12
-  INTEGER jl, ja
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
-  ! -----------------------------------------------
-
-
-
-  ! cdir collapse
-  DO ja = 1, 8
-    DO jl = 1, kdlon
-      zz = sqrt(puu(jl,ja))
-      ! ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
-      ! ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
-      ! PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
-      zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz)
-      zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2))
-      ptt(jl, ja) = zxn/zxd
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
-  ! ---------------------------------------------------
-
-
-  DO jl = 1, kdlon
-    ptt(jl, 9) = ptt(jl, 8)
-
-    ! -  CONTINUUM ABSORPTION: E- AND P-TYPE
-
-    zpu = 0.002*puu(jl, 10)
-    zpu10 = 112.*zpu
-    zpu11 = 6.25*zpu
-    zpu12 = 5.00*zpu
-    zpu13 = 80.0*zpu
-    zeu = puu(jl, 11)
-    zeu10 = 12.*zeu
-    zeu11 = 6.25*zeu
-    zeu12 = 5.00*zeu
-    zeu13 = 80.0*zeu
-
-    ! -  OZONE ABSORPTION
-
-    zx = puu(jl, 12)
-    zy = puu(jl, 13)
-    zuxy = 4.*zx*zx/(rpialf0*zy)
-    zsq1 = sqrt(1.+o1h*zuxy) - 1.
-    zsq2 = sqrt(1.+o2h*zuxy) - 1.
-    zvxy = rpialf0*zy/(2.*zx)
-    zaercn = puu(jl, 17) + zeu12 + zpu12
-    zto1 = exp(-zvxy*zsq1-zaercn)
-    zto2 = exp(-zvxy*zsq2-zaercn)
-
-    ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
-
-    ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    ! NEXOTIC=1
-    ! IF (NEXOTIC.EQ.1) THEN
-    zxch4 = puu(jl, 19)
-    zych4 = puu(jl, 20)
-    zuxy = 4.*zxch4*zxch4/(0.103*zych4)
-    zsqh41 = sqrt(1.+33.7*zuxy) - 1.
-    zvxy = 0.103*zych4/(2.*zxch4)
-    zodh41 = zvxy*zsqh41
-
-    ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    zxn2o = puu(jl, 21)
-    zyn2o = puu(jl, 22)
-    zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o)
-    zsqn21 = sqrt(1.+21.3*zuxy) - 1.
-    zvxy = 0.416*zyn2o/(2.*zxn2o)
-    zodn21 = zvxy*zsqn21
-
-    ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
-
-    zuxy = 4.*zxch4*zxch4/(0.113*zych4)
-    zsqh42 = sqrt(1.+400.*zuxy) - 1.
-    zvxy = 0.113*zych4/(2.*zxch4)
-    zodh42 = zvxy*zsqh42
-
-    ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
-
-    zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o)
-    zsqn22 = sqrt(1.+2000.*zuxy) - 1.
-    zvxy = 0.197*zyn2o/(2.*zxn2o)
-    zodn22 = zvxy*zsqn22
-
-    ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    za11 = 2.*puu(jl, 23)*4.404E+05
-    zttf11 = 1. - za11*0.003225
-
-    ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    za12 = 2.*puu(jl, 24)*6.7435E+05
-    zttf12 = 1. - za12*0.003225
-
-    zuu11 = -puu(jl, 15) - zeu10 - zpu10
-    zuu12 = -puu(jl, 16) - zeu11 - zpu11 - zodh41 - zodn21
-    ptt(jl, 10) = exp(-puu(jl,14))
-    ptt(jl, 11) = exp(zuu11)
-    ptt(jl, 12) = exp(zuu12)*zttf11*zttf12
-    ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2
-    ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
-    ptt(jl, 15) = exp(-puu(jl,14)-zodh42-zodn22)
-  END DO
-
-  RETURN
-END SUBROUTINE lwtt_lmdar4
-SUBROUTINE lwttm_lmdar4(pga, pgb, puu1, puu2, ptt)
-  USE dimphy
-  IMPLICIT NONE
-  include "raddimlw.h"
-
-  ! ------------------------------------------------------------------
-  ! PURPOSE.
-  ! --------
-  ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-  ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
-  ! INTERVALS.
-
-  ! METHOD.
-  ! -------
-
-  ! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
-  ! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
-  ! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
-  ! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
-  ! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
-
-  ! REFERENCE.
-  ! ----------
-
-  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-  ! AUTHOR.
-  ! -------
-  ! JEAN-JACQUES MORCRETTE  *ECMWF*
-
-  ! MODIFICATIONS.
-  ! --------------
-  ! ORIGINAL : 88-12-15
-
-  ! -----------------------------------------------------------------------
-  REAL (KIND=8) o1h, o2h
-  PARAMETER (o1h=2230.)
-  PARAMETER (o2h=100.)
-  REAL (KIND=8) rpialf0
-  PARAMETER (rpialf0=2.0)
-
-  ! * ARGUMENTS:
-
-  REAL (KIND=8) pga(kdlon, 8, 2) ! PADE APPROXIMANTS
-  REAL (KIND=8) pgb(kdlon, 8, 2) ! PADE APPROXIMANTS
-  REAL (KIND=8) puu1(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
-  REAL (KIND=8) puu2(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
-  REAL (KIND=8) ptt(kdlon, ntra) ! TRANSMISSION FUNCTIONS
-
-  ! * LOCAL VARIABLES:
-
-  INTEGER ja, jl
-  REAL (KIND=8) zz, zxd, zxn
-  REAL (KIND=8) zpu, zpu10, zpu11, zpu12, zpu13
-  REAL (KIND=8) zeu, zeu10, zeu11, zeu12, zeu13
-  REAL (KIND=8) zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2
-  REAL (KIND=8) zxch4, zych4, zsqh41, zodh41
-  REAL (KIND=8) zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
-  REAL (KIND=8) zsqn22, zodn22, za11, zttf11, za12, zttf12
-  REAL (KIND=8) zuu11, zuu12
-
-  ! ------------------------------------------------------------------
-
-  ! *         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
-  ! -----------------------------------------------
-
-
-
-
-  ! CDIR ON_ADB(PUU1)
-  ! CDIR ON_ADB(PUU2)
-  ! CDIR COLLAPSE
-  DO ja = 1, 8
-    DO jl = 1, kdlon
-      zz = sqrt(puu1(jl,ja)-puu2(jl,ja))
-      zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz)
-      zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2))
-      ptt(jl, ja) = zxn/zxd
-    END DO
-  END DO
-
-  ! ------------------------------------------------------------------
-
-  ! *         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
-  ! ---------------------------------------------------
-
-
-  DO jl = 1, kdlon
-    ptt(jl, 9) = ptt(jl, 8)
-
-    ! -  CONTINUUM ABSORPTION: E- AND P-TYPE
-
-    zpu = 0.002*(puu1(jl,10)-puu2(jl,10))
-    zpu10 = 112.*zpu
-    zpu11 = 6.25*zpu
-    zpu12 = 5.00*zpu
-    zpu13 = 80.0*zpu
-    zeu = (puu1(jl,11)-puu2(jl,11))
-    zeu10 = 12.*zeu
-    zeu11 = 6.25*zeu
-    zeu12 = 5.00*zeu
-    zeu13 = 80.0*zeu
-
-    ! -  OZONE ABSORPTION
-
-    zx = (puu1(jl,12)-puu2(jl,12))
-    zy = (puu1(jl,13)-puu2(jl,13))
-    zuxy = 4.*zx*zx/(rpialf0*zy)
-    zsq1 = sqrt(1.+o1h*zuxy) - 1.
-    zsq2 = sqrt(1.+o2h*zuxy) - 1.
-    zvxy = rpialf0*zy/(2.*zx)
-    zaercn = (puu1(jl,17)-puu2(jl,17)) + zeu12 + zpu12
-    zto1 = exp(-zvxy*zsq1-zaercn)
-    zto2 = exp(-zvxy*zsq2-zaercn)
-
-    ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
-
-    ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    zxch4 = (puu1(jl,19)-puu2(jl,19))
-    zych4 = (puu1(jl,20)-puu2(jl,20))
-    zuxy = 4.*zxch4*zxch4/(0.103*zych4)
-    zsqh41 = sqrt(1.+33.7*zuxy) - 1.
-    zvxy = 0.103*zych4/(2.*zxch4)
-    zodh41 = zvxy*zsqh41
-
-    ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    zxn2o = (puu1(jl,21)-puu2(jl,21))
-    zyn2o = (puu1(jl,22)-puu2(jl,22))
-    zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o)
-    zsqn21 = sqrt(1.+21.3*zuxy) - 1.
-    zvxy = 0.416*zyn2o/(2.*zxn2o)
-    zodn21 = zvxy*zsqn21
-
-    ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
-
-    zuxy = 4.*zxch4*zxch4/(0.113*zych4)
-    zsqh42 = sqrt(1.+400.*zuxy) - 1.
-    zvxy = 0.113*zych4/(2.*zxch4)
-    zodh42 = zvxy*zsqh42
-
-    ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
-
-    zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o)
-    zsqn22 = sqrt(1.+2000.*zuxy) - 1.
-    zvxy = 0.197*zyn2o/(2.*zxn2o)
-    zodn22 = zvxy*zsqn22
-
-    ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    za11 = (puu1(jl,23)-puu2(jl,23))*4.404E+05
-    zttf11 = 1. - za11*0.003225
-
-    ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
-
-    za12 = (puu1(jl,24)-puu2(jl,24))*6.7435E+05
-    zttf12 = 1. - za12*0.003225
-
-    zuu11 = -(puu1(jl,15)-puu2(jl,15)) - zeu10 - zpu10
-    zuu12 = -(puu1(jl,16)-puu2(jl,16)) - zeu11 - zpu11 - zodh41 - zodn21
-    ptt(jl, 10) = exp(-(puu1(jl,14)-puu2(jl,14)))
-    ptt(jl, 11) = exp(zuu11)
-    ptt(jl, 12) = exp(zuu12)*zttf11*zttf12
-    ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2
-    ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
-    ptt(jl, 15) = exp(-(puu1(jl,14)-puu2(jl,14))-zodh42-zodn22)
-  END DO
-
-  RETURN
-END SUBROUTINE lwttm_lmdar4
+link ../phylmd/radiation_AR4.F90
Index: LMDZ6/trunk/libf/phylmdiso/radiation_ar4_param.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/radiation_ar4_param.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/radiation_ar4_param.F90	(revision 3940)
@@ -1,243 +1,1 @@
-MODULE radiation_ar4_param
-
- IMPLICIT NONE
-
- REAL(KIND=8), parameter :: ZPDH2O = 0.8
- REAL(KIND=8), parameter :: ZPDUMG = 0.75
- REAL(KIND=8), parameter :: ZPRH2O = 30000.0
- REAL(KIND=8), parameter :: ZPRUMG = 30000.0
- REAL(KIND=8), parameter :: RTDH2O = 0.40
- REAL(KIND=8), parameter :: RTDUMG = 0.375
- REAL(KIND=8), parameter :: RTH2O = 240.0
- REAL(KIND=8), parameter :: RTUMG = 240.0
-
- REAL(KIND=8), dimension(2), parameter :: WG1 = (/1.0, 1.0/)
- REAL(KIND=8), dimension(11), parameter :: TINTP = (/ 187.5, 200., 212.5, 225., 237.5, 250., 262.5, 275., 287.5, 300., 312.5 /)
-
- real(kind=8), dimension(11,16,3), parameter :: GA = reshape ( (/ &
- 0.63499072E-02, 0.65566348E-02, 0.67849730E-02, 0.70481947E-02, 0.73585943E-02, 0.77242818E-02, 0.81472693E-02, 0.86227527E-02,&
- 0.91396814E-02, 0.96825438E-02, 0.10233955E-01, 0.77266491E-02, 0.81323287E-02, 0.86507620E-02, 0.92776391E-02, 0.99806312E-02,&
- 0.10709803E-01, 0.11414739E-01, 0.12058772E-01, 0.12623992E-01, 0.13108146E-01, 0.13518390E-01, 0.11644593E+01, 0.11747203E+01,&
- 0.11837872E+01, 0.11918561E+01, 0.11990757E+01, 0.12055643E+01, 0.12114186E+01, 0.12167192E+01, 0.12215344E+01, 0.12259226E+01,&
- 0.12299344E+01, 0.12006968E+01, 0.12108196E+01, 0.12196717E+01, 0.12274493E+01, 0.12343189E+01, 0.12404147E+01, 0.12458431E+01,&
- 0.12506907E+01, 0.12550299E+01, 0.12589256E+01, 0.12624402E+01, 0.15750172E+00, 0.16174076E+00, 0.16548628E+00, 0.16881124E+00,&
- 0.17177839E+00, 0.17443933E+00, 0.17683622E+00, 0.17900375E+00, 0.18097099E+00, 0.18276283E+00, 0.18440117E+00, 0.17770551E+00,&
- 0.18176757E+00, 0.18527967E+00, 0.18833348E+00, 0.19100108E+00, 0.19334122E+00, 0.19540288E+00, 0.19722732E+00, 0.19884918E+00,&
- 0.20029696E+00, 0.20159300E+00, 0.10192131E+02, 0.97258602E+01, 0.92992890E+01, 0.89154021E+01, 0.85730084E+01, 0.82685838E+01,&
- 0.79978921E+01, 0.77568055E+01, 0.75416266E+01, 0.73491694E+01, 0.71767400E+01, 0.92439050E+01, 0.87567422E+01, 0.83270144E+01,&
- 0.79528337E+01, 0.76286839E+01, 0.73477879E+01, 0.71035818E+01, 0.68903312E+01, 0.67032875E+01, 0.65386461E+01, 0.63934377E+01,&
- 0.24870635E+02, 0.24725591E+02, 0.24600320E+02, 0.24487300E+02, 0.24384935E+02, 0.24292341E+02, 0.24208572E+02, 0.24132642E+02,&
- 0.24063614E+02, 0.24000649E+02, 0.23943021E+02, 0.24586283E+02, 0.24441465E+02, 0.24311657E+02, 0.24196167E+02, 0.24093406E+02,&
- 0.24001597E+02, 0.23919098E+02, 0.23844511E+02, 0.23776708E+02, 0.23714816E+02, 0.23658197E+02, 0.11990218E+02, 0.10904073E+02,&
- 0.89126838E+01, 0.85622405E+01, 0.94892164E+01, 0.13580937E+02,-0.32050918E+03,-0.37133165E+01, 0.18890836E+00, 0.14209226E+01,&
- 0.19817679E+01, 0.79709806E+01, 0.75400737E+01, 0.81804377E+01, 0.10564339E+02, 0.46896789E+02,-0.30926524E+01, 0.85742941E+00,&
- 0.19164038E+01, 0.23513199E+01, 0.25566644E+01, 0.26555181E+01, 0.87668459E-01, 0.83754276E-01, 0.80460283E-01, 0.77659686E-01,&
- 0.75257056E-01, 0.73179175E-01, 0.71369063E-01, 0.69781812E-01, 0.68381606E-01, 0.67139539E-01, 0.66032012E-01, 0.74878820E-01,&
- 0.71650966E-01, 0.68979615E-01, 0.66745345E-01, 0.64857571E-01, 0.63248495E-01, 0.61866970E-01, 0.60673632E-01, 0.59637277E-01,&
- 0.58732178E-01, 0.57936092E-01, 0.13230067E+02, 0.13213564E+02, 0.13209140E+02, 0.13213894E+02, 0.13225963E+02, 0.13243806E+02,&
- 0.13266104E+02, 0.13291782E+02, 0.13319961E+02, 0.13349927E+02, 0.13381108E+02, 0.13183816E+02, 0.13189991E+02, 0.13209485E+02,&
- 0.13238789E+02, 0.13275017E+02, 0.13316096E+02, 0.13360555E+02, 0.13407324E+02, 0.13455544E+02, 0.13504450E+02, 0.13553282E+02,&
--0.99506586E-03,-0.10184169E-02,-0.10404730E-02,-0.10621792E-02,-0.10847662E-02,-0.11094726E-02,-0.11372949E-02,-0.11687683E-02,&
--0.12038314E-02,-0.12418367E-02,-0.12817135E-02,-0.11661515E-02,-0.11886130E-02,-0.12139929E-02,-0.12445811E-02,-0.12807672E-02,&
--0.13208251E-02,-0.13619034E-02,-0.14014165E-02,-0.14378639E-02,-0.14708488E-02,-0.15006791E-02, 0.41243390E+00, 0.43407282E+00,&
- 0.45331413E+00, 0.47048604E+00, 0.48586286E+00, 0.49968044E+00, 0.51214132E+00, 0.52341830E+00, 0.53365803E+00, 0.54298448E+00,&
- 0.55150227E+00, 0.48318936E+00, 0.50501827E+00, 0.52409502E+00, 0.54085277E+00, 0.55565422E+00, 0.56878618E+00, 0.58047395E+00,&
- 0.59089894E+00, 0.60021475E+00, 0.60856112E+00, 0.61607594E+00,-0.22159303E-01,-0.22748917E-01,-0.23269898E-01,-0.23732392E-01,&
--0.24145123E-01,-0.24515269E-01,-0.24848690E-01,-0.25150210E-01,-0.25423873E-01,-0.25673139E-01,-0.25901055E-01,-0.24972399E-01,&
--0.25537247E-01,-0.26025624E-01,-0.26450280E-01,-0.26821236E-01,-0.27146657E-01,-0.27433354E-01,-0.27687065E-01,-0.27912608E-01,&
--0.28113944E-01,-0.28294180E-01, 0.80737799E+01, 0.79171158E+01, 0.77609605E+01, 0.76087371E+01, 0.74627112E+01, 0.73239981E+01,&
- 0.71929934E+01, 0.70697065E+01, 0.69539626E+01, 0.68455144E+01, 0.67441020E+01, 0.77425778E+01, 0.75443460E+01, 0.73526151E+01,&
- 0.71711188E+01, 0.70015571E+01, 0.68442532E+01, 0.66987996E+01, 0.65644820E+01, 0.64405267E+01, 0.63262376E+01, 0.62210701E+01,&
- 0.10542131E+02, 0.10515895E+02, 0.10492949E+02, 0.10472049E+02, 0.10452961E+02, 0.10435562E+02, 0.10419710E+02, 0.10405247E+02,&
- 0.10392022E+02, 0.10379892E+02, 0.10368736E+02, 0.10490353E+02, 0.10463512E+02, 0.10439183E+02, 0.10417324E+02, 0.10397704E+02,&
- 0.10380038E+02, 0.10364052E+02, 0.10349509E+02, 0.10336215E+02, 0.10324018E+02, 0.10312808E+02,-0.12823142E+01,-0.10571588E+01,&
--0.74864953E+00,-0.58705980E+00,-0.49305772E+00,-0.51461431E+00, 0.12373350E+02, 0.44809588E+00, 0.46548918E+00, 0.59121475E+00,&
- 0.74676119E+00,-0.74805226E+00,-0.56252739E+00,-0.46188072E+00,-0.40712065E+00,-0.15295996E+01, 0.43555255E+00, 0.50380874E+00,&
- 0.68537352E+00, 0.89437630E+00, 0.11127003E+01, 0.13329782E+01, 0.13845511E+01, 0.13187042E+01, 0.12644396E+01, 0.12191543E+01,&
- 0.11809511E+01, 0.11484154E+01, 0.11204723E+01, 0.10962918E+01, 0.10752229E+01, 0.10567474E+01, 0.10404465E+01, 0.11718758E+01,&
- 0.11216131E+01, 0.10809473E+01, 0.10476396E+01, 0.10200373E+01, 0.99692726E+00, 0.97740923E+00, 0.96080188E+00, 0.94657562E+00,&
- 0.93430511E+00, 0.92363528E+00, 0.22042132E+02, 0.22107298E+02, 0.22180915E+02, 0.22259478E+02, 0.22341039E+02, 0.22424247E+02,&
- 0.22508089E+02, 0.22591771E+02, 0.22674661E+02, 0.22756246E+02, 0.22836093E+02, 0.22169501E+02, 0.22270075E+02, 0.22379193E+02,&
- 0.22492992E+02, 0.22608508E+02, 0.22723843E+02, 0.22837837E+02, 0.22949751E+02, 0.23059032E+02, 0.23165146E+02, 0.23267456E+02,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00,&
- 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00, 0.00000000E+00 /) &
- , (/ 11,16,3 /) )
-
- real(kind=8), dimension(11,16,3), parameter :: GB = reshape ( (/ &
- 0.63499072E-02, 0.65566348E-02, 0.67849730E-02, 0.70481947E-02, 0.73585943E-02, 0.77242818E-02, 0.81472693E-02, 0.86227527E-02,&
- 0.91396814E-02, 0.96825438E-02, 0.10233955E-01, 0.77266491E-02, 0.81323287E-02, 0.86507620E-02, 0.92776391E-02, 0.99806312E-02,&
- 0.10709803E-01, 0.11414739E-01, 0.12058772E-01, 0.12623992E-01, 0.13108146E-01, 0.13518390E-01, 0.11644593E+01, 0.11747203E+01,&
- 0.11837872E+01, 0.11918561E+01, 0.11990757E+01, 0.12055643E+01, 0.12114186E+01, 0.12167192E+01, 0.12215344E+01, 0.12259226E+01,&
- 0.12299344E+01, 0.12006968E+01, 0.12108196E+01, 0.12196717E+01, 0.12274493E+01, 0.12343189E+01, 0.12404147E+01, 0.12458431E+01,&
- 0.12506907E+01, 0.12550299E+01, 0.12589256E+01, 0.12624402E+01, 0.15750172E+00, 0.16174076E+00, 0.16548628E+00, 0.16881124E+00,&
- 0.17177839E+00, 0.17443933E+00, 0.17683622E+00, 0.17900375E+00, 0.18097099E+00, 0.18276283E+00, 0.18440117E+00, 0.17770551E+00,&
- 0.18176757E+00, 0.18527967E+00, 0.18833348E+00, 0.19100108E+00, 0.19334122E+00, 0.19540288E+00, 0.19722732E+00, 0.19884918E+00,&
- 0.20029696E+00, 0.20159300E+00, 0.10192131E+02, 0.97258602E+01, 0.92992890E+01, 0.89154021E+01, 0.85730084E+01, 0.82685838E+01,&
- 0.79978921E+01, 0.77568055E+01, 0.75416266E+01, 0.73491694E+01, 0.71767400E+01, 0.92439050E+01, 0.87567422E+01, 0.83270144E+01,&
- 0.79528337E+01, 0.76286839E+01, 0.73477879E+01, 0.71035818E+01, 0.68903312E+01, 0.67032875E+01, 0.65386461E+01, 0.63934377E+01,&
- 0.24870635E+02, 0.24725591E+02, 0.24600320E+02, 0.24487300E+02, 0.24384935E+02, 0.24292341E+02, 0.24208572E+02, 0.24132642E+02,&
- 0.24063614E+02, 0.24000649E+02, 0.23943021E+02, 0.24586283E+02, 0.24441465E+02, 0.24311657E+02, 0.24196167E+02, 0.24093406E+02,&
- 0.24001597E+02, 0.23919098E+02, 0.23844511E+02, 0.23776708E+02, 0.23714816E+02, 0.23658197E+02, 0.11990218E+02, 0.10904073E+02,&
- 0.89126838E+01, 0.85622405E+01, 0.94892164E+01, 0.13580937E+02,-0.32050918E+03,-0.37133165E+01, 0.18890836E+00, 0.14209226E+01,&
- 0.19817679E+01, 0.79709806E+01, 0.75400737E+01, 0.81804377E+01, 0.10564339E+02, 0.46896789E+02,-0.30926524E+01, 0.85742941E+00,&
- 0.19164038E+01, 0.23513199E+01, 0.25566644E+01, 0.26555181E+01, 0.87668459E-01, 0.83754276E-01, 0.80460283E-01, 0.77659686E-01,&
- 0.75257056E-01, 0.73179175E-01, 0.71369063E-01, 0.69781812E-01, 0.68381606E-01, 0.67139539E-01, 0.66032012E-01, 0.74878820E-01,&
- 0.71650966E-01, 0.68979615E-01, 0.66745345E-01, 0.64857571E-01, 0.63248495E-01, 0.61866970E-01, 0.60673632E-01, 0.59637277E-01,&
- 0.58732178E-01, 0.57936092E-01, 0.13230067E+02, 0.13213564E+02, 0.13209140E+02, 0.13213894E+02, 0.13225963E+02, 0.13243806E+02,&
- 0.13266104E+02, 0.13291782E+02, 0.13319961E+02, 0.13349927E+02, 0.13381108E+02, 0.13183816E+02, 0.13189991E+02, 0.13209485E+02,&
- 0.13238789E+02, 0.13275017E+02, 0.13316096E+02, 0.13360555E+02, 0.13407324E+02, 0.13455544E+02, 0.13504450E+02, 0.13553282E+02,&
- 0.97222852E-01, 0.98862238E-01, 0.10061504E+00, 0.10256222E+00, 0.10475952E+00, 0.10720986E+00, 0.10985370E+00, 0.11257633E+00,&
- 0.11522980E+00, 0.11766343E+00, 0.11975320E+00, 0.10681591E+00, 0.10921298E+00, 0.11198225E+00, 0.11487826E+00, 0.11751113E+00,&
- 0.11951535E+00, 0.12069945E+00, 0.12108524E+00, 0.12084229E+00, 0.12019005E+00, 0.11932684E+00, 0.10346097E+01, 0.10433655E+01,&
- 0.10511933E+01, 0.10582150E+01, 0.10645317E+01, 0.10702313E+01, 0.10753907E+01, 0.10800762E+01, 0.10843446E+01, 0.10882439E+01,&
- 0.10918144E+01, 0.10626130E+01, 0.10716026E+01, 0.10795108E+01, 0.10865006E+01, 0.10927103E+01, 0.10982489E+01, 0.11032019E+01,&
- 0.11076379E+01, 0.11116160E+01, 0.11151910E+01, 0.11184188E+01, 0.38103212E+00, 0.38913800E+00, 0.39613651E+00, 0.40222421E+00,&
- 0.40756010E+00, 0.41226954E+00, 0.41645142E+00, 0.42018474E+00, 0.42353379E+00, 0.42655211E+00, 0.42928533E+00, 0.41646579E+00,&
- 0.42345095E+00, 0.42937476E+00, 0.43444062E+00, 0.43880316E+00, 0.44258354E+00, 0.44587882E+00, 0.44876776E+00, 0.45131451E+00,&
- 0.45357095E+00, 0.45557797E+00, 0.82623280E+01, 0.81072291E+01, 0.79523834E+01, 0.78012527E+01, 0.76561458E+01, 0.75182174E+01,&
- 0.73878952E+01, 0.72652133E+01, 0.71500151E+01, 0.70420667E+01, 0.69411177E+01, 0.79342219E+01, 0.77373458E+01, 0.75467334E+01,&
- 0.73661786E+01, 0.71974319E+01, 0.70408543E+01, 0.68960649E+01, 0.67623672E+01, 0.66389989E+01, 0.65252707E+01, 0.64206412E+01,&
- 0.10656640E+02, 0.10630910E+02, 0.10608399E+02, 0.10587891E+02, 0.10569156E+02, 0.10552075E+02, 0.10536510E+02, 0.10522307E+02,&
- 0.10509317E+02, 0.10497402E+02, 0.10486443E+02, 0.10605856E+02, 0.10579514E+02, 0.10555632E+02, 0.10534169E+02, 0.10514900E+02,&
- 0.10497547E+02, 0.10481842E+02, 0.10467553E+02, 0.10454488E+02, 0.10442501E+02, 0.10431483E+02, 0.26681588E+02, 0.24728346E+02,&
- 0.20551342E+02, 0.19955244E+02, 0.22227100E+02, 0.31770288E+02,-0.74061287E+03,-0.81329826E+01, 0.90279822E+00, 0.37532746E+01,&
- 0.50437916E+01, 0.18377807E+02, 0.17643148E+02, 0.19296161E+02, 0.24951120E+02, 0.10957372E+03,-0.67432659E+01, 0.24550746E+01,&
- 0.49089917E+01, 0.59008712E+01, 0.63532616E+01, 0.65558627E+01, 0.23203798E+01, 0.22288925E+01, 0.21515593E+01, 0.20855896E+01,&
- 0.20288489E+01, 0.19796791E+01, 0.19367778E+01, 0.18991112E+01, 0.18658501E+01, 0.18363226E+01, 0.18099779E+01, 0.20206726E+01,&
- 0.19441824E+01, 0.18807257E+01, 0.18275618E+01, 0.17825910E+01, 0.17442308E+01, 0.17112809E+01, 0.16828137E+01, 0.16580908E+01,&
- 0.16365014E+01, 0.16175164E+01, 0.22051750E+02, 0.22116850E+02, 0.22190410E+02, 0.22268925E+02, 0.22350445E+02, 0.22433617E+02,&
- 0.22517429E+02, 0.22601086E+02, 0.22683956E+02, 0.22765522E+02, 0.22845354E+02, 0.22178972E+02, 0.22279484E+02, 0.22388551E+02,&
- 0.22502309E+02, 0.22617792E+02, 0.22733099E+02, 0.22847071E+02, 0.22958967E+02, 0.23068234E+02, 0.23174336E+02, 0.23276638E+02,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01,&
- 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01, 0.10000000E+01 /) &
-  , (/ 11,16,3 /) )
-
-      real(kind=8), dimension(6,6), parameter :: XP = reshape ( (/  &
-      0.46430621E+02,  0.12928299E+03,  0.20732648E+03,  0.31398411E+03,  0.18373177E+03, -0.11412303E+03, &
-      0.73604774E+02,  0.27887914E+03,  0.27076947E+03, -0.57322111E+02, -0.64742459E+02,  0.87238280E+02, &
-      0.37050866E+02,  0.20498759E+03,  0.37558029E+03,  0.17401171E+03, -0.13350302E+03, -0.37651795E+02, &
-      0.14930141E+02,  0.89161160E+02,  0.17793062E+03,  0.93433860E+02, -0.70646020E+02, -0.26373150E+02, &
-      0.40386780E+02,  0.10855270E+03,  0.50755010E+02, -0.31496190E+02,  0.12791300E+00,  0.18017770E+01, &
-      0.90811926E+01,  0.75073923E+02,  0.24654438E+03,  0.39332612E+03,  0.29385281E+03,  0.89107921E+02 /) , (/ 6,6 /) )
-
-! If running with Reporbus type_trac=repr, values of RSUN might be overritten in radiation_AR4
-      REAL(KIND=8), dimension(2) :: RSUN = (/ 0.441676 , 0.558324 /)
-      REAL(KIND=8), dimension(2,6), parameter :: RRAY = reshape ( &
-         (/ .428937E-01, .697200E-02,&
-            .890743E+00, .173297E-01,&
-           -.288555E+01,-.850903E-01,&
-            .522744E+01, .248261E+00,&
-           -.469173E+01,-.302031E+00,&
-            .161645E+01, .129662E+00 /) , (/2,6/) )
-
-      REAL(KIND=8), dimension(2,5), parameter :: TAUA = reshape ( &
-      (/ 0.730719, 0.730719, 0.912819, 0.912819, 0.725059, &
-         0.725059, 0.745405, 0.745405, 0.682188, 0.682188 /),(/2,5/) )
-      REAL(KIND=8), dimension(2,5), parameter :: RPIZA = reshape ( &
-      (/ 0.872212, 0.872212, 0.982545, 0.982545, 0.623143,   &
-         0.623143, 0.944887, 0.944887, 0.997975, 0.997975 /),(/2,5/) )
-      REAL(KIND=8), dimension(2,5), parameter :: RCGA = reshape (  &
-      (/ 0.647596, 0.647596, 0.739002, 0.739002, 0.580845,   &
-         0.580845, 0.662657, 0.662657, 0.624246, 0.624246 /),(/2,5/) )
-
-      REAL(KIND=8), dimension(2,3,7), parameter :: APAD = reshape (  &
-          (/ 0.912418292E+05, 0.376655383E-08, 0.000000000E-00,&
-             0.739646016E-08, 0.925887084E-04, 0.410177786E+03,&
-             0.723613782E+05, 0.978576773E-04, 0.000000000E-00,&
-             0.131849595E-03, 0.129353723E-01, 0.672595424E+02,&
-             0.596037057E+04, 0.387714006E+00, 0.000000000E-00,&
-             0.437772681E+00, 0.800821928E+00, 0.000000000E-00,&
-             0.000000000E-00, 0.118461660E+03, 0.000000000E-00,&
-             0.151345118E+03, 0.242715973E+02, 0.000000000E-00,&
-             0.000000000E-00, 0.119079797E+04, 0.000000000E-00,&
-             0.233628890E+04, 0.878331486E+02, 0.000000000E-00,&
-             0.000000000E-00, 0.293353397E+03, 0.000000000E-00,&
-             0.797219934E+03, 0.191559725E+02, 0.000000000E-00,&
-             0.000000000E-00, 0.000000000E+00, 0.000000000E-00,&
-             0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /) , (/2,3,7/) )
-      REAL(KIND=8), dimension(2,3,7), parameter :: BPAD = reshape (  &
-          (/ 0.912418292E+05, 0.376655383E-08, 0.000000000E-00,&
-             0.739646016E-08, 0.925887084E-04, 0.410177786E+03,&
-             0.724555318E+05, 0.979023421E-04, 0.000000000E-00,&
-             0.131861712E-03, 0.131812683E-01, 0.731185438E+02,&
-             0.602593328E+04, 0.388611139E+00, 0.000000000E-00,&
-             0.437949001E+00, 0.812706117E+00, 0.100000000E+01,&
-             0.100000000E+01, 0.120291383E+03, 0.000000000E-00,&
-             0.151692730E+03, 0.249863591E+02, 0.000000000E+00,&
-             0.000000000E-00, 0.130531005E+04, 0.000000000E-00,&
-             0.237071130E+04, 0.931071925E+02, 0.000000000E+00,&
-             0.000000000E-00, 0.415049409E+03, 0.000000000E-00,&
-             0.867914360E+03, 0.252233437E+02, 0.000000000E+00,&
-             0.000000000E-00, 0.100000000E+01, 0.000000000E-00,&
-             0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /) , (/2,3,7/) )
-      REAL(KIND=8), dimension(2,3), parameter :: D = reshape ( &
-       (/ 0.0, 0.0, 0.0, 0.0, 0.0, 0.8 /) , (/2,3/) )
-
-      REAL(KIND=8), parameter :: TREF = 250.0
-      REAL(KIND=8), dimension(2), parameter :: RT1 = (/ -0.577350269, +0.577350269 /)
-      REAL(KIND=8), dimension(5,5), parameter :: RAER= reshape ( &
-        (/ .038520, .037196, .040532, .054934, .038520 &
-         , .12613 , .18313 , .10357 , .064106, .126130 &
-         , .012579, .013649, .018652, .025181, .012579 &
-         , .011890, .016142, .021105, .028908, .011890 &
-         , .013792, .026810, .052203, .066338, .013792 /) , (/5,5/) )
-
-      REAL(KIND=8), dimension(8,3), parameter :: AT= reshape ( &
-       (/ 0.298199E-02,0.143676E-01,0.197861E-01,0.289560E-01,&
-          0.103800E-01,0.868859E-02,0.250073E-03,0.307423E-01,&
-          -.394023E-03,0.366501E-02,0.315541E-02,-.208807E-02,&
-          0.436296E-02,-.972752E-03,0.455875E-03,0.110879E-02,&
-          0.319566E-04,-.160822E-02,-.174547E-02,-.121943E-02,&
-          -.161431E-02,0.000000E-00,0.109242E-03,-.322172E-03 /) , (/8,3/) )
-
-      REAL(KIND=8), dimension(8,3), parameter :: BT= reshape ( &
-       (/ -0.106432E-04,-0.553979E-04,-0.877012E-04,-0.165960E-03,&
-          -0.276744E-04,-0.278412E-04, 0.199846E-05,-0.108482E-03,&
-           0.660324E-06,-0.101701E-04, 0.513302E-04, 0.157704E-03,&
-          -0.327381E-04,-0.713940E-06,-0.216313E-05, 0.258096E-05,&
-           0.174356E-06, 0.920868E-05, 0.523138E-06,-0.146427E-04,&
-           0.127646E-04 ,0.117469E-05, 0.175991E-06,-0.814575E-06 /) , (/8,3/) )
-
-      REAL(KIND=8), dimension(4), parameter :: OCT = (/ -.326E-03, -.102E-05, .137E-02, -.535E-05 /)
-
- end module radiation_AR4_param
+link ../phylmd/radiation_ar4_param.F90
Index: LMDZ6/trunk/libf/phylmdiso/radio_decay.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/radio_decay.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/radio_decay.F90	(revision 3940)
@@ -1,59 +1,1 @@
-!
-! $Id $
-!
-SUBROUTINE radio_decay(radio,rnpb,dtime,tautr,tr,d_tr) 
-!
-! Caluclate radioactive decay for all tracers with radio(it)=true
-!
-  USE dimphy
-  USE infotrac_phy, ONLY : nbtr
-  USE traclmdz_mod, ONLY : id_rn, id_pb
-  IMPLICIT NONE
-!-----------------------------------------------------------------------
-! Auteur(s): AA + CG (LGGE/CNRS) Date 24-06-94
-! Objet: Calcul de la tendance radioactive des traceurs type radioelements
-!        Cas particulier pour le couple radon-plomb : Le radon decroit en plomb
-!-----------------------------------------------------------------------
-!
-! Entrees
-!
-  LOGICAL,DIMENSION(nbtr),INTENT(IN)        :: radio ! .true. = traceur radioactif  
-  LOGICAL,INTENT(IN)                        :: rnpb  ! .true. = decroissance RN = source PB
-  REAL,INTENT(IN)                           :: dtime ! Pas de temps physique (secondes)
-  REAL,DIMENSION(nbtr),INTENT(IN)           :: tautr ! Constante de decroissance radioactive
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr    ! Concentrations traceurs U/kgA
-!
-! Sortie
-!
-  REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: d_tr  ! Tendance de decroissance radioactive
-!
-! Locales
-!
-  INTEGER  :: i,k,it
-
-
-  DO it = 1,nbtr
-     d_tr(:,:,it) = 0.
-     IF ( radio(it) ) THEN
-        IF (tautr(it) .GT. 0.) THEN
-           DO k = 1,klev
-              DO i = 1,klon
-                 d_tr(i,k,it) = - tr(i,k,it) * dtime / tautr(it)
-              END DO
-           END DO
-        END IF
-     END IF
-  END DO
-
-!-------------------------------------------------------
-! Cas particulier radon (id_rn) => plomb (id_pb)
-!-------------------------------------------------------
-  IF ( rnpb ) THEN
-     DO k = 1,klev
-        DO i = 1,klon
-           d_tr(i,k,id_pb) = d_tr(i,k,id_pb) - d_tr(i,k,id_rn)
-        ENDDO
-     ENDDO
-  ENDIF
-
-END SUBROUTINE radio_decay
+link ../phylmd/radio_decay.F90
Index: LMDZ6/trunk/libf/phylmdiso/radlwsw_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/radlwsw_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/radlwsw_m.F90	(revision 3940)
@@ -1,1162 +1,1 @@
-!
-! $Id: radlwsw_m.F90 3666 2020-04-20 10:13:34Z lfalletti $
-!
-module radlwsw_m
-
-  IMPLICIT NONE
-
-contains
-
-SUBROUTINE radlwsw( &
-   dist, rmu0, fract, &
-!albedo SB >>>
-!  paprs, pplay,tsol,alb1, alb2, &
-   paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, &
-!albedo SB <<<
-   t,q,wo,&
-   cldfra, cldemi, cldtaupd,&
-   ok_ade, ok_aie, ok_volcan, flag_aerosol,&
-   flag_aerosol_strat, flag_aer_feedback, &
-   tau_aero, piz_aero, cg_aero,&
-   tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB pour RRTM
-   tau_aero_lw_rrtm, &                                   ! rajoute par C. Kleinschmitt pour RRTM
-   cldtaupi, &
-   qsat, flwc, fiwc, &
-   ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
-   heat,heat0,cool,cool0,albpla,&
-   heat_volc, cool_volc,&
-   topsw,toplw,solsw,sollw,&
-   sollwdown,&
-   topsw0,toplw0,solsw0,sollw0,&
-   lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,&
-   swdnc0, swdn0, swdn, swupc0, swup0, swup,&
-   topswad_aero, solswad_aero,&
-   topswai_aero, solswai_aero, &
-   topswad0_aero, solswad0_aero,&
-   topsw_aero, topsw0_aero,&
-   solsw_aero, solsw0_aero, &
-   topswcf_aero, solswcf_aero,&
-!-C. Kleinschmitt for LW diagnostics
-   toplwad_aero, sollwad_aero,&
-   toplwai_aero, sollwai_aero, &
-   toplwad0_aero, sollwad0_aero,&
-!-end
-   ZLWFT0_i, ZFLDN0, ZFLUP0,&
-   ZSWFT0_i, ZFSDN0, ZFSUP0)
-
-
-
-  USE DIMPHY
-  USE assert_m, ONLY : assert
-  USE infotrac_phy, ONLY : type_trac
-  USE write_field_phy
-#ifdef REPROBUS
-  USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon
-#endif
-#ifdef CPP_RRTM
-!    modules necessaires au rayonnement 
-!    -----------------------------------------
-!     USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
-!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LINHOM   , LCCNL,LCCNO,
-!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO ,&
-! NSW mis dans .def MPL 20140211
-! NLW ajoute par OB
-      USE YOERAD   , ONLY : NLW, LRRTM    ,LCCNL    ,LCCNO ,&
-          NRADIP   , NRADLP , NICEOPT, NLIQOPT ,RCCNLND  , RCCNSEA
-      USE YOELW    , ONLY : NSIL     ,NTRA     ,NUA      ,TSTAND   ,XP
-      USE YOESW    , ONLY : RYFWCA   ,RYFWCB   ,RYFWCC   ,RYFWCD,&   
-          RYFWCE   ,RYFWCF   ,REBCUA   ,REBCUB   ,REBCUC,&   
-          REBCUD   ,REBCUE   ,REBCUF   ,REBCUI   ,REBCUJ,&  
-          REBCUG   ,REBCUH   ,RHSAVI   ,RFULIO   ,RFLAA0,&  
-          RFLAA1   ,RFLBB0   ,RFLBB1   ,RFLBB2   ,RFLBB3,&  
-          RFLCC0   ,RFLCC1   ,RFLCC2   ,RFLCC3   ,RFLDD0,&  
-          RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RASWCA,& 
-          RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF
-!    &    RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF, RLINLI
-      USE YOERDU   , ONLY : NUAER  ,NTRAER ,REPLOG ,REPSC  ,REPSCW ,DIFF
-!      USE YOETHF   , ONLY : RTICE
-      USE YOERRTWN , ONLY : DELWAVE   ,TOTPLNK      
-      USE YOMPHY3  , ONLY : RII0
-#endif
-      USE aero_mod
-
-  !======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
-  ! Objet: interface entre le modele et les rayonnements
-  ! Arguments:
-  ! dist-----input-R- distance astronomique terre-soleil
-  ! rmu0-----input-R- cosinus de l'angle zenithal
-  ! fract----input-R- duree d'ensoleillement normalisee
-  ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
-  ! paprs----input-R- pression a inter-couche (Pa)
-  ! pplay----input-R- pression au milieu de couche (Pa)
-  ! tsol-----input-R- temperature du sol (en K)
-  ! alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible 
-  ! alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge   
-  ! t--------input-R- temperature (K)
-  ! q--------input-R- vapeur d'eau (en kg/kg)
-  ! cldfra---input-R- fraction nuageuse (entre 0 et 1)
-  ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
-  ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
-  ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
-  ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
-  ! ok_volcan-input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
-  ! flag_aerosol-input-I- aerosol flag from 0 to 6
-  ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (0, 1, 2)
-  ! flag_aer_feedback-input-I- activate aerosol radiative feedback (T, F)
-  ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
-  ! cldtaupi-input-R- epaisseur optique des nuages dans le visible
-  !                   calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
-  !                   droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
-  !                   it is needed for the diagnostics of the aerosol indirect radiative forcing      
-  !
-  ! heat-----output-R- echauffement atmospherique (visible) (K/jour)
-  ! cool-----output-R- refroidissement dans l'IR (K/jour)
-  ! albpla---output-R- albedo planetaire (entre 0 et 1)
-  ! topsw----output-R- flux solaire net au sommet de l'atm.
-  ! toplw----output-R- ray. IR montant au sommet de l'atmosphere
-  ! solsw----output-R- flux solaire net a la surface
-  ! sollw----output-R- ray. IR montant a la surface
-  ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
-  ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
-  ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
-  ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
-  !
-  ! heat_volc-----output-R- echauffement atmospherique  du au forcage volcanique (visible) (K/s)
-  ! cool_volc-----output-R- refroidissement dans l'IR du au forcage volcanique (K/s)
-  !
-  ! ATTENTION: swai and swad have to be interpreted in the following manner:
-  ! ---------
-  ! ok_ade=F & ok_aie=F -both are zero
-  ! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad
-  !                        indirect is zero
-  ! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
-  !                        direct is zero
-  ! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
-  !                        aerosol direct forcing is F_{AD} = topswai-topswad
-  !
-  ! --------- RRTM: output RECMWFL
-  ! ZEMTD (KPROMA,KLEV+1)         ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
-  ! ZEMTU (KPROMA,KLEV+1)         ; TOTAL UPWARD   LONGWAVE EMISSIVITY
-  ! ZTRSO (KPROMA,KLEV+1)         ; TOTAL SHORTWAVE TRANSMISSIVITY
-  ! ZTH   (KPROMA,KLEV+1)         ; HALF LEVEL TEMPERATURE
-  ! ZCTRSO(KPROMA,2)              ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
-  ! ZCEMTR(KPROMA,2)              ; CLEAR-SKY NET LONGWAVE EMISSIVITY
-  ! ZTRSOD(KPROMA)                ; TOTAL-SKY SURFACE SW TRANSMISSITY
-  ! ZLWFC (KPROMA,2)              ; CLEAR-SKY LONGWAVE FLUXES
-  ! ZLWFT (KPROMA,KLEV+1)         ; TOTAL-SKY LONGWAVE FLUXES
-  ! ZLWFT0(KPROMA,KLEV+1)         ; CLEAR-SKY LONGWAVE FLUXES      ! added by MPL 090109
-  ! ZSWFC (KPROMA,2)              ; CLEAR-SKY SHORTWAVE FLUXES
-  ! ZSWFT (KPROMA,KLEV+1)         ; TOTAL-SKY SHORTWAVE FLUXES
-  ! ZSWFT0(KPROMA,KLEV+1)         ; CLEAR-SKY SHORTWAVE FLUXES     ! added by MPL 090109
-  ! ZFLUX (KLON,2,KLEV+1)         ; TOTAL LW FLUXES  1=up, 2=DWN   ! added by MPL 080411
-  ! ZFLUC (KLON,2,KLEV+1)         ; CLEAR SKY LW FLUXES            ! added by MPL 080411
-  ! ZFSDWN(klon,KLEV+1)           ; TOTAL SW  DWN FLUXES           ! added by MPL 080411
-  ! ZFCDWN(klon,KLEV+1)           ; CLEAR SKY SW  DWN FLUXES       ! added by MPL 080411
-  ! ZFCCDWN(klon,KLEV+1)          ; CLEAR SKY CLEAN (NO AEROSOL) SW  DWN FLUXES      ! added by OB 211117
-  ! ZFSUP (klon,KLEV+1)           ; TOTAL SW  UP  FLUXES           ! added by MPL 080411
-  ! ZFCUP (klon,KLEV+1)           ; CLEAR SKY SW  UP  FLUXES       ! added by MPL 080411
-  ! ZFCCUP (klon,KLEV+1)          ; CLEAR SKY CLEAN (NO AEROSOL) SW  UP  FLUXES      ! added by OB 211117
-  ! ZFLCCDWN(klon,KLEV+1)         ; CLEAR SKY CLEAN (NO AEROSOL) LW  DWN FLUXES      ! added by OB 211117
-  ! ZFLCCUP (klon,KLEV+1)         ; CLEAR SKY CLEAN (NO AEROSOL) LW  UP  FLUXES      ! added by OB 211117
-  
-  !======================================================================
-  
-  ! ====================================================================
-  ! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009
-  ! 1 = ZERO    
-  ! 2 = AER total    
-  ! 3 = NAT    
-  ! 4 = BC    
-  ! 5 = SO4    
-  ! 6 = POM    
-  ! 7 = DUST    
-  ! 8 = SS    
-  ! 9 = NO3    
-  ! 
-  ! ====================================================================
-  include "YOETHF.h"
-  include "YOMCST.h"
-  include "clesphys.h"
-
-! Input arguments
-  REAL,    INTENT(in)  :: dist
-  REAL,    INTENT(in)  :: rmu0(KLON), fract(KLON)
-  REAL,    INTENT(in)  :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
-!albedo SB >>>
-! REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
-  REAL,    INTENT(in)  :: tsol(KLON)
-  REAL,    INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW)
-  real, intent(in) :: SFRWL(6)
-!albedo SB <<<
-  REAL,    INTENT(in)  :: t(KLON,KLEV), q(KLON,KLEV)
-
-  REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2)
-  ! column-density of ozone in a layer, in kilo-Dobsons
-  ! "wo(:, :, 1)" is for the average day-night field, 
-  ! "wo(:, :, 2)" is for daylight time.
-
-  LOGICAL, INTENT(in)  :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
-  LOGICAL, INTENT(in)  :: ok_volcan                                      ! produce volcanic diags (SW/LW heat flux and rate)
-  LOGICAL              :: lldebug
-  INTEGER, INTENT(in)  :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
-  INTEGER, INTENT(in)  :: flag_aerosol_strat                             ! use stratospheric aerosols
-  LOGICAL, INTENT(in)  :: flag_aer_feedback                              ! activate aerosol radiative feedback
-  REAL,    INTENT(in)  :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV)
-  REAL,    INTENT(in)  :: tau_aero(KLON,KLEV,naero_grp,2)                        ! aerosol optical properties (see aeropt.F)
-  REAL,    INTENT(in)  :: piz_aero(KLON,KLEV,naero_grp,2)                        ! aerosol optical properties (see aeropt.F)
-  REAL,    INTENT(in)  :: cg_aero(KLON,KLEV,naero_grp,2)                         ! aerosol optical properties (see aeropt.F)
-!--OB
-  REAL,    INTENT(in)  :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
-  REAL,    INTENT(in)  :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
-  REAL,    INTENT(in)  :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW)                  ! aerosol optical properties RRTM
-!--OB fin
-
-!--C. Kleinschmitt
-#ifdef CPP_RRTM
-  REAL,    INTENT(in)  :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW)                 ! LW aerosol optical properties RRTM
-#else
-  REAL,    INTENT(in)  :: tau_aero_lw_rrtm(KLON,KLEV,2,nbands_lw_rrtm)
-#endif
-!--C. Kleinschmitt end
-
-  REAL,    INTENT(in)  :: cldtaupi(KLON,KLEV)                            ! cloud optical thickness for pre-industrial aerosol concentrations
-  REAL,    INTENT(in)  :: qsat(klon,klev) ! Variable pour iflag_rrtm=1
-  REAL,    INTENT(in)  :: flwc(klon,klev) ! Variable pour iflag_rrtm=1
-  REAL,    INTENT(in)  :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1
-  REAL,    INTENT(in)  :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro
-  REAL,    INTENT(in)  :: ref_ice(klon,klev) ! ice crystal radius   present-day from newmicro
-  REAL,    INTENT(in)  :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro
-  REAL,    INTENT(in)  :: ref_ice_pi(klon,klev) ! ice crystal radius   pre-industrial from newmicro
-
-! Output arguments
-  REAL,    INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV)
-  REAL,    INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV)
-  REAL,    INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL
-  REAL,    INTENT(out) :: topsw(KLON), toplw(KLON)
-  REAL,    INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON)
-  REAL,    INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
-  REAL,    INTENT(out) :: sollwdown(KLON)
-  REAL,    INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1)
-  REAL,    INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1)
-  REAL,    INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1)
-  REAL,    INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1)
-  REAL,    INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON)         ! output: aerosol direct forcing at TOA and surface
-  REAL,    INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON)         ! output: aerosol indirect forcing atTOA and surface
-  REAL,    INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON)         ! output: LW aerosol direct forcing at TOA and surface
-  REAL,    INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON)         ! output: LW aerosol indirect forcing atTOA and surface
-  REAL, DIMENSION(klon), INTENT(out)    :: topswad0_aero 
-  REAL, DIMENSION(klon), INTENT(out)    :: solswad0_aero
-  REAL, DIMENSION(klon), INTENT(out)    :: toplwad0_aero 
-  REAL, DIMENSION(klon), INTENT(out)    :: sollwad0_aero
-  REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero
-  REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero
-  REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero
-  REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero
-  REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero
-  REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero
-  REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i
-  REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i
-
-! Local variables
-  REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFLUP(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFLDN(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1)
-  REAL(KIND=8) zx_alpha1, zx_alpha2
-  INTEGER k, kk, i, j, iof, nb_gr
-  INTEGER ist,iend,ktdia,kmode
-  REAL(KIND=8) PSCT
-  REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2)
-!  MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW
-! avec NSW en deuxieme dimension       
-  REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW)
-  REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
-  REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV)
-  REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
-  REAL(KIND=8) PTAVE(kdlon,kflev)
-  REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev)
-
-  real(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
-  ! "POZON(:, :, 1)" is for the average day-night field, 
-  ! "POZON(:, :, 2)" is for daylight time.
-!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6  
-  REAL(KIND=8) PAER(kdlon,kflev,6)
-  REAL(KIND=8) PCLDLD(kdlon,kflev)
-  REAL(KIND=8) PCLDLU(kdlon,kflev)
-  REAL(KIND=8) PCLDSW(kdlon,kflev)
-  REAL(KIND=8) PTAU(kdlon,2,kflev)
-  REAL(KIND=8) POMEGA(kdlon,2,kflev)
-  REAL(KIND=8) PCG(kdlon,2,kflev)
-  REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist
-  REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev)
-  REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev)
-  REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL
-  REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon)
-  REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
-  REAL(KIND=8) zsollwdown(kdlon)
-  REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon)
-  REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon)
-  REAL(KIND=8) zznormcp
-  REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2)                     ! aer opt properties
-  REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2)
-  REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2)
-  REAL(KIND=8) PTAUA(kdlon,2,kflev)                         ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use
-  REAL(KIND=8) POMEGAA(kdlon,2,kflev)                       ! dito for single scatt albedo
-  REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon)     ! Aerosol direct forcing at TOAand surface
-  REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon)   ! Aerosol direct forcing at TOAand surface
-  REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon)     ! dito, indirect
-!--NL
-  REAL(KIND=8) zswadaero(kdlon,kflev+1)                       ! SW Aerosol direct forcing
-  REAL(KIND=8) zlwadaero(kdlon,kflev+1)                       ! LW Aerosol direct forcing
-!-LW by CK
-  REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon)     ! LW Aerosol direct forcing at TOAand surface
-  REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon)   ! LW Aerosol direct forcing at TOAand surface
-  REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon)     ! dito, indirect
-!-end
-  REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9)
-  REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9)
-  REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3)     
-! real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 deje declare dans physiq.F MPL 20130618
-!MPL input supplementaires pour RECMWFL
-! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
-      REAL(KIND=8) GEMU(klon)
-!MPL input RECMWFL: 
-! Tableaux aux niveaux inverses pour respecter convention Arpege
-      REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted)
-      REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted)
-!--OB
-      REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted)
-      REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted)
-!--end OB
-      REAL(KIND=8) paprs_i(klon,klev+1)
-      REAL(KIND=8) pplay_i(klon,klev)
-      REAL(KIND=8) cldfra_i(klon,klev)
-      REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone 
-  ! "POZON(:, :, 1)" is for the average day-night field, 
-  ! "POZON(:, :, 2)" is for daylight time.
-!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6      
-      REAL(KIND=8) PAER_i(kdlon,kflev,6)
-      REAL(KIND=8) PDP_i(klon,klev)
-      REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev)
-      REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev)
-!MPL output RECMWFL:
-      REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1)       
-      REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1)      
-      REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1)    
-      REAL(KIND=8) ZTH   (klon,klev+1),ZTH_i   (klon,klev+1)   
-      REAL(KIND=8) ZCTRSO(klon,2)       
-      REAL(KIND=8) ZCEMTR(klon,2)     
-      REAL(KIND=8) ZTRSOD(klon)        
-      REAL(KIND=8) ZLWFC (klon,2)      
-      REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1)    
-      REAL(KIND=8) ZSWFC (klon,2)      
-      REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
-      REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1)
-      REAL(KIND=8) PPIZA_TOT(klon,klev,NSW)
-      REAL(KIND=8) PCGA_TOT(klon,klev,NSW)
-      REAL(KIND=8) PTAU_TOT(klon,klev,NSW)
-      REAL(KIND=8) PPIZA_NAT(klon,klev,NSW)
-      REAL(KIND=8) PCGA_NAT(klon,klev,NSW)
-      REAL(KIND=8) PTAU_NAT(klon,klev,NSW)
-#ifdef CPP_RRTM
-      REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW)
-      REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW)
-#endif
-      REAL(KIND=8) PSFSWDIR(klon,NSW)
-      REAL(KIND=8) PSFSWDIF(klon,NSW)
-      REAL(KIND=8) PFSDNN(klon)
-      REAL(KIND=8) PFSDNV(klon)
-!MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC,
-!MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja
-!MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0,
-!MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0
-      REAL(KIND=8) ZFLUX_i (klon,2,klev+1)
-      REAL(KIND=8) ZFLUC_i (klon,2,klev+1)
-      REAL(KIND=8) ZFSDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFCDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFCCDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFSUP_i (klon,klev+1)
-      REAL(KIND=8) ZFCUP_i (klon,klev+1)
-      REAL(KIND=8) ZFCCUP_i (klon,klev+1)
-      REAL(KIND=8) ZFLCCDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFLCCUP_i (klon,klev+1)
-! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412)
-!      REAL(KIND=8) RSUN(3,2)
-!      REAL(KIND=8) SUN(3)
-!      REAL(KIND=8) SUN_FRACT(2)
-  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
-  CHARACTER (LEN=80) :: abort_message
-  CHARACTER (LEN=80) :: modname='radlwsw_m'
-
-  call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
-  ! initialisation
-  ist=1
-  iend=klon
-  ktdia=1
-  kmode=ist 
-  tauaero(:,:,:,:)=0.
-  pizaero(:,:,:,:)=0.
-  cgaero(:,:,:,:)=0.
-  lldebug=.FALSE.
-
-  ztopsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
-  ztopsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
-  zsolsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
-  zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
-
-
-   ZTOPSWADAERO(:)  = 0. !ym missing init
-   ZSOLSWADAERO(:)  = 0. !ym missing init
-   ZTOPSWAD0AERO(:) = 0. !ym missing init
-   ZSOLSWAD0AERO(:) = 0. !ym missing init
-   ZTOPSWAIAERO(:)  = 0. !ym missing init 
-   ZSOLSWAIAERO(:)  = 0. !ym missing init  
-   ZTOPSWCF_AERO(:,:)= 0.!ym missing init  
-   ZSOLSWCF_AERO(:,:) =0. !ym missing init  
-
-  !
-  !-------------------------------------------
-  nb_gr = KLON / kdlon
-  IF (nb_gr*kdlon .NE. KLON) THEN
-      PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr
-      call abort_physic("radlwsw", "", 1)
-  ENDIF
-  IF (kflev .NE. KLEV) THEN
-      PRINT*, "kflev differe de KLEV, kflev, KLEV"
-      call abort_physic("radlwsw", "", 1)
-  ENDIF
-  !-------------------------------------------
-  DO k = 1, KLEV
-    DO i = 1, KLON
-      heat(i,k)=0.
-      cool(i,k)=0.
-      heat_volc(i,k)=0. !NL
-      cool_volc(i,k)=0. !NL
-      heat0(i,k)=0.
-      cool0(i,k)=0.
-    ENDDO
-  ENDDO
-  !
-  zdist = dist
-  !
-  PSCT = solaire/zdist/zdist
-
-  IF (type_trac == 'repr') THEN
-#ifdef REPROBUS
-    IF (iflag_rrtm==0) THEN
-      if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
-      print*,'Constante solaire: ',PSCT*zdist*zdist
-    END IF
-#endif
-  END IF
-
-  DO j = 1, nb_gr
-    iof = kdlon*(j-1)
-    DO i = 1, kdlon
-      zfract(i) = fract(iof+i)
-!     zfract(i) = 1.     !!!!!!  essai MPL 19052010
-      zrmu0(i) = rmu0(iof+i)
-
-
-!albedo SB >>>
-!
-      IF (iflag_rrtm==0) THEN
-!
-        PALBD(i,1)=alb_dif(iof+i,1)
-        PALBD(i,2)=alb_dif(iof+i,2)
-        PALBP(i,1)=alb_dir(iof+i,1)
-        PALBP(i,2)=alb_dir(iof+i,2)
-!
-      ELSEIF (iflag_rrtm==1) THEn
-!
-        DO kk=1,NSW
-          PALBD_NEW(i,kk)=alb_dif(iof+i,kk)
-          PALBP_NEW(i,kk)=alb_dir(iof+i,kk)
-        ENDDO
-!
-      ENDIF
-!albedo SB <<<
-
-
-      PEMIS(i) = 1.0    !!!!! A REVOIR (MPL) 
-      PVIEW(i) = 1.66
-      PPSOL(i) = paprs(iof+i,1)
-      zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2))
-      zx_alpha2 = 1.0 - zx_alpha1
-      PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
-      PTL(i,KLEV+1) = t(iof+i,KLEV)
-      PDT0(i) = tsol(iof+i) - PTL(i,1)
-    ENDDO
-    DO k = 2, kflev
-      DO i = 1, kdlon
-        PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
-      ENDDO
-    ENDDO
-    DO k = 1, kflev
-      DO i = 1, kdlon
-        PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
-        PTAVE(i,k) = t(iof+i,k)
-        PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
-        PQS(i,k) = PWV(i,k)
-!       Confert from  column density of ozone in a cell, in kDU, to a mass fraction
-        POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 &
-             / (paprs(iof+i, k) - paprs(iof+i, k+1))
-!       A activer pour CCMVAL on prend l'ozone impose (MPL 07042010)
-!       POZON(i,k,:) = wo(i,k,:)  
-!       print *,'RADLWSW: POZON',k, POZON(i,k,1) 
-        PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
-        PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
-        PCLDSW(i,k) = cldfra(iof+i,k)
-        PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable
-        PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines
-        POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
-        POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
-        PCG(i,1,k) = 0.865
-        PCG(i,2,k) = 0.910
-        !-
-        ! Introduced for aerosol indirect forcings.
-        ! The following values use the cloud optical thickness calculated from
-        ! present-day aerosol concentrations whereas the quantities without the
-        ! "A" at the end are for pre-industial (natural-only) aerosol concentrations
-        !
-        PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable
-        PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines
-        POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k))
-        POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k))
-      ENDDO
-    ENDDO
-
-    IF (type_trac == 'repr') THEN
-#ifdef REPROBUS
-       ndimozon = size(wo, 3)
-       CALL RAD_INTERACTIF(POZON,iof)
-#endif
-    END IF
-
-    !
-    DO k = 1, kflev+1
-      DO i = 1, kdlon
-        PPMB(i,k) = paprs(iof+i,k)/100.0
-      ENDDO
-    ENDDO
-    !
-!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 
-    DO kk = 1, 6
-      DO k = 1, kflev
-        DO i = 1, kdlon
-          PAER(i,k,kk) = 1.0E-15   !!!!! A REVOIR (MPL)
-        ENDDO
-      ENDDO
-    ENDDO
-    DO k = 1, kflev
-      DO i = 1, kdlon
-        tauaero(i,k,:,1)=tau_aero(iof+i,k,:,1)
-        pizaero(i,k,:,1)=piz_aero(iof+i,k,:,1)
-        cgaero(i,k,:,1) =cg_aero(iof+i,k,:,1)
-        tauaero(i,k,:,2)=tau_aero(iof+i,k,:,2)
-        pizaero(i,k,:,2)=piz_aero(iof+i,k,:,2)
-        cgaero(i,k,:,2) =cg_aero(iof+i,k,:,2)
-      ENDDO
-    ENDDO
-
-!
-!===== iflag_rrtm ================================================
-!      
-    IF (iflag_rrtm == 0) THEN       !!!! remettre 0 juste pour tester l'ancien rayt via rrtm
-!--- Mise a zero des tableaux output du rayonnement LW-AR4 ----------              
-      DO k = 1, kflev+1
-      DO i = 1, kdlon
-!     print *,'RADLWSW: boucle mise a zero i k',i,k
-      ZFLUP(i,k)=0.
-      ZFLDN(i,k)=0.
-      ZFLUP0(i,k)=0.
-      ZFLDN0(i,k)=0.
-      ZLWFT0_i(i,k)=0.
-      ZFLUCUP_i(i,k)=0.
-      ZFLUCDWN_i(i,k)=0.
-      ENDDO
-      ENDDO
-      DO k = 1, kflev
-         DO i = 1, kdlon
-            zcool(i,k)=0.
-            zcool_volc(i,k)=0. !NL
-            zcool0(i,k)=0.
-         ENDDO
-      ENDDO
-      DO i = 1, kdlon
-      ztoplw(i)=0.
-      zsollw(i)=0.
-      ztoplw0(i)=0.
-      zsollw0(i)=0.
-      zsollwdown(i)=0.
-      ENDDO
-       ! Old radiation scheme, used for AR4 runs
-       ! average day-night ozone for longwave
-       CALL LW_LMDAR4(&
-            PPMB, PDP,&
-            PPSOL,PDT0,PEMIS,&
-            PTL, PTAVE, PWV, POZON(:, :, 1), PAER,&
-            PCLDLD,PCLDLU,&
-            PVIEW,&
-            zcool, zcool0,&
-            ztoplw,zsollw,ztoplw0,zsollw0,&
-            zsollwdown,&
-            ZFLUP, ZFLDN, ZFLUP0,ZFLDN0)
-!----- Mise a zero des tableaux output du rayonnement SW-AR4 
-      DO k = 1, kflev+1
-         DO i = 1, kdlon
-            ZFSUP(i,k)=0.
-            ZFSDN(i,k)=0.
-            ZFSUP0(i,k)=0.
-            ZFSDN0(i,k)=0.
-            ZFSUPC0(i,k)=0.
-            ZFSDNC0(i,k)=0.
-            ZFLUPC0(i,k)=0.
-            ZFLDNC0(i,k)=0.
-            ZSWFT0_i(i,k)=0.
-            ZFCUP_i(i,k)=0.
-            ZFCDWN_i(i,k)=0.
-            ZFCCUP_i(i,k)=0.
-            ZFCCDWN_i(i,k)=0.
-            ZFLCCUP_i(i,k)=0.
-            ZFLCCDWN_i(i,k)=0.
-            zswadaero(i,k)=0. !--NL
-         ENDDO
-      ENDDO
-      DO k = 1, kflev
-         DO i = 1, kdlon
-            zheat(i,k)=0.
-            zheat_volc(i,k)=0.
-            zheat0(i,k)=0.
-         ENDDO
-      ENDDO
-      DO i = 1, kdlon
-      zalbpla(i)=0.
-      ztopsw(i)=0.
-      zsolsw(i)=0.
-      ztopsw0(i)=0.
-      zsolsw0(i)=0.
-      ztopswadaero(i)=0.
-      zsolswadaero(i)=0.
-      ztopswaiaero(i)=0.
-      zsolswaiaero(i)=0.
-      ENDDO
-!     print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract
-       ! daylight ozone, if we have it, for short wave
-      CALL SW_AEROAR4(PSCT, zrmu0, zfract,&
-               PPMB, PDP,&
-               PPSOL, PALBD, PALBP,&
-               PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,&
-               PCLDSW, PTAU, POMEGA, PCG,&
-               zheat, zheat0,&
-               zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
-               ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
-               tauaero, pizaero, cgaero, &
-               PTAUA, POMEGAA,&
-               ztopswadaero,zsolswadaero,&
-               ztopswad0aero,zsolswad0aero,&
-               ztopswaiaero,zsolswaiaero, & 
-               ztopsw_aero,ztopsw0_aero,&
-               zsolsw_aero,zsolsw0_aero,&
-               ztopswcf_aero,zsolswcf_aero, & 
-               ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) 
-
-       ZSWFT0_i(:,:) = ZFSDN0(:,:)-ZFSUP0(:,:)
-       ZLWFT0_i(:,:) =-ZFLDN0(:,:)-ZFLUP0(:,:)
-
-       DO i=1,kdlon
-       DO k=1,kflev+1
-!        print *,'iof i k klon klev=',iof,i,k,klon,klev
-         lwdn0 ( iof+i,k)   = ZFLDN0 ( i,k)
-         lwdn  ( iof+i,k)   = ZFLDN  ( i,k)
-         lwup0 ( iof+i,k)   = ZFLUP0 ( i,k)
-         lwup  ( iof+i,k)   = ZFLUP  ( i,k)
-         swdn0 ( iof+i,k)   = ZFSDN0 ( i,k)
-         swdn  ( iof+i,k)   = ZFSDN  ( i,k)
-         swup0 ( iof+i,k)   = ZFSUP0 ( i,k)
-         swup  ( iof+i,k)   = ZFSUP  ( i,k)
-       ENDDO  
-       ENDDO  
-!          print*,'SW_AR4 ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
-!          print*,'SW_AR4 swdn0  1 , klev:',swdn0(1:klon,1),swdn0(1:klon,klev)
-!          print*,'SW_AR4 ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
-!          print*,'SW_AR4 swup0  1 , klev:',swup0(1:klon,1),swup0(1:klon,klev)
-!          print*,'SW_AR4 ZFSDN  1 , klev:',ZFSDN(1:klon,1) ,ZFSDN(1:klon,klev)
-!          print*,'SW_AR4 ZFSUP  1 , klev:',ZFSUP(1:klon,1) ,ZFSUP(1:klon,klev)
-    ELSE  
-#ifdef CPP_RRTM
-!      if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.' 
-!===== iflag_rrtm=1, on passe dans SW via RECMWFL ===============
-
-      DO k = 1, kflev+1
-      DO i = 1, kdlon
-      ZEMTD_i(i,k)=0.
-      ZEMTU_i(i,k)=0.
-      ZTRSO_i(i,k)=0.
-      ZTH_i(i,k)=0.
-      ZLWFT_i(i,k)=0.
-      ZSWFT_i(i,k)=0.
-      ZFLUX_i(i,1,k)=0.
-      ZFLUX_i(i,2,k)=0.
-      ZFLUC_i(i,1,k)=0.
-      ZFLUC_i(i,2,k)=0.
-      ZFSDWN_i(i,k)=0.
-      ZFCDWN_i(i,k)=0.
-      ZFCCDWN_i(i,k)=0.
-      ZFSUP_i(i,k)=0.
-      ZFCUP_i(i,k)=0.
-      ZFCCUP_i(i,k)=0.
-      ZFLCCDWN_i(i,k)=0.
-      ZFLCCUP_i(i,k)=0.
-      ENDDO
-      ENDDO
-!
-!--OB
-!--aerosol TOT  - anthropogenic+natural - index 2
-!--aerosol NAT  - natural only          - index 1
-!
-      DO i = 1, kdlon
-      DO k = 1, kflev
-      DO kk=1, NSW
-!
-      PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk)
-      PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk)
-      PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk)
-!
-      PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk)
-      PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk)
-      PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk)
-!
-      ENDDO
-      ENDDO
-      ENDDO
-!-end OB
-!
-!--C. Kleinschmitt
-!--aerosol TOT  - anthropogenic+natural - index 2
-!--aerosol NAT  - natural only          - index 1
-!
-      DO i = 1, kdlon
-      DO k = 1, kflev
-      DO kk=1, NLW
-!
-      PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk)
-      PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk)
-!
-      ENDDO
-      ENDDO
-      ENDDO
-!-end C. Kleinschmitt
-!      
-      DO i = 1, kdlon
-      ZCTRSO(i,1)=0.
-      ZCTRSO(i,2)=0.
-      ZCEMTR(i,1)=0.
-      ZCEMTR(i,2)=0.
-      ZTRSOD(i)=0.
-      ZLWFC(i,1)=0.
-      ZLWFC(i,2)=0.
-      ZSWFC(i,1)=0.
-      ZSWFC(i,2)=0.
-      PFSDNN(i)=0.
-      PFSDNV(i)=0.
-      DO kk = 1, NSW
-      PSFSWDIR(i,kk)=0.
-      PSFSWDIF(i,kk)=0.
-      ENDDO
-      ENDDO
-!----- Fin des mises a zero des tableaux output de RECMWF -------------------              
-!        GEMU(1:klon)=sin(rlatd(1:klon))
-! On met les donnees dans l'ordre des niveaux arpege
-         paprs_i(:,1)=paprs(:,klev+1)
-         do k=1,klev
-            paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k)
-            pplay_i(1:klon,k)   =pplay(1:klon,klev+1-k)
-            cldfra_i(1:klon,k)  =cldfra(1:klon,klev+1-k)
-            PDP_i(1:klon,k)     =PDP(1:klon,klev+1-k)
-            t_i(1:klon,k)       =t(1:klon,klev+1-k)
-            q_i(1:klon,k)       =q(1:klon,klev+1-k)
-            qsat_i(1:klon,k)    =qsat(1:klon,klev+1-k)
-            flwc_i(1:klon,k)    =flwc(1:klon,klev+1-k)
-            fiwc_i(1:klon,k)    =fiwc(1:klon,klev+1-k)
-            ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k)
-            ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k)
-!-OB
-            ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k)
-            ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k)
-         enddo
-         do k=1,kflev
-           POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:)
-!!!            POZON_i(1:klon,k)=POZON(1:klon,k)	    !!! on laisse 1=sol et klev=top 
-!          print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k)
-!!!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6      
-            do i=1,6
-            PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i)
-            enddo
-         enddo
-!       print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0
-
-!  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-! La version ARPEGE1D utilise differentes valeurs de la constante
-! solaire suivant le rayonnement utilise.
-! A controler ...
-! SOLAR FLUX AT THE TOP (/YOMPHY3/)
-! introduce season correction
-!--------------------------------------
-! RII0 = RIP0
-! IF(LRAYFM)
-! RII0 = RIP0M   ! =rip0m if Morcrette non-each time step call.
-! IF(LRAYFM15)
-! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call.
-         RII0=solaire/zdist/zdist
-!print*,'+++ radlwsw: solaire ,RII0',solaire,RII0
-!  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-! Ancien appel a RECMWF (celui du cy25)
-!        CALL RECMWF (ist , iend, klon , ktdia , klev   , kmode ,
-!    s   PALBD    , PALBP   , paprs_i , pplay_i , RCO2   , cldfra_i,
-!    s   POZON_i  , PAER_i  , PDP_i   , PEMIS   , GEMU   , rmu0,
-!    s    q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,
-!    s   ZEMTD_i  , ZEMTU_i , ZTRSO_i ,
-!    s   ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,
-!    s   ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,
-!    s   ZFLUX_i  , ZFLUC_i , ZFSDWN_i, ZFSUP_i , ZFCDWN_i,ZFCUP_i)
-!    s   'RECMWF ')
-!
-      if(lldebug) then
-        CALL writefield_phy('paprs_i',paprs_i,klev+1)
-        CALL writefield_phy('pplay_i',pplay_i,klev)
-        CALL writefield_phy('cldfra_i',cldfra_i,klev)
-        CALL writefield_phy('pozon_i',POZON_i,klev)
-        CALL writefield_phy('paer_i',PAER_i,klev)
-        CALL writefield_phy('pdp_i',PDP_i,klev)
-        CALL writefield_phy('q_i',q_i,klev)
-        CALL writefield_phy('qsat_i',qsat_i,klev)
-        CALL writefield_phy('fiwc_i',fiwc_i,klev)
-        CALL writefield_phy('flwc_i',flwc_i,klev)
-        CALL writefield_phy('t_i',t_i,klev)
-        CALL writefield_phy('palbd_new',PALBD_NEW,NSW)
-        CALL writefield_phy('palbp_new',PALBP_NEW,NSW)
-      endif
-
-! Nouvel appel a RECMWF (celui du cy32t0)
-         CALL RECMWF_AERO (ist , iend, klon , ktdia  , klev   , kmode ,&
-         PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2   , cldfra_i,&
-         POZON_i  , PAER_i  , PDP_i   , PEMIS   , rmu0   ,&
-          q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
-         ref_liq_i, ref_ice_i, &
-         ref_liq_pi_i, ref_ice_pi_i, &   ! rajoute par OB pour diagnostiquer effet indirect
-         ZEMTD_i  , ZEMTU_i , ZTRSO_i ,&
-         ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,&
-         ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,&
-         PSFSWDIR , PSFSWDIF, PFSDNN  , PFSDNV  ,&
-         PPIZA_TOT, PCGA_TOT,PTAU_TOT,&
-         PPIZA_NAT, PCGA_NAT,PTAU_NAT,           &  ! rajoute par OB pour diagnostiquer effet direct
-         PTAU_LW_TOT, PTAU_LW_NAT,               &  ! rajoute par C. Kleinschmitt
-         ZFLUX_i  , ZFLUC_i ,&
-         ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i, ZFCCDWN_i, ZFCCUP_i, ZFLCCDWN_i, ZFLCCUP_i, &
-         ZTOPSWADAERO,ZSOLSWADAERO,&  ! rajoute par OB pour diagnostics
-         ZTOPSWAD0AERO,ZSOLSWAD0AERO,&
-         ZTOPSWAIAERO,ZSOLSWAIAERO, &
-         ZTOPSWCF_AERO,ZSOLSWCF_AERO, &
-         ZSWADAERO, & !--NL
-         ZTOPLWADAERO,ZSOLLWADAERO,&  ! rajoute par C. Kleinscmitt pour LW diagnostics
-         ZTOPLWAD0AERO,ZSOLLWAD0AERO,&
-         ZTOPLWAIAERO,ZSOLLWAIAERO, &
-         ZLWADAERO, & !--NL
-         ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat, flag_aer_feedback) ! flags aerosols
-            
-!        print *,'RADLWSW: apres RECMWF'
-      if(lldebug) then
-        CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1)
-        CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1)
-        CALL writefield_phy('ztrso_i',ZTRSO_i,klev+1)
-        CALL writefield_phy('zth_i',ZTH_i,klev+1)
-        CALL writefield_phy('zctrso',ZCTRSO,2)
-        CALL writefield_phy('zcemtr',ZCEMTR,2)
-        CALL writefield_phy('ztrsod',ZTRSOD,1)
-        CALL writefield_phy('zlwfc',ZLWFC,2)
-        CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1)
-        CALL writefield_phy('zswfc',ZSWFC,2)
-        CALL writefield_phy('zswft_i',ZSWFT_i,klev+1)
-        CALL writefield_phy('psfswdir',PSFSWDIR,6)
-        CALL writefield_phy('psfswdif',PSFSWDIF,6)
-        CALL writefield_phy('pfsdnn',PFSDNN,1)
-        CALL writefield_phy('pfsdnv',PFSDNV,1)
-        CALL writefield_phy('ppiza_dst',PPIZA_TOT,klev)
-        CALL writefield_phy('pcga_dst',PCGA_TOT,klev)
-        CALL writefield_phy('ptaurel_dst',PTAU_TOT,klev)
-        CALL writefield_phy('zflux_i',ZFLUX_i,klev+1)
-        CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1)
-        CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1)
-        CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1)
-        CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1)
-        CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1)
-      endif
-! --------- output RECMWFL
-!  ZEMTD        (KPROMA,KLEV+1)  ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
-!  ZEMTU        (KPROMA,KLEV+1)  ; TOTAL UPWARD   LONGWAVE EMISSIVITY
-!  ZTRSO        (KPROMA,KLEV+1)  ; TOTAL SHORTWAVE TRANSMISSIVITY
-!  ZTH          (KPROMA,KLEV+1)  ; HALF LEVEL TEMPERATURE
-!  ZCTRSO       (KPROMA,2)       ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
-!  ZCEMTR       (KPROMA,2)       ; CLEAR-SKY NET LONGWAVE EMISSIVITY
-!  ZTRSOD       (KPROMA)         ; TOTAL-SKY SURFACE SW TRANSMISSITY
-!  ZLWFC        (KPROMA,2)       ; CLEAR-SKY LONGWAVE FLUXES
-!  ZLWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY LONGWAVE FLUXES
-!  ZSWFC        (KPROMA,2)       ; CLEAR-SKY SHORTWAVE FLUXES
-!  ZSWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY SHORTWAVE FLUXES
-!  PPIZA_TOT    (KPROMA,KLEV,NSW); Single scattering albedo of total aerosols 
-!  PCGA_TOT     (KPROMA,KLEV,NSW); Assymetry factor for total aerosols 
-!  PTAU_TOT     (KPROMA,KLEV,NSW); Optical depth of total aerosols 
-!  PPIZA_NAT    (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosols 
-!  PCGA_NAT     (KPROMA,KLEV,NSW); Assymetry factor for natural aerosols 
-!  PTAU_NAT     (KPROMA,KLEV,NSW); Optical depth of natiral aerosols
-!  PTAU_LW_TOT  (KPROMA,KLEV,NLW); LW Optical depth of total aerosols  
-!  PTAU_LW_NAT  (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols  
-!  PSFSWDIR     (KPROMA,NSW)     ;
-!  PSFSWDIF     (KPROMA,NSW)     ;
-!  PFSDNN       (KPROMA)         ;
-!  PFSDNV       (KPROMA)         ;
-! ---------
-! ---------
-! On retablit l'ordre des niveaux lmd pour les tableaux de sortie
-! D autre part, on multiplie les resultats SW par fract pour etre coherent
-! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de 
-! rayonnement SW. (MPL 260609)
-      DO k=0,klev
-         DO i=1,klon
-         ZEMTD(i,k+1)  = ZEMTD_i(i,k+1)
-         ZEMTU(i,k+1)  = ZEMTU_i(i,k+1)
-         ZTRSO(i,k+1)  = ZTRSO_i(i,k+1)
-         ZTH(i,k+1)    = ZTH_i(i,k+1)
-!        ZLWFT(i,k+1)  = ZLWFT_i(i,klev+1-k)
-!        ZSWFT(i,k+1)  = ZSWFT_i(i,klev+1-k)
-         ZFLUP(i,k+1)  = ZFLUX_i(i,1,k+1)
-         ZFLDN(i,k+1)  = ZFLUX_i(i,2,k+1)
-         ZFLUP0(i,k+1) = ZFLUC_i(i,1,k+1)
-         ZFLDN0(i,k+1) = ZFLUC_i(i,2,k+1)
-         ZFSDN(i,k+1)  = ZFSDWN_i(i,k+1)*fract(i)
-         ZFSDN0(i,k+1) = ZFCDWN_i(i,k+1)*fract(i)
-         ZFSDNC0(i,k+1)= ZFCCDWN_i(i,k+1)*fract(i)
-         ZFSUP (i,k+1) = ZFSUP_i(i,k+1)*fract(i)
-         ZFSUP0(i,k+1) = ZFCUP_i(i,k+1)*fract(i)
-         ZFSUPC0(i,k+1)= ZFCCUP_i(i,k+1)*fract(i)
-         ZFLDNC0(i,k+1)= ZFLCCDWN_i(i,k+1)
-         ZFLUPC0(i,k+1)= ZFLCCUP_i(i,k+1)
-         IF(ok_volcan) THEN
-            ZSWADAERO(i,k+1)=ZSWADAERO(i,k+1)*fract(i) !--NL
-         ENDIF
-         
-!   Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32
-!   en sortie de radlsw.F90 - MPL 7.01.09
-         ZSWFT(i,k+1)  = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i)
-         ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i)
-!        WRITE(*,'("FSDN FSUP FCDN FCUP: ",4E12.5)') ZFSDWN_i(i,k+1),&
-!        ZFSUP_i(i,k+1),ZFCDWN_i(i,k+1),ZFCUP_i(i,k+1)
-         ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1)
-         ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1)
-!        print *,'FLUX2 FLUX1 FLUC2 FLUC1',ZFLUX_i(i,2,k+1),&
-!    & ZFLUX_i(i,1,k+1),ZFLUC_i(i,2,k+1),ZFLUC_i(i,1,k+1)
-         ENDDO
-      ENDDO
-
-!--ajout OB
-      ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:)
-      ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:)
-      ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:)
-      ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:)
-      ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:)
-      ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:)
-      ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:) 
-      ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:) 
-      ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:) 
-      ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:)
-      ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:)
-      ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:)
-
-!     print*,'SW_RRTM ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
-!     print*,'SW_RRTM ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
-!     print*,'SW_RRTM ZFSDN  1 , klev:',ZFSDN(1:klon,1),ZFSDN(1:klon,klev)
-!     print*,'SW_RRTM ZFSUP  1 , klev:',ZFSUP(1:klon,1),ZFSUP(1:klon,klev)	
-!     print*,'OK1'
-! ---------
-! ---------
-! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de
-! LW_LMDAR4 et SW_LMDAR4
-      DO i = 1, kdlon
-         zsolsw(i)    = ZSWFT(i,1)
-         zsolsw0(i)   = ZSWFT0_i(i,1)
-!        zsolsw0(i)   = ZFSDN0(i,1)     -ZFSUP0(i,1)
-         ztopsw(i)    = ZSWFT(i,klev+1)
-         ztopsw0(i)   = ZSWFT0_i(i,klev+1)
-!        ztopsw0(i)   = ZFSDN0(i,klev+1)-ZFSUP0(i,klev+1)
-!         
-!        zsollw(i)    = ZFLDN(i,1)      -ZFLUP(i,1)
-!        zsollw0(i)   = ZFLDN0(i,1)     -ZFLUP0(i,1)
-!        ztoplw(i)    = ZFLDN(i,klev+1) -ZFLUP(i,klev+1)
-!        ztoplw0(i)   = ZFLDN0(i,klev+1)-ZFLUP0(i,klev+1)
-         zsollw(i)    = ZLWFT(i,1)
-         zsollw0(i)   = ZLWFT0_i(i,1)
-         ztoplw(i)    = ZLWFT(i,klev+1)*(-1)
-         ztoplw0(i)   = ZLWFT0_i(i,klev+1)*(-1)
-!         
-           IF (fract(i) == 0.) THEN
-!!!!! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0
-! pas plus que dans le sw_AR4
-          zalbpla(i)   = 1.0e+39
-         ELSE
-          zalbpla(i)   = ZFSUP(i,klev+1)/ZFSDN(i,klev+1)
-         ENDIF
-!!! 5 juin 2015
-!!! Correction MP bug RRTM
-         zsollwdown(i)= -1.*ZFLDN(i,1)
-      ENDDO
-!     print*,'OK2'
-
-! extrait de SW_AR4
-!     DO k = 1, KFLEV
-!        kpl1 = k+1
-!        DO i = 1, KDLON
-!           PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k)) -(ZFSDN(i,k)-ZFSDN(i,kpl1))
-!           PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
-! ZLWFT(klon,k),ZSWFT
-
-      do k=1,kflev
-         do i=1,kdlon
-           zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k)
-           zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k)
-           zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
-           zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
-           IF(ok_volcan) THEN
-              zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL
-              zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL
-           ENDIF
-!          print *,'heat cool heat0 cool0 ',zheat(i,k),zcool(i,k),zheat0(i,k),zcool0(i,k)
-!	   ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k)
-!	   ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k)	   
-         enddo
-      enddo
-#else
-    abort_message="You should compile with -rrtm if running with iflag_rrtm=1"
-    call abort_physic(modname, abort_message, 1)
-#endif
-    ENDIF ! iflag_rrtm
-!======================================================================
-
-    DO i = 1, kdlon
-      topsw(iof+i) = ztopsw(i)
-      toplw(iof+i) = ztoplw(i)
-      solsw(iof+i) = zsolsw(i)
-      sollw(iof+i) = zsollw(i)
-      sollwdown(iof+i) = zsollwdown(i)
-      DO k = 1, kflev+1
-        lwdn0 ( iof+i,k)   = ZFLDN0 ( i,k)
-        lwdn  ( iof+i,k)   = ZFLDN  ( i,k)
-        lwup0 ( iof+i,k)   = ZFLUP0 ( i,k)
-        lwup  ( iof+i,k)   = ZFLUP  ( i,k)
-      ENDDO
-      topsw0(iof+i) = ztopsw0(i)
-      toplw0(iof+i) = ztoplw0(i)
-      solsw0(iof+i) = zsolsw0(i)
-      sollw0(iof+i) = zsollw0(i)
-      albpla(iof+i) = zalbpla(i)
-
-      DO k = 1, kflev+1
-        swdnc0( iof+i,k)   = ZFSDNC0( i,k)
-        swdn0 ( iof+i,k)   = ZFSDN0 ( i,k)
-        swdn  ( iof+i,k)   = ZFSDN  ( i,k)
-        swupc0( iof+i,k)   = ZFSUPC0( i,k)
-        swup0 ( iof+i,k)   = ZFSUP0 ( i,k)
-        swup  ( iof+i,k)   = ZFSUP  ( i,k)
-        lwdnc0( iof+i,k)   = ZFLDNC0( i,k)
-        lwupc0( iof+i,k)   = ZFLUPC0( i,k)
-      ENDDO
-    ENDDO
-    !-transform the aerosol forcings, if they have
-    ! to be calculated
-    IF (ok_ade) THEN
-        DO i = 1, kdlon
-          topswad_aero(iof+i) = ztopswadaero(i)
-          topswad0_aero(iof+i) = ztopswad0aero(i)
-          solswad_aero(iof+i) = zsolswadaero(i)
-          solswad0_aero(iof+i) = zsolswad0aero(i)
-! MS the following lines seem to be wrong, why is iof on right hand side???
-!          topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
-!          topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
-!          solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
-!          solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
-          topsw_aero(iof+i,:) = ztopsw_aero(i,:)
-          topsw0_aero(iof+i,:) = ztopsw0_aero(i,:)
-          solsw_aero(iof+i,:) = zsolsw_aero(i,:)
-          solsw0_aero(iof+i,:) = zsolsw0_aero(i,:)
-          topswcf_aero(iof+i,:) = ztopswcf_aero(i,:)
-          solswcf_aero(iof+i,:) = zsolswcf_aero(i,:)   
-          !-LW
-          toplwad_aero(iof+i) = ztoplwadaero(i)
-          toplwad0_aero(iof+i) = ztoplwad0aero(i)
-          sollwad_aero(iof+i) = zsollwadaero(i)
-          sollwad0_aero(iof+i) = zsollwad0aero(i)    
-        ENDDO
-    ELSE
-        DO i = 1, kdlon
-          topswad_aero(iof+i) = 0.0
-          solswad_aero(iof+i) = 0.0
-          topswad0_aero(iof+i) = 0.0
-          solswad0_aero(iof+i) = 0.0
-          topsw_aero(iof+i,:) = 0.
-          topsw0_aero(iof+i,:) =0.
-          solsw_aero(iof+i,:) = 0.
-          solsw0_aero(iof+i,:) = 0.
-          !-LW
-          toplwad_aero(iof+i) = 0.0
-          sollwad_aero(iof+i) = 0.0
-          toplwad0_aero(iof+i) = 0.0
-          sollwad0_aero(iof+i) = 0.0
-        ENDDO
-    ENDIF
-    IF (ok_aie) THEN
-        DO i = 1, kdlon
-          topswai_aero(iof+i) = ztopswaiaero(i)
-          solswai_aero(iof+i) = zsolswaiaero(i)
-          !-LW
-          toplwai_aero(iof+i) = ztoplwaiaero(i)
-          sollwai_aero(iof+i) = zsollwaiaero(i)
-        ENDDO
-    ELSE
-        DO i = 1, kdlon
-          topswai_aero(iof+i) = 0.0
-          solswai_aero(iof+i) = 0.0
-          !-LW
-          toplwai_aero(iof+i) = 0.0
-          sollwai_aero(iof+i) = 0.0
-        ENDDO
-    ENDIF
-    DO k = 1, kflev
-      DO i = 1, kdlon
-        !        scale factor to take into account the difference between
-        !        dry air and watter vapour scpecifi! heat capacity
-        zznormcp=1.0+RVTMP2*PWV(i,k)
-        heat(iof+i,k) = zheat(i,k)/zznormcp
-        cool(iof+i,k) = zcool(i,k)/zznormcp
-        heat0(iof+i,k) = zheat0(i,k)/zznormcp
-        cool0(iof+i,k) = zcool0(i,k)/zznormcp
-        IF(ok_volcan) THEN !NL
-           heat_volc(iof+i,k) = zheat_volc(i,k)/zznormcp
-           cool_volc(iof+i,k) = zcool_volc(i,k)/zznormcp
-        ENDIF
-      ENDDO
-    ENDDO
-
- ENDDO ! j = 1, nb_gr
-
-END SUBROUTINE radlwsw
-
-end module radlwsw_m
+link ../phylmd/radlwsw_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/radopt.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/radopt.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/radopt.h	(revision 3940)
@@ -1,9 +1,1 @@
-!
-! $Header$
-!
-      LOGICAL LEVOIGT
-      PARAMETER (LEVOIGT=.FALSE.)
-      INTEGER NOVLP
-      PARAMETER (NOVLP=1)
-      INTEGER KAER
-      PARAMETER (KAER=0)
+link ../phylmd/radopt.h
Index: LMDZ6/trunk/libf/phylmdiso/ran0_vec.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ran0_vec.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ran0_vec.F90	(revision 3940)
@@ -1,34 +1,1 @@
-
-! $Header$
-
-SUBROUTINE ran0_vec(npoints, idum, ran0)
-
-  ! $Id: ran0_vec.F90 1992 2014-03-05 13:19:12Z lguez $
-  ! Platform independent random number generator from
-  ! Numerical Recipies
-  ! Mark Webb July 1999
-
-  IMPLICIT NONE
-
-  INTEGER j, npoints, idum(npoints), ia, im, iq, ir, k(npoints)
-  REAL ran0(npoints), am
-
-  PARAMETER (ia=16807, im=2147483647, am=1.0/im, iq=127773, ir=2836)
-
-  ! do j=1,npoints
-  ! if (idum(j).eq.0) then
-  ! write(6,*) 'idum=',idum
-  ! write(6,*) 'ZERO seed not allowed'
-  ! stop
-  ! endif
-  ! enddo
-
-  DO j = 1, npoints
-    k(j) = idum(j)/iq
-    idum(j) = ia*(idum(j)-k(j)*iq) - ir*k(j)
-    IF (idum(j)<0) idum(j) = idum(j) + im
-    ran0(j) = am*idum(j)
-  END DO
-
-END SUBROUTINE ran0_vec
-
+link ../phylmd/ran0_vec.F90
Index: LMDZ6/trunk/libf/phylmdiso/read_map2D.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/read_map2D.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/read_map2D.F90	(revision 3940)
@@ -1,79 +1,1 @@
-SUBROUTINE read_map2D(filename, varname, timestep, inverse, varout)
-! Open file and read one variable for one timestep.
-! Return variable for the given timestep. 
-  USE dimphy
-  USE netcdf
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-  USE print_control_mod, ONLY: lunout
-
-  IMPLICIT NONE
-
-! Input arguments
-  CHARACTER(len=*), INTENT(IN)  :: filename     ! name of file to read
-  CHARACTER(len=*), INTENT(IN)  :: varname      ! name of variable in file
-  INTEGER, INTENT(IN)           :: timestep     ! actual timestep
-  LOGICAL, INTENT(IN)           :: inverse      ! TRUE if latitude needs to be inversed
-! Output argument
-  REAL, DIMENSION(klon), INTENT(OUT) :: varout  ! The variable read from file for the given timestep
-
-! Local variables
-  INTEGER :: j
-  INTEGER :: nid, nvarid, ierr
-  INTEGER, DIMENSION(3) :: start, count
-  CHARACTER(len=20)     :: modname='read_map2D'
-
-  REAL, DIMENSION(nbp_lon,nbp_lat) :: var_glo2D     ! 2D global 
-  REAL, DIMENSION(nbp_lon,nbp_lat) :: var_glo2D_tmp ! 2D global
-  REAL, DIMENSION(klon_glo)        :: var_glo1D     ! 1D global
-
-! Read variable from file. Done by master process MPI and master thread OpenMP
-  IF (is_mpi_root .AND. is_omp_root) THEN
-     ierr = NF90_OPEN(trim(filename), NF90_NOWRITE, nid)
-     IF (ierr /= NF90_NOERR) CALL write_err_mess('Problem in opening file')
-
-     ierr = NF90_INQ_VARID(nid, trim(varname), nvarid)
-     IF (ierr /= NF90_NOERR) CALL write_err_mess('The variable is absent in file')
-     
-     start=(/1,1,timestep/)
-     count=(/nbp_lon,nbp_lat,1/)
-     ierr = NF90_GET_VAR(nid, nvarid, var_glo2D,start,count)
-     IF (ierr /= NF90_NOERR) CALL write_err_mess('Problem in reading varaiable')
-
-     ierr = NF90_CLOSE(nid)
-     IF (ierr /= NF90_NOERR) CALL write_err_mess('Problem in closing file')
-
-     ! Inverse latitude order
-     IF (inverse) THEN
-        var_glo2D_tmp(:,:) = var_glo2D(:,:)
-        DO j=1, nbp_lat
-           var_glo2D(:,j) = var_glo2D_tmp(:,nbp_lat-j+1)
-        END DO
-     END IF
-
-     ! Transform the global field from 2D to 1D
-     CALL grid2Dto1D_glo(var_glo2D,var_glo1D)
-
-     WRITE(lunout,*) 'in read_map2D, filename = ', trim(filename)
-     WRITE(lunout,*) 'in read_map2D, varname  = ', trim(varname)
-     WRITE(lunout,*) 'in read_map2D, timestep = ', timestep
-  ENDIF
-
-! Scatter gloabl 1D variable to all processes
-  CALL scatter(var_glo1D, varout)
-
-  CONTAINS
-    SUBROUTINE write_err_mess(err_mess)
-      USE print_control_mod, ONLY: lunout
-      IMPLICIT NONE
-      CHARACTER(len=*), INTENT(IN) :: err_mess
-      
-      WRITE(lunout,*) 'Error in read_map2D, filename = ', trim(filename)
-      WRITE(lunout,*) 'Error in read_map2D, varname  = ', trim(varname)
-      WRITE(lunout,*) 'Error in read_map2D, timestep = ', timestep
-
-      CALL abort_physic(modname, err_mess, 1)
-
-    END SUBROUTINE write_err_mess
-
-END SUBROUTINE read_map2D
+link ../phylmd/read_map2D.F90
Index: LMDZ6/trunk/libf/phylmdiso/read_pstoke.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/read_pstoke.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/read_pstoke.F90	(revision 3940)
@@ -1,518 +1,1 @@
-
-! $Id: read_pstoke.F90 2345 2015-08-21 09:57:36Z emillour $
-
-
-
-SUBROUTINE read_pstoke(irec, zrec, zklono, zklevo, airefi, phisfi, t, mfu, &
-    mfd, en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, &
-    frac_nucl, pyu1, pyv1, ftsol, psrf)
-
-  ! ******************************************************************************
-  ! Frederic HOURDIN, Abderrahmane IDELKADI
-  ! Lecture des parametres physique stockes online necessaires pour
-  ! recalculer offline le transport de traceurs sur une grille 2x plus fine
-  ! que
-  ! celle online
-  ! A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
-  ! ******************************************************************************
-
-  USE netcdf
-  USE dimphy
-  USE indice_sol_mod
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
-
-  IMPLICIT NONE
-
-  include "netcdf.inc"
-
-  INTEGER klono, klevo, imo, jmo
-!  PARAMETER (imo=iim/2, jmo=(jjm+1)/2)
-!  PARAMETER (klono=(jmo-1)*imo+2, klevo=llm)
-  REAL :: phisfi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !phisfi(klono)
-  REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(imo,jmo+1)
-  REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(imo, jmo+1)
-
-  REAL :: mfu(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfu(klono, klevo)
-  REAL :: mfd(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfd(klono, klevo)
-  REAL :: en_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_u(klono, klevo)
-  REAL :: de_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_u(klono, klevo)
-  REAL :: en_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_d(klono, klevo)
-  REAL :: de_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_d(klono, klevo)
-  REAL :: coefh(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !coefh(klono, klevo)
-  REAL :: fm_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !fm_therm(klono, klevo)
-  REAL :: en_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_therm(klono, klevo)
-
-  REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(imo, jmo+1, klevo)
-
-  REAL,ALLOCATABLE :: pl(:) !pl(klevo)
-  INTEGER irec
-  INTEGER xid, yid, zid, tid
-  REAL zrec, zklono, zklevo, zim, zjm
-  INTEGER ncrec, ncklono, ncklevo, ncim, ncjm
-
-  REAL :: airefi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !airefi(klono)
-  CHARACTER *20 namedim
-
-  ! !! attention !!
-  ! attention il y a aussi le pb de def klono
-  ! dim de phis??
-
-
-  REAL :: frac_impa(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_impa(klono, klevo)
-  REAL :: frac_nucl(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_nucl(klono, klevo)
-  REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(imo, jmo+1, klevo)
-  REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(imo, jmo+1, klevo)
-  REAL :: pyu1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyu1(klono)
-  REAL :: pyv1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyv1(klono)
-  REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(imo, jmo+1), pyv12(imo, jmo+1)
-  REAL :: ftsol(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !ftsol(klono, nbsrf)
-  REAL :: psrf(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !psrf(klono, nbsrf)
-  REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(klono), ftsol2(klono)
-  REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(klono), ftsol4(klono)
-  REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(klono), psrf2(klono)
-  REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(klono), psrf4(klono)
-  REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(imo, jmo+1)
-  REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(imo, jmo+1)
-  REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(imo, jmo+1)
-  REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(imo, jmo+1)
-  REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(imo, jmo+1)
-  REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(imo, jmo+1)
-  REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(imo, jmo+1)
-  REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(imo, jmo+1)
-  REAL :: t(((nbp_lon/2)-1)*(nbp_lat/2)+2,nbp_lev) !t(klono, klevo)
-  REAL,ALLOCATABLE :: t2(:,:,:) !t2(imo, jmo+1, klevo)
-  INTEGER,SAVE :: ncidp
-  INTEGER,SAVE :: varidt
-  INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu
-  INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn
-  INTEGER,SAVE :: varidfmth, varidenth
-  INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt
-  INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4
-  INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4
-
-  INTEGER l, i
-  INTEGER start(4), count(4), status
-  REAL rcode
-  LOGICAL,SAVE :: first=.TRUE.
-
-  ! Allocate arrays
-  imo=nbp_lon/2
-  jmo=nbp_lat/2
-  klono=(jmo-1)*imo+2
-  klevo=nbp_lev
-  
-  ALLOCATE(phisfi2(imo,jmo+1))
-  ALLOCATE(airefi2(imo, jmo+1))
-  ALLOCATE(mfu2(imo, jmo+1, klevo))
-  ALLOCATE(mfd2(imo, jmo+1, klevo))
-  ALLOCATE(en_u2(imo, jmo+1, klevo))
-  ALLOCATE(de_u2(imo, jmo+1, klevo))
-  ALLOCATE(en_d2(imo, jmo+1, klevo))
-  ALLOCATE(de_d2(imo, jmo+1, klevo))
-  ALLOCATE(coefh2(imo, jmo+1, klevo))
-  ALLOCATE(fm_therm2(imo, jmo+1, klevo))
-  ALLOCATE(en_therm2(imo, jmo+1, klevo))
-  ALLOCATE(pl(klevo))
-  ALLOCATE(frac_impa2(imo, jmo+1, klevo))
-  ALLOCATE(frac_nucl2(imo, jmo+1, klevo))
-  ALLOCATE(pyu12(imo, jmo+1), pyv12(imo, jmo+1))
-  ALLOCATE(ftsol1(klono), ftsol2(klono))
-  ALLOCATE(ftsol3(klono), ftsol4(klono))
-  ALLOCATE(psrf1(klono), psrf2(klono))
-  ALLOCATE(psrf3(klono), psrf4(klono))
-  ALLOCATE(ftsol12(imo, jmo+1))
-  ALLOCATE(ftsol22(imo, jmo+1))
-  ALLOCATE(ftsol32(imo, jmo+1))
-  ALLOCATE(ftsol42(imo, jmo+1))
-  ALLOCATE(psrf12(imo, jmo+1))
-  ALLOCATE(psrf22(imo, jmo+1))
-  ALLOCATE(psrf32(imo, jmo+1))
-  ALLOCATE(psrf42(imo, jmo+1))
-  ALLOCATE(t2(imo, jmo+1, klevo))
-
-  ! ---------------------------------------------
-  ! Initialisation de la lecture des fichiers
-  ! ---------------------------------------------
-
-  IF (irec==0) THEN
-
-    rcode = nf90_open('phystoke.nc', nf90_nowrite, ncidp)
-
-    rcode = nf90_inq_varid(ncidp, 'phis', varidps)
-    PRINT *, 'ncidp,varidps', ncidp, varidps
-
-    rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
-    PRINT *, 'ncidp,varidpl', ncidp, varidpl
-
-    rcode = nf90_inq_varid(ncidp, 'aire', varidai)
-    PRINT *, 'ncidp,varidai', ncidp, varidai
-
-    ! A FAIRE: Es-il necessaire de stocke t?
-    rcode = nf90_inq_varid(ncidp, 't', varidt)
-    PRINT *, 'ncidp,varidt', ncidp, varidt
-
-    rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
-    PRINT *, 'ncidp,varidmfu', ncidp, varidmfu
-
-    rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
-    PRINT *, 'ncidp,varidmfd', ncidp, varidmfd
-
-    rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
-    PRINT *, 'ncidp,varidenu', ncidp, varidenu
-
-    rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
-    PRINT *, 'ncidp,variddeu', ncidp, variddeu
-
-    rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
-    PRINT *, 'ncidp,varidend', ncidp, varidend
-
-    rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
-    PRINT *, 'ncidp,varidded', ncidp, varidded
-
-    rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
-    PRINT *, 'ncidp,varidch', ncidp, varidch
-
-    ! abder (pour thermiques)
-    rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
-    PRINT *, 'ncidp,varidfmth', ncidp, varidfmth
-
-    rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
-    PRINT *, 'ncidp,varidenth', ncidp, varidenth
-
-    rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
-    PRINT *, 'ncidp,varidfi', ncidp, varidfi
-
-    rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
-    PRINT *, 'ncidp,varidfn', ncidp, varidfn
-
-    rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
-    PRINT *, 'ncidp,varidyu1', ncidp, varidyu1
-
-    rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
-    PRINT *, 'ncidp,varidyv1', ncidp, varidyv1
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
-    PRINT *, 'ncidp,varidfts1', ncidp, varidfts1
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
-    PRINT *, 'ncidp,varidfts2', ncidp, varidfts2
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
-    PRINT *, 'ncidp,varidfts3', ncidp, varidfts3
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
-    PRINT *, 'ncidp,varidfts4', ncidp, varidfts4
-
-    rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
-    PRINT *, 'ncidp,varidpsr1', ncidp, varidpsr1
-
-    rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
-    PRINT *, 'ncidp,varidpsr2', ncidp, varidpsr2
-
-    rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
-    PRINT *, 'ncidp,varidpsr3', ncidp, varidpsr3
-
-    rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
-    PRINT *, 'ncidp,varidpsr4', ncidp, varidpsr4
-
-    ! ID pour les dimensions
-
-    status = nf_inq_dimid(ncidp, 'y', yid)
-    status = nf_inq_dimid(ncidp, 'x', xid)
-    status = nf_inq_dimid(ncidp, 'sig_s', zid)
-    status = nf_inq_dimid(ncidp, 'time_counter', tid)
-
-    ! lecture des dimensions
-
-    status = nf_inq_dim(ncidp, yid, namedim, ncjm)
-    status = nf_inq_dim(ncidp, xid, namedim, ncim)
-    status = nf_inq_dim(ncidp, zid, namedim, ncklevo)
-    status = nf_inq_dim(ncidp, tid, namedim, ncrec)
-
-    zrec = ncrec
-    zklevo = ncklevo
-    zim = ncim
-    zjm = ncjm
-
-    zklono = zim*(zjm-2) + 2
-
-    WRITE (*, *) 'read_pstoke : zrec = ', zrec
-    WRITE (*, *) 'read_pstoke : zklevo = ', zklevo
-    WRITE (*, *) 'read_pstoke : zim = ', zim
-    WRITE (*, *) 'read_pstoke : zjm = ', zjm
-    WRITE (*, *) 'read_pstoke : zklono = ', zklono
-
-    ! niveaux de pression
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpl, 1, zklevo, pl)
-#else
-    status = nf_get_vara_real(ncidp, varidpl, 1, zklevo, pl)
-#endif
-
-    ! lecture de aire et phis
-
-    start(1) = 1
-    start(2) = 1
-    start(3) = 1
-    start(4) = 0
-
-    count(1) = zim
-    count(2) = zjm
-    count(3) = 1
-    count(4) = 0
-
-    ! phis
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2)
-#else
-    status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, phisfi2, phisfi)
-
-    ! aire
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidai, start, count, airefi2)
-#else
-    status = nf_get_vara_real(ncidp, varidai, start, count, airefi2)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, airefi2, airefi)
-  ELSE
-
-    PRINT *, 'ok1'
-
-    ! ---------------------
-    ! lecture des champs
-    ! ---------------------
-
-    PRINT *, 'WARNING!!! Il n y a pas de test de coherence'
-    PRINT *, 'sur le nombre de niveaux verticaux dans le fichier nc'
-
-    start(1) = 1
-    start(2) = 1
-    start(3) = 1
-    start(4) = irec
-
-    count(1) = zim
-    count(2) = zjm
-    count(3) = zklevo
-    count(4) = 1
-
-
-    ! *** Lessivage******************************************************
-    ! frac_impa
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2)
-#else
-    status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, frac_impa2, frac_impa)
-
-    ! frac_nucl
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2)
-#else
-    status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, frac_nucl2, frac_nucl)
-
-    ! *** Temperature ******************************************************
-    ! abder t
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidt, start, count, t2)
-#else
-    status = nf_get_vara_real(ncidp, varidt, start, count, t2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, t2, t)
-
-    ! *** Flux pour le calcul de la convection TIEDTK ***********************
-    ! mfu
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2)
-#else
-    status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, mfu2, mfu)
-
-    ! mfd
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2)
-#else
-    status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, mfd2, mfd)
-
-    ! en_u
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2)
-#else
-    status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_u2, en_u)
-
-    ! de_u
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2)
-#else
-    status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, de_u2, de_u)
-
-    ! en_d
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidend, start, count, en_d2)
-#else
-    status = nf_get_vara_real(ncidp, varidend, start, count, en_d2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_d2, en_d)
-
-    ! de_d
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidded, start, count, de_d2)
-#else
-    status = nf_get_vara_real(ncidp, varidded, start, count, de_d2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, de_d2, de_d)
-
-    ! **** Coeffecient du mellange
-    ! turbulent**********************************
-    ! coefh
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidch, start, count, coefh2)
-#else
-    status = nf_get_vara_real(ncidp, varidch, start, count, coefh2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, coefh2, coefh)
-
-    ! *** Flux ascendant et entrant pour les
-    ! Thermiques************************
-    ! abder thermiques
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2)
-#else
-    status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, fm_therm2, fm_therm)
-
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2)
-#else
-    status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2)
-#endif
-    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_therm2, en_therm)
-
-    ! *** Vitesses aux sol
-    ! ******************************************************
-    start(3) = irec
-    start(4) = 0
-    count(3) = 1
-    count(4) = 0
-    ! pyu1
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12)
-#else
-    status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, pyu12, pyu1)
-
-    ! pyv1
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12)
-#else
-    status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, pyv12, pyv1)
-
-    ! *** Temperature au sol ********************************************
-    ! ftsol1
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12)
-#else
-    status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol12, ftsol1)
-
-    ! ftsol2
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22)
-#else
-    status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol22, ftsol2)
-
-    ! ftsol3
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32)
-#else
-    status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol32, ftsol3)
-
-    ! ftsol4
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42)
-#else
-    status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol42, ftsol4)
-
-    ! *** Nature du sol **************************************************
-    ! psrf1
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr1, start, count, psrf12)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf12, psrf1)
-
-    ! psrf2
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr2, start, count, psrf22)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf22, psrf2)
-
-    ! psrf3
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf32, psrf3)
-
-    ! psrf4
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42)
-#endif
-    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf42, psrf4)
-
-    DO i = 1, klono
-
-      psrf(i, 1) = psrf1(i)
-      psrf(i, 2) = psrf2(i)
-      psrf(i, 3) = psrf3(i)
-      psrf(i, 4) = psrf4(i)
-
-      ftsol(i, 1) = ftsol1(i)
-      ftsol(i, 2) = ftsol2(i)
-      ftsol(i, 3) = ftsol3(i)
-      ftsol(i, 4) = ftsol4(i)
-
-    END DO
-
-  END IF
-
-  RETURN
-
-END SUBROUTINE read_pstoke
-
+link ../phylmd/read_pstoke.F90
Index: LMDZ6/trunk/libf/phylmdiso/read_pstoke0.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/read_pstoke0.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/read_pstoke0.F90	(revision 3940)
@@ -1,536 +1,1 @@
-
-! $Id: read_pstoke0.F90 2345 2015-08-21 09:57:36Z emillour $
-
-
-
-SUBROUTINE read_pstoke0(irec, zrec, zkon, zkev, airefi, phisfi, t, mfu, mfd, &
-    en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, frac_nucl, &
-    pyu1, pyv1, ftsol, psrf)
-
-  ! ******************************************************************************
-  ! Frederic HOURDIN, Abderrahmane IDELKADI
-  ! Lecture des parametres physique stockes online necessaires pour
-  ! recalculer offline le transport des traceurs sur la meme grille que
-  ! online
-  ! A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
-  ! ******************************************************************************
-
-  USE netcdf
-  USE dimphy
-  USE indice_sol_mod
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
-
-  IMPLICIT NONE
-
-  include "netcdf.inc"
-
-  INTEGER kon, kev, zkon, zkev
-!  PARAMETER (kon=iim*(jjm-1)+2, kev=llm)
-  REAL :: phisfi(nbp_lon*(nbp_lat-2)+2) !phisfi(kon)
-  REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(nbp_lon, nbp_lat)
-
-  REAL :: mfu(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfu(kon, kev)
-  REAL :: mfd(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfd(kon, kev)
-  REAL :: en_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_u(kon, kev)
-  REAL :: de_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_u(kon, kev)
-  REAL :: en_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_d(kon, kev)
-  REAL :: de_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_d(kon, kev)
-  REAL :: coefh(nbp_lon*(nbp_lat-2)+2,nbp_lev) !coefh(kon, kev)
-
-  ! abd 25 11 02
-  ! Thermiques
-  REAL :: fm_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !fm_therm(kon, kev)
-  REAL :: en_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_therm(kon, kev)
-  REAL :: t(nbp_lon*(nbp_lat-2)+2,nbp_lev) !t(kon, kev)
-
-  REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: t2(:,:,:) !t2(nbp_lon, nbp_lat, kev)
-  ! Thermiques
-  REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(nbp_lon, nbp_lat, kev)
-
-  REAL,ALLOCATABLE :: pl(:) !pl(kev)
-  INTEGER irec
-  INTEGER xid, yid, zid, tid
-  INTEGER zrec, zim, zjm
-  INTEGER ncrec, nckon, nckev, ncim, ncjm
-
-  REAL :: airefi(nbp_lon*(nbp_lat-2)+2) !airefi(kon)
-  CHARACTER *20 namedim
-
-  ! !! attention !!
-  ! attention il y a aussi le pb de def kon
-  ! dim de phis??
-
-  REAL :: frac_impa(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_impa(kon, kev)
-  REAL :: frac_nucl(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_nucl(kon, kev)
-  REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(nbp_lon, nbp_lat, kev)
-  REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(nbp_lon, nbp_lat, kev)
-  REAL :: pyu1(nbp_lon*(nbp_lat-2)+2) !pyu1(kon)
-  REAL :: pyv1(nbp_lon*(nbp_lat-2)+2) !pyv1(kon)
-  REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat)
-  REAL :: ftsol(nbp_lon*(nbp_lat-2)+2,nbp_lev) !ftsol(kon, nbsrf)
-  REAL :: psrf(nbp_lon*(nbp_lat-2)+2,nbp_lev) !psrf(kon, nbsrf)
-  REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(kon), ftsol2(kon)
-  REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(kon), ftsol4(kon)
-  REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(kon), psrf2(kon)
-  REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(kon), psrf4(kon)
-  REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(nbp_lon, nbp_lat)
-  REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(nbp_lon, nbp_lat)
-
-  INTEGER,SAVE :: ncidp
-  INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu
-  INTEGER,SAVE :: varidt
-  INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn
-  ! therm
-  INTEGER,SAVE :: varidfmth, varidenth
-  INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt
-  INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4
-  INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4
-
-  INTEGER l, i
-  INTEGER start(4), count(4), status
-  REAL rcode
-  LOGICAL,SAVE :: first=.TRUE.
-
-  ! Allocate arrays
-  kon=nbp_lon*(nbp_lat-2)+2
-  kev=nbp_lev
-
-  ALLOCATE(phisfi2(nbp_lon, nbp_lat))
-  ALLOCATE(airefi2(nbp_lon, nbp_lat))
-  ALLOCATE(mfu2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(mfd2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(en_u2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(de_u2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(en_d2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(de_d2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(coefh2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(t2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(fm_therm2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(en_therm2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(pl(kev))
-  ALLOCATE(frac_impa2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(frac_nucl2(nbp_lon, nbp_lat, kev))
-  ALLOCATE(pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat))
-  ALLOCATE(ftsol1(kon), ftsol2(kon))
-  ALLOCATE(ftsol3(kon), ftsol4(kon))
-  ALLOCATE(psrf1(kon), psrf2(kon))
-  ALLOCATE(psrf3(kon), psrf4(kon))
-  ALLOCATE(ftsol12(nbp_lon, nbp_lat))
-  ALLOCATE(ftsol22(nbp_lon, nbp_lat))
-  ALLOCATE(ftsol32(nbp_lon, nbp_lat))
-  ALLOCATE(ftsol42(nbp_lon, nbp_lat))
-  ALLOCATE(psrf12(nbp_lon, nbp_lat))
-  ALLOCATE(psrf22(nbp_lon, nbp_lat))
-  ALLOCATE(psrf32(nbp_lon, nbp_lat))
-  ALLOCATE(psrf42(nbp_lon, nbp_lat))
-
-  ! ---------------------------------------------
-  ! Initialisation de la lecture des fichiers
-  ! ---------------------------------------------
-
-  IF (irec==0) THEN
-
-    rcode = nf90_open('phystoke.nc', nf90_nowrite, ncidp)
-
-    rcode = nf90_inq_varid(ncidp, 'phis', varidps)
-    PRINT *, 'ncidp,varidps', ncidp, varidps
-
-    rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
-    PRINT *, 'ncidp,varidpl', ncidp, varidpl
-
-    rcode = nf90_inq_varid(ncidp, 'aire', varidai)
-    PRINT *, 'ncidp,varidai', ncidp, varidai
-
-    rcode = nf90_inq_varid(ncidp, 't', varidt)
-    PRINT *, 'ncidp,varidt', ncidp, varidt
-
-    rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
-    PRINT *, 'ncidp,varidmfu', ncidp, varidmfu
-
-    rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
-    PRINT *, 'ncidp,varidmfd', ncidp, varidmfd
-
-    rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
-    PRINT *, 'ncidp,varidenu', ncidp, varidenu
-
-    rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
-    PRINT *, 'ncidp,variddeu', ncidp, variddeu
-
-    rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
-    PRINT *, 'ncidp,varidend', ncidp, varidend
-
-    rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
-    PRINT *, 'ncidp,varidded', ncidp, varidded
-
-    rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
-    PRINT *, 'ncidp,varidch', ncidp, varidch
-
-    ! Thermiques
-    rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
-    PRINT *, 'ncidp,varidfmth', ncidp, varidfmth
-
-    rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
-    PRINT *, 'ncidp,varidenth', ncidp, varidenth
-
-    rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
-    PRINT *, 'ncidp,varidfi', ncidp, varidfi
-
-    rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
-    PRINT *, 'ncidp,varidfn', ncidp, varidfn
-
-    rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
-    PRINT *, 'ncidp,varidyu1', ncidp, varidyu1
-
-    rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
-    PRINT *, 'ncidp,varidyv1', ncidp, varidyv1
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
-    PRINT *, 'ncidp,varidfts1', ncidp, varidfts1
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
-    PRINT *, 'ncidp,varidfts2', ncidp, varidfts2
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
-    PRINT *, 'ncidp,varidfts3', ncidp, varidfts3
-
-    rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
-    PRINT *, 'ncidp,varidfts4', ncidp, varidfts4
-
-    rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
-    PRINT *, 'ncidp,varidpsr1', ncidp, varidpsr1
-
-    rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
-    PRINT *, 'ncidp,varidpsr2', ncidp, varidpsr2
-
-    rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
-    PRINT *, 'ncidp,varidpsr3', ncidp, varidpsr3
-
-    rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
-    PRINT *, 'ncidp,varidpsr4', ncidp, varidpsr4
-
-    ! ID pour les dimensions
-
-    status = nf_inq_dimid(ncidp, 'y', yid)
-    status = nf_inq_dimid(ncidp, 'x', xid)
-    status = nf_inq_dimid(ncidp, 'sig_s', zid)
-    status = nf_inq_dimid(ncidp, 'time_counter', tid)
-
-    ! lecture des dimensions
-
-    status = nf_inq_dim(ncidp, yid, namedim, ncjm)
-    status = nf_inq_dim(ncidp, xid, namedim, ncim)
-    status = nf_inq_dim(ncidp, zid, namedim, nckev)
-    status = nf_inq_dim(ncidp, tid, namedim, ncrec)
-
-    zrec = ncrec
-    zkev = nckev
-    zim = ncim
-    zjm = ncjm
-
-    zkon = zim*(zjm-2) + 2
-
-    WRITE (*, *) 'read_pstoke : zrec = ', zrec
-    WRITE (*, *) 'read_pstoke : kev = ', zkev
-    WRITE (*, *) 'read_pstoke : zim = ', zim
-    WRITE (*, *) 'read_pstoke : zjm = ', zjm
-    WRITE (*, *) 'read_pstoke : kon = ', zkon
-
-    ! niveaux de pression
-
-    status = nf_get_vara_real(ncidp, varidpl, 1, kev, pl)
-
-    ! lecture de aire et phis
-
-    start(1) = 1
-    start(2) = 1
-    start(3) = 1
-    start(4) = 0
-
-    count(1) = zim
-    count(2) = zjm
-    count(3) = 1
-    count(4) = 0
-
-
-    ! **** Geopotentiel au sol ***************************************
-    ! phis
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2)
-#else
-    status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi)
-
-    ! **** Aires des mails aux sol ************************************
-    ! aire
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidai, start, count, airefi2)
-#else
-    status = nf_get_vara_real(ncidp, varidai, start, count, airefi2)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi)
-  ELSE
-
-    PRINT *, 'ok1'
-
-    ! ---------------------
-    ! lecture des champs
-    ! ---------------------
-
-    PRINT *, 'WARNING!!! Il n y a pas de test de coherence'
-    PRINT *, 'sur le nombre de niveaux verticaux dans le fichier nc'
-
-    start(1) = 1
-    start(2) = 1
-    start(3) = 1
-    start(4) = irec
-
-    count(1) = zim
-    count(2) = zjm
-    count(3) = kev
-    count(4) = 1
-
-    ! **** Temperature ********************************************
-    ! A FAIRE : Es-ce necessaire ?
-
-    ! abder t
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidt, start, count, t2)
-#else
-    status = nf_get_vara_real(ncidp, varidt, start, count, t2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t)
-
-    ! **** Flux pour la convection (Tiedtk)
-    ! ********************************************
-    ! mfu
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2)
-#else
-    status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu)
-
-    ! mfd
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2)
-#else
-    status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd)
-
-    ! en_u
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2)
-#else
-    status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u)
-
-    ! de_u
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2)
-#else
-    status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u)
-
-    ! en_d
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidend, start, count, en_d2)
-#else
-    status = nf_get_vara_real(ncidp, varidend, start, count, en_d2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d)
-
-    ! de_d
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidded, start, count, de_d2)
-#else
-    status = nf_get_vara_real(ncidp, varidded, start, count, de_d2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d)
-
-    ! **** Coefficient de mellange turbulent
-    ! *******************************************
-    ! coefh
-    PRINT *, 'LECTURE de coefh a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidch, start, count, coefh2)
-#else
-    status = nf_get_vara_real(ncidp, varidch, start, count, coefh2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh)
-    ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ   ')
-    ! call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ   ')
-
-    ! **** Flux ascendants et entrant dans le thermique
-    ! **********************************
-    ! Thermiques
-    PRINT *, 'LECTURE de fm_therm a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2)
-#else
-    status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm)
-    PRINT *, 'LECTURE de en_therm a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2)
-#else
-    status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm)
-
-    ! **** Coefficients de lessivage
-    ! *******************************************
-    ! frac_impa
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2)
-#else
-    status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa)
-
-    ! frac_nucl
-
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2)
-#else
-    status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2)
-#endif
-    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl)
-
-    ! **** Vents aux sol ********************************************
-
-    start(3) = irec
-    start(4) = 0
-    count(3) = 1
-    count(4) = 0
-
-    ! pyu1
-    PRINT *, 'LECTURE de yu1 a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12)
-#else
-    status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1)
-
-    ! pyv1
-    PRINT *, 'LECTURE de yv1 a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12)
-#else
-    status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1)
-
-    ! **** Temerature au sol ********************************************
-    ! ftsol1
-    PRINT *, 'LECTURE de ftsol1 a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12)
-#else
-    status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1)
-
-    ! ftsol2
-    PRINT *, 'LECTURE de ftsol2 a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22)
-#else
-    status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2)
-
-    ! ftsol3
-    PRINT *, 'LECTURE de ftsol3 a irec =', irec
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32)
-#else
-    status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3)
-
-    ! ftsol4
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42)
-#else
-    status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4)
-
-    ! **** Nature sol ********************************************
-    ! psrf1
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr1, start, count, psrf12)
-#endif
-    ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1)
-
-    ! psrf2
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr2, start, count, psrf22)
-#endif
-    ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2)
-
-    ! psrf3
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3)
-
-    ! psrf4
-#ifdef NC_DOUBLE
-    status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42)
-#else
-    status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42)
-#endif
-    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4)
-
-    DO i = 1, kon
-
-      psrf(i, 1) = psrf1(i)
-      psrf(i, 2) = psrf2(i)
-      psrf(i, 3) = psrf3(i)
-      ! test abderr
-      ! print*,'Dans read_pstoke psrf3 =',psrf3(i),i
-      psrf(i, 4) = psrf4(i)
-
-      ftsol(i, 1) = ftsol1(i)
-      ftsol(i, 2) = ftsol2(i)
-      ftsol(i, 3) = ftsol3(i)
-      ftsol(i, 4) = ftsol4(i)
-
-    END DO
-
-  END IF
-
-  RETURN
-
-END SUBROUTINE read_pstoke0
-
+link ../phylmd/read_pstoke0.F90
Index: LMDZ6/trunk/libf/phylmdiso/readaerosol_interp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/readaerosol_interp.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/readaerosol_interp.F90	(revision 3940)
@@ -1,579 +1,1 @@
-! $Id$
-!
-SUBROUTINE readaerosol_interp(id_aero, itap, pdtphys, r_day, first, pplay, paprs, t_seri, mass_out, pi_mass_out, load_src)
-!
-! This routine will return the mass concentration at actual day(mass_out) and 
-! the pre-industrial values(pi_mass_out) for aerosol corresponding to "id_aero".
-! The mass concentrations for all aerosols are saved in this routine but each
-! call to this routine only treats the aerosol "id_aero".
-!
-! 1) Read in data for the whole year, only at first time step
-! 2) Interpolate to the actual day, only at new day
-! 3) Interpolate to the model vertical grid (target grid), only at new day
-! 4) Test for negative mass values
-
-  USE ioipsl
-  USE dimphy, ONLY : klev,klon
-  USE mod_phys_lmdz_para, ONLY : mpi_rank  
-  USE readaerosol_mod
-  USE aero_mod, ONLY : naero_spc, name_aero
-  USE write_field_phy
-  USE phys_cal_mod
-  USE pres2lev_mod
-  USE print_control_mod, ONLY: lunout
-
-  IMPLICIT NONE
-
-  INCLUDE "YOMCST.h"
-  INCLUDE "chem.h"      
-  INCLUDE "clesphys.h"
-
-!
-! Input:
-!****************************************************************************************
-  INTEGER, INTENT(IN)                    :: id_aero! Identity number for the aerosol to treat
-  INTEGER, INTENT(IN)                    :: itap   ! Physic step count
-  REAL, INTENT(IN)                       :: pdtphys! Physic day step
-  REAL, INTENT(IN)                       :: r_day  ! Day of integration
-  LOGICAL, INTENT(IN)                    :: first  ! First model timestep 
-  REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay  ! pression at model mid-layers
-  REAL, DIMENSION(klon,klev+1),INTENT(IN):: paprs  ! pression between model layers
-  REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri ! air temperature
-!      
-! Output:      
-!****************************************************************************************
-  REAL, INTENT(OUT) :: mass_out(klon,klev)    ! Mass of aerosol (monthly mean data,from file) [ug AIBCM/m3]
-  REAL, INTENT(OUT) :: pi_mass_out(klon,klev) ! Mass of preindustrial aerosol (monthly mean data,from file) [ug AIBCM/m3]
-  REAL, INTENT(OUT) :: load_src(klon) ! Load of aerosol (monthly mean data,from file) [kg/m3]
-!      
-! Local Variables:
-!****************************************************************************************
-  INTEGER                         :: i, k, ierr
-  INTEGER                         :: iday, iyr, lmt_pas
-!  INTEGER                         :: im, day1, day2, im2
-  INTEGER                         :: im, im2
-  REAL                            :: day1, day2
-  INTEGER                         :: pi_klev_src ! Only for testing purpose
-  INTEGER, SAVE                   :: klev_src    ! Number of vertical levles in source field
-!$OMP THREADPRIVATE(klev_src)
-
-  REAL                              :: zrho      ! Air density [kg/m3]
-  REAL                              :: volm      ! Volyme de melange [kg/kg]
-  REAL, DIMENSION(klon)             :: psurf_day, pi_psurf_day
-  REAL, DIMENSION(klon)             :: pi_load_src  ! Mass load at source grid
-  REAL, DIMENSION(klon)             :: load_tgt, load_tgt_test
-  REAL, DIMENSION(klon,klev)        :: delp ! pressure difference in each model layer
-
-  REAL, ALLOCATABLE, DIMENSION(:,:)            :: pplay_src ! pression mid-layer at source levels
-  REAL, ALLOCATABLE, DIMENSION(:,:)            :: tmp1, tmp2  ! Temporary variables
-  REAL, ALLOCATABLE, DIMENSION(:,:,:,:), SAVE  :: var_year    ! VAR in right dimension for the total year
-  REAL, ALLOCATABLE, DIMENSION(:,:,:,:), SAVE  :: pi_var_year ! pre-industrial VAR, -"-
-!$OMP THREADPRIVATE(var_year,pi_var_year)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:),SAVE     :: var_day     ! VAR interpolated to the actual day and model grid
-  REAL, ALLOCATABLE, DIMENSION(:,:,:),SAVE     :: pi_var_day  ! pre-industrial VAR, -"-
-!$OMP THREADPRIVATE(var_day,pi_var_day)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE    :: psurf_year, pi_psurf_year ! surface pressure for the total year
-!$OMP THREADPRIVATE(psurf_year, pi_psurf_year)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE    :: load_year, pi_load_year   ! load in the column for the total year
-!$OMP THREADPRIVATE(load_year, pi_load_year)
-
-  REAL, DIMENSION(:,:,:), POINTER   :: pt_tmp      ! Pointer allocated in readaerosol
-  REAL, POINTER, DIMENSION(:), SAVE :: pt_ap, pt_b ! Pointer for describing the vertical levels 
-!$OMP THREADPRIVATE(pt_ap, pt_b)
-  INTEGER, SAVE                     :: nbr_tsteps ! number of time steps in file read
-  REAL, DIMENSION(14), SAVE         :: month_len, month_start, month_mid
-!$OMP THREADPRIVATE(nbr_tsteps, month_len, month_start, month_mid)
-  REAL                              :: jDay
-
-  LOGICAL            :: lnewday      ! Indicates if first time step at a new day
-  LOGICAL            :: OLDNEWDAY
-  LOGICAL,SAVE       :: vert_interp  ! Indicates if vertical interpolation will be done
-  LOGICAL,SAVE       :: debug=.FALSE.! Debugging in this subroutine
-!$OMP THREADPRIVATE(vert_interp, debug)
-  CHARACTER(len=8)      :: type
-  CHARACTER(len=8)      :: filename
-
-
-!****************************************************************************************
-! Initialization
-!
-!****************************************************************************************
-
-! Calculation to find if it is a new day
-
-  IF(mpi_rank == 0 .AND. debug )then
-     PRINT*,'CONTROL PANEL REGARDING TIME STEPING'
-  ENDIF
-
-  ! Use phys_cal_mod
-  iday= day_cur
-  iyr = year_cur
-  im  = mth_cur
-
-!  iday = INT(r_day)
-!  iyr  = iday/360
-!  iday = iday-iyr*360         ! day of the actual year
-!  iyr  = iyr + annee_ref      ! year of the run   
-!  im   = iday/30 +1           ! the actual month
-  CALL ymds2ju(iyr, im, iday, 0., jDay)
-!   CALL ymds2ju(iyr, im, iday-(im-1)*30, 0., jDay)
-
-
-  IF(MOD(itap-1,NINT(86400./pdtphys)) == 0)THEN
-     lnewday=.TRUE.
-  ELSE
-     lnewday=.FALSE.
-  ENDIF
-
-  IF(mpi_rank == 0 .AND. debug)then
-     ! 0.02 is about 0.5/24, namly less than half an hour
-     OLDNEWDAY = (r_day-REAL(iday) < 0.02)
-     ! Once per day, update aerosol fields
-     lmt_pas = NINT(86400./pdtphys)
-     PRINT*,'r_day-REAL(iday) =',r_day-REAL(iday) 
-     PRINT*,'itap =',itap
-     PRINT*,'pdtphys =',pdtphys
-     PRINT*,'lmt_pas =',lmt_pas
-     PRINT*,'iday =',iday
-     PRINT*,'r_day =',r_day
-     PRINT*,'day_cur =',day_cur
-     PRINT*,'mth_cur =',mth_cur
-     PRINT*,'year_cur =',year_cur
-     PRINT*,'NINT(86400./pdtphys) =',NINT(86400./pdtphys)
-     PRINT*,'MOD(0,1) =',MOD(0,1)
-     PRINT*,'lnewday =',lnewday
-     PRINT*,'OLDNEWDAY =',OLDNEWDAY
-  ENDIF
-
-  IF (.NOT. ALLOCATED(var_day)) THEN
-     ALLOCATE( var_day(klon, klev, naero_spc), stat=ierr)
-     IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 1',1)
-     ALLOCATE( pi_var_day(klon, klev, naero_spc), stat=ierr)
-     IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 2',1)
-
-     ALLOCATE( psurf_year(klon, 12, naero_spc), pi_psurf_year(klon, 12, naero_spc), stat=ierr)
-     IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 3',1)
-
-     ALLOCATE( load_year(klon, 12, naero_spc), pi_load_year(klon, 12, naero_spc), stat=ierr)
-     IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 4',1)
-
-     lnewday=.TRUE.
-
-     NULLIFY(pt_ap)
-     NULLIFY(pt_b)
-  ENDIF
-
-!****************************************************************************************
-! 1) Read in data : corresponding to the actual year and preindustrial data. 
-!    Only for the first day of the year.
-!
-!****************************************************************************************
-  IF ( (first .OR. iday==0) .AND. lnewday ) THEN 
-     NULLIFY(pt_tmp)
-
-     ! Reading values corresponding to the closest year taking into count the choice of aer_type. 
-     ! For aer_type=scenario interpolation between 2 data sets is done in readaerosol.
-     ! If aer_type=mix1, mix2 or mix3, the run type and file name depends on the aerosol.
-     IF (aer_type=='preind' .OR. aer_type=='actuel' .OR. aer_type=='annuel' .OR. aer_type=='scenario') THEN
-        ! Standard case
-        filename='aerosols'
-        type=aer_type
-     ELSE IF (aer_type == 'mix1') THEN
-        ! Special case using a mix of decenal sulfate file and annual aerosols(all aerosols except sulfate)
-        IF (name_aero(id_aero) == 'SO4') THEN
-           filename='so4.run '
-           type='scenario'
-        ELSE
-           filename='aerosols'
-           type='annuel'
-        ENDIF
-     ELSE  IF (aer_type == 'mix2') THEN
-        ! Special case using a mix of decenal sulfate file and natrual aerosols
-        IF (name_aero(id_aero) == 'SO4') THEN
-           filename='so4.run '
-           type='scenario'
-        ELSE
-           filename='aerosols'
-           type='preind'
-        ENDIF
-     ELSE  IF (aer_type == 'mix3') THEN
-        ! Special case using a mix of annual sulfate file and natrual aerosols
-        IF (name_aero(id_aero) == 'SO4') THEN
-           filename='aerosols'
-           type='annuel'
-        ELSE
-           filename='aerosols' 
-           type='preind'
-        ENDIF
-     ELSE
-        CALL abort_physic('readaerosol_interp', 'this aer_type not supported',1)
-     ENDIF
-
-     CALL readaerosol(name_aero(id_aero), type, filename, iyr, klev_src, pt_ap, pt_b, pt_tmp, &
-          psurf_year(:,:,id_aero), load_year(:,:,id_aero))
-     IF (.NOT. ALLOCATED(var_year)) THEN
-        ALLOCATE(var_year(klon, klev_src, 12, naero_spc), stat=ierr)
-        IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 5',1)
-     ENDIF
-     var_year(:,:,:,id_aero) = pt_tmp(:,:,:)
-
-     ! Reading values corresponding to the preindustrial concentrations.
-     type='preind'
-     CALL readaerosol(name_aero(id_aero), type, filename, iyr, pi_klev_src, pt_ap, pt_b, pt_tmp, &
-          pi_psurf_year(:,:,id_aero), pi_load_year(:,:,id_aero))
-
-     ! klev_src must be the same in both files. 
-     ! Also supposing pt_ap and pt_b to be the same in the 2 files without testing. 
-     IF (pi_klev_src /= klev_src) THEN
-        WRITE(lunout,*) 'Error! All forcing files for the same aerosol must have the same vertical dimension'
-        WRITE(lunout,*) 'Aerosol : ', name_aero(id_aero)
-        CALL abort_physic('readaerosol_interp','Differnt vertical axes in aerosol forcing files',1)
-     ENDIF
-
-     IF (.NOT. ALLOCATED(pi_var_year)) THEN
-        ALLOCATE(pi_var_year(klon, klev_src, 12, naero_spc), stat=ierr)
-        IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 6',1)
-     ENDIF
-     pi_var_year(:,:,:,id_aero) = pt_tmp(:,:,:)
-    
-     IF (debug) THEN
-        CALL writefield_phy('var_year_jan',var_year(:,:,1,id_aero),klev_src)
-        CALL writefield_phy('var_year_dec',var_year(:,:,12,id_aero),klev_src)
-        CALL writefield_phy('psurf_src',psurf_year(:,:,id_aero),1)
-        CALL writefield_phy('pi_psurf_src',pi_psurf_year(:,:,id_aero),1)
-        CALL writefield_phy('load_year_src',load_year(:,:,id_aero),1)
-        CALL writefield_phy('pi_load_year_src',pi_load_year(:,:,id_aero),1)
-     ENDIF
-
-     ! Pointer no more useful, deallocate. 
-     DEALLOCATE(pt_tmp)
-
-     ! Test if vertical interpolation will be needed.
-     IF (psurf_year(1,1,id_aero)==not_valid .OR. pi_psurf_year(1,1,id_aero)==not_valid ) THEN
-        ! Pressure=not_valid indicates old file format, see module readaerosol
-        vert_interp = .FALSE.
-
-        ! If old file format, both psurf_year and pi_psurf_year must be not_valid
-        IF (  psurf_year(1,1,id_aero) /= pi_psurf_year(1,1,id_aero) ) THEN
-           WRITE(lunout,*) 'Warning! All forcing files for the same aerosol must have the same structure'
-           CALL abort_physic('readaerosol_interp', 'The aerosol files have not the same format',1)
-        ENDIF
-        
-        IF (klev /= klev_src) THEN
-           WRITE(lunout,*) 'Old format of aerosol file do not allowed vertical interpolation'
-           CALL abort_physic('readaerosol_interp', 'Old aerosol file not possible',1)
-        ENDIF
-
-     ELSE 
-        vert_interp = .TRUE.
-     ENDIF
-
-!    Calendar initialisation
-!
-     DO i = 2, 13
-       month_len(i) = REAL(ioget_mon_len(year_cur, i-1))
-       CALL ymds2ju(year_cur, i-1, 1, 0.0, month_start(i))
-     ENDDO
-     month_len(1) = REAL(ioget_mon_len(year_cur-1, 12))
-     CALL ymds2ju(year_cur-1, 12, 1, 0.0, month_start(1))
-     month_len(14) = REAL(ioget_mon_len(year_cur+1, 1))
-     CALL ymds2ju(year_cur+1, 1, 1, 0.0, month_start(14))
-     month_mid(:) = month_start (:) + month_len(:)/2.
-     
-     if (debug) then
-       write(lunout,*)' month_len = ',month_len
-       write(lunout,*)' month_mid = ',month_mid
-     endif
-
-  ENDIF  ! IF ( (first .OR. iday==0) .AND. lnewday ) THEN 
-  
-!****************************************************************************************
-! - 2) Interpolate to the actual day.
-! - 3) Interpolate to the model vertical grid.
-!
-!****************************************************************************************
-
-  IF (lnewday) THEN ! only if new day
-!****************************************************************************************
-! 2) Interpolate to the actual day
-! 
-!****************************************************************************************
-    ! Find which months and days to use for time interpolation
-     nbr_tsteps = 12
-     IF (nbr_tsteps == 12) then
-       IF (jDay < month_mid(im+1)) THEN
-          im2=im-1
-          day2 = month_mid(im2+1)
-          day1 = month_mid(im+1)
-          IF (im2 <= 0) THEN
-             ! the month is january, thus the month before december
-             im2=12
-          ENDIF
-       ELSE
-          ! the second half of the month
-          im2=im+1
-          day1 = month_mid(im+1)
-          day2 = month_mid(im2+1)
-          IF (im2 > 12) THEN
-             ! the month is december, the following thus january
-             im2=1
-          ENDIF
-       ENDIF
-     ELSE IF (nbr_tsteps == 14) then
-       im = im + 1
-       IF (jDay < month_mid(im)) THEN
-          ! in the first half of the month use month before and actual month
-          im2=im-1
-          day2 = month_mid(im2)
-          day1 = month_mid(im)
-       ELSE
-          ! the second half of the month
-          im2=im+1
-          day1 = month_mid(im)
-          day2 = month_mid(im2)
-       ENDIF
-     ELSE
-       CALL abort_physic('readaerosol_interp', 'number of months undefined',1)
-     ENDIF
-     if (debug) then
-       write(lunout,*)' jDay, day1, day2, im, im2 = ', jDay, day1, day2, im, im2
-     endif
-
- 
-     ! Time interpolation, still on vertical source grid
-     ALLOCATE(tmp1(klon,klev_src), tmp2(klon,klev_src),stat=ierr)
-     IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 7',1)
-
-     ALLOCATE(pplay_src(klon,klev_src), stat=ierr)
-     IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 8',1)
-     
-
-     DO k=1,klev_src
-        DO i=1,klon 
-           tmp1(i,k) = &
-                var_year(i,k,im2,id_aero) - (jDay-day2)/(day1-day2) * &
-                (var_year(i,k,im2,id_aero) - var_year(i,k,im,id_aero))
-           
-           tmp2(i,k) = &
-                pi_var_year(i,k,im2,id_aero) - (jDay-day2)/(day1-day2) * &
-                (pi_var_year(i,k,im2,id_aero) - pi_var_year(i,k,im,id_aero))
-        ENDDO
-     ENDDO
-
-     ! Time interpolation for pressure at surface, still on vertical source grid
-     DO i=1,klon 
-        psurf_day(i) = &
-             psurf_year(i,im2,id_aero) - (jDay-day2)/(day1-day2) * &
-             (psurf_year(i,im2,id_aero) - psurf_year(i,im,id_aero))
-        
-        pi_psurf_day(i) = &
-             pi_psurf_year(i,im2,id_aero) - (jDay-day2)/(day1-day2) * &
-             (pi_psurf_year(i,im2,id_aero) - pi_psurf_year(i,im,id_aero))
-     ENDDO
-
-     ! Time interpolation for the load, still on vertical source grid
-     DO i=1,klon 
-        load_src(i) = &
-             load_year(i,im2,id_aero) - (jDay-day2)/(day1-day2) * &
-             (load_year(i,im2,id_aero) - load_year(i,im,id_aero))
-        
-        pi_load_src(i) = &
-             pi_load_year(i,im2,id_aero) - (jDay-day2)/(day1-day2) * &
-             (pi_load_year(i,im2,id_aero) - pi_load_year(i,im,id_aero))
-     ENDDO
-
-!****************************************************************************************
-! 3) Interpolate to the model vertical grid (target grid)
-!
-!****************************************************************************************
-
-     IF (vert_interp) THEN
-
-        ! - Interpolate variable tmp1 (on source grid) to var_day (on target grid)
-        !********************************************************************************
-        ! a) calculate pression at vertical levels for the source grid using the
-        !    hybrid-sigma coordinates ap and b and the surface pressure, variables from file.
-        DO k = 1, klev_src
-           DO i = 1, klon
-              pplay_src(i,k)= pt_ap(k) + pt_b(k)*psurf_day(i)
-           ENDDO
-        ENDDO
-        
-        IF (debug) THEN
-           CALL writefield_phy('psurf_day_src',psurf_day(:),1)
-           CALL writefield_phy('pplay_src',pplay_src(:,:),klev_src)
-           CALL writefield_phy('pplay',pplay(:,:),klev)
-           CALL writefield_phy('day_src',tmp1,klev_src)
-           CALL writefield_phy('pi_day_src',tmp2,klev_src)
-        ENDIF
-
-        ! b) vertical interpolation on pressure leveles
-        CALL pres2lev(tmp1(:,:), var_day(:,:,id_aero), klev_src, klev, pplay_src, pplay, &
-             1, klon, .FALSE.)
-        
-        IF (debug) CALL writefield_phy('day_tgt',var_day(:,:,id_aero),klev)
-        
-        ! c) adjust to conserve total aerosol mass load in the vertical pillar
-        !    Calculate the load in the actual pillar and compare with the load
-        !    read from aerosol file.
-        
-        ! Find the pressure difference in each model layer
-        DO k = 1, klev
-           DO i = 1, klon
-              delp(i,k) = paprs(i,k) - paprs (i,k+1)
-           ENDDO
-        ENDDO
-
-        ! Find the mass load in the actual pillar, on target grid
-        load_tgt(:) = 0.
-        DO k= 1, klev
-           DO i = 1, klon
-              zrho = pplay(i,k)/t_seri(i,k)/RD       ! [kg/m3]
-              volm = var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
-              load_tgt(i) = load_tgt(i) + volm *delp(i,k)/RG
-           ENDDO
-        ENDDO
-        
-        ! Adjust, uniform
-        DO k = 1, klev
-           DO i = 1, klon
-              var_day(i,k,id_aero) = var_day(i,k,id_aero)*load_src(i)/max(1.e-30,load_tgt(i))
-           ENDDO
-        ENDDO
-        
-        IF (debug) THEN
-           load_tgt_test(:) = 0.
-           DO k= 1, klev
-              DO i = 1, klon
-                 zrho = pplay(i,k)/t_seri(i,k)/RD       ! [kg/m3]
-                 volm = var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
-                 load_tgt_test(i) = load_tgt_test(i) + volm*delp(i,k)/RG
-              ENDDO
-           ENDDO
-           
-           CALL writefield_phy('day_tgt2',var_day(:,:,id_aero),klev)
-           CALL writefield_phy('load_tgt',load_tgt(:),1)
-           CALL writefield_phy('load_tgt_test',load_tgt_test(:),1)
-           CALL writefield_phy('load_src',load_src(:),1)
-        ENDIF
-
-        ! - Interpolate variable tmp2 (source grid) to pi_var_day (target grid)
-        !********************************************************************************
-        ! a) calculate pression at vertical levels at source grid    
-        DO k = 1, klev_src
-           DO i = 1, klon
-              pplay_src(i,k)= pt_ap(k) + pt_b(k)*pi_psurf_day(i)
-           ENDDO
-        ENDDO
-
-        IF (debug) THEN
-           CALL writefield_phy('pi_psurf_day_src',pi_psurf_day(:),1)
-           CALL writefield_phy('pi_pplay_src',pplay_src(:,:),klev_src)
-        ENDIF
-
-        ! b) vertical interpolation on pressure leveles
-        CALL pres2lev(tmp2(:,:), pi_var_day(:,:,id_aero), klev_src, klev, pplay_src, pplay, &
-             1, klon, .FALSE.)
-
-        IF (debug) CALL writefield_phy('pi_day_tgt',pi_var_day(:,:,id_aero),klev)
-
-        ! c) adjust to conserve total aerosol mass load in the vertical pillar
-        !    Calculate the load in the actual pillar and compare with the load
-        !    read from aerosol file.
-
-        ! Find the load in the actual pillar, on target grid
-        load_tgt(:) = 0.
-        DO k = 1, klev
-           DO i = 1, klon
-              zrho = pplay(i,k)/t_seri(i,k)/RD          ! [kg/m3]
-              volm = pi_var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
-              load_tgt(i) = load_tgt(i) + volm*delp(i,k)/RG
-           ENDDO
-        ENDDO
-
-        DO k = 1, klev
-           DO i = 1, klon
-              pi_var_day(i,k,id_aero) = pi_var_day(i,k,id_aero)*pi_load_src(i)/max(1.e-30,load_tgt(i))
-           ENDDO
-        ENDDO
-
-        IF (debug) THEN
-           load_tgt_test(:) = 0.
-           DO k = 1, klev
-              DO i = 1, klon
-                 zrho = pplay(i,k)/t_seri(i,k)/RD          ! [kg/m3]
-                 volm = pi_var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
-                 load_tgt_test(i) = load_tgt_test(i) + volm*delp(i,k)/RG
-              ENDDO
-           ENDDO
-           CALL writefield_phy('pi_day_tgt2',pi_var_day(:,:,id_aero),klev)
-           CALL writefield_phy('pi_load_tgt',load_tgt(:),1)
-           CALL writefield_phy('pi_load_tgt_test',load_tgt_test(:),1)
-           CALL writefield_phy('pi_load_src',pi_load_src(:),1)
-        ENDIF
-
-
-     ELSE   ! No vertical interpolation done
-
-        var_day(:,:,id_aero)    = tmp1(:,:)
-        pi_var_day(:,:,id_aero) = tmp2(:,:)
-
-     ENDIF ! vert_interp
-
-
-     ! Deallocation
-     DEALLOCATE(tmp1, tmp2, pplay_src, stat=ierr)
-
-!****************************************************************************************
-! 4) Test for negative mass values
-!
-!****************************************************************************************
-     IF (MINVAL(var_day(:,:,id_aero)) < 0.) THEN
-        DO k=1,klev
-           DO i=1,klon 
-              ! Test for var_day
-              IF (var_day(i,k,id_aero) < 0.) THEN
-                 IF (jDay-day2 < 0.) WRITE(lunout,*) 'jDay-day2=',jDay-day2
-                 IF (var_year(i,k,im2,id_aero) - var_year(i,k,im,id_aero) < 0.) THEN
-                    WRITE(lunout,*) trim(name_aero(id_aero)),'(i,k,im2)-', &
-                         trim(name_aero(id_aero)),'(i,k,im)=',           &
-                         var_year(i,k,im2,id_aero) - var_year(i,k,im,id_aero)
-                 ENDIF
-                 WRITE(lunout,*) 'stop for aerosol : ',name_aero(id_aero)
-                 WRITE(lunout,*) 'day1, day2, jDay = ', day1, day2, jDay 
-                 CALL abort_physic('readaerosol_interp','Error in interpolation 1',1)
-              ENDIF
-           ENDDO 
-        ENDDO
-     ENDIF
-
-     IF (MINVAL(pi_var_day(:,:,id_aero)) < 0. ) THEN
-        DO k=1, klev
-           DO i=1,klon
-              ! Test for pi_var_day
-              IF (pi_var_day(i,k,id_aero) < 0.) THEN
-                 IF (jDay-day2 < 0.) WRITE(lunout,*) 'jDay-day2=',jDay-day2
-                 IF (pi_var_year(i,k,im2,id_aero) - pi_var_year(i,k,im,id_aero) < 0.) THEN
-                    WRITE(lunout,*) trim(name_aero(id_aero)),'(i,k,im2)-', &
-                         trim(name_aero(id_aero)),'(i,k,im)=',           &
-                         pi_var_year(i,k,im2,id_aero) - pi_var_year(i,k,im,id_aero)
-                 ENDIF
-                 
-                 WRITE(lunout,*) 'stop for aerosol : ',name_aero(id_aero)
-                 CALL abort_physic('readaerosol_interp','Error in interpolation 2',1)
-              ENDIF
-           ENDDO
-        ENDDO
-     ENDIF
-
-  ENDIF ! lnewday
-
-!****************************************************************************************
-! Copy output from saved variables
-!
-!****************************************************************************************
-
-  mass_out(:,:)    = var_day(:,:,id_aero) 
-  pi_mass_out(:,:) = pi_var_day(:,:,id_aero)
-  
-END SUBROUTINE readaerosol_interp
+link ../phylmd/readaerosol_interp.F90
Index: LMDZ6/trunk/libf/phylmdiso/readaerosol_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/readaerosol_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/readaerosol_mod.F90	(revision 3940)
@@ -1,739 +1,1 @@
-! $Id: readaerosol.F90 3436 2019-01-22 16:26:21Z emillour $
-!
-MODULE readaerosol_mod
-
-  REAL, SAVE :: not_valid=-333.
-  
-  INTEGER, SAVE :: nbp_lon_src
-!$OMP THREADPRIVATE(nbp_lon_src)  
-  INTEGER, SAVE :: nbp_lat_src
-!$OMP THREADPRIVATE(nbp_lat_src)  
-  REAL, ALLOCATABLE, SAVE    :: psurf_interp(:,:)
-!$OMP THREADPRIVATE(psurf_interp)  
-
-CONTAINS
-
-SUBROUTINE readaerosol(name_aero, type, filename, iyr_in, klev_src, pt_ap, pt_b, pt_out, psurf, load)
-
-!****************************************************************************************
-! This routine will read the aersosol from file. 
-!
-! Read a year data with get_aero_fromfile depending on aer_type : 
-! - actuel   : read year 1980
-! - preind   : read natural data
-! - scenario : read one or two years and do eventually linare time interpolation
-!
-! Return pointer, pt_out, to the year read or result from interpolation
-!****************************************************************************************
-  USE dimphy
-  USE print_control_mod, ONLY: lunout
-
-  IMPLICIT NONE
-
-  ! Input arguments
-  CHARACTER(len=7), INTENT(IN) :: name_aero
-  CHARACTER(len=*), INTENT(IN) :: type  ! actuel, annuel, scenario or preind
-  CHARACTER(len=8), INTENT(IN) :: filename
-  INTEGER, INTENT(IN)          :: iyr_in
-
-  ! Output
-  INTEGER, INTENT(OUT)            :: klev_src
-  REAL, POINTER, DIMENSION(:)     :: pt_ap        ! Pointer for describing the vertical levels      
-  REAL, POINTER, DIMENSION(:)     :: pt_b         ! Pointer for describing the vertical levels      
-  REAL, POINTER, DIMENSION(:,:,:) :: pt_out       ! The massvar distributions, DIMENSION(klon, klev_src, 12)
-  REAL, DIMENSION(klon,12), INTENT(OUT) :: psurf  ! Surface pression for 12 months
-  REAL, DIMENSION(klon,12), INTENT(OUT) :: load   ! Aerosol mass load in each column for 12 months
-
-  ! Local variables
-  CHARACTER(len=4)                :: cyear
-  REAL, POINTER, DIMENSION(:,:,:) :: pt_2
-  REAL, DIMENSION(klon,12)        :: psurf2, load2
-  INTEGER                         :: iyr1, iyr2, klev_src2
-  INTEGER                         :: it, k, i
-  LOGICAL, PARAMETER              :: lonlyone=.FALSE.
-
-!****************************************************************************************
-! Read data depending on aer_type
-!
-!****************************************************************************************
-
-  IF (type == 'actuel') THEN
-! Read and return data for year 1980
-!****************************************************************************************
-     cyear='1980'
-     ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
-     ! pt_out has dimensions (klon, klev_src, 12)
-     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
-     
-
-  ELSE IF (type == 'preind') THEN
-! Read and return data from file with suffix .nat
-!****************************************************************************************     
-     cyear='.nat'
-     ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
-     ! pt_out has dimensions (klon, klev_src, 12)
-     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
-     
-  ELSE IF (type == 'annuel') THEN
-! Read and return data from scenario annual files
-!****************************************************************************************     
-     WRITE(cyear,'(I4)') iyr_in
-     WRITE(lunout,*) 'get_aero 3 iyr_in=', iyr_in,'   ',cyear
-     ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 
-     ! pt_out has dimensions (klon, klev_src, 12)
-     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
-     
-  ELSE IF (type == 'scenario') THEN
-! Read data depending on actual year and interpolate if necessary
-!****************************************************************************************
-     IF (iyr_in .LT. 1850) THEN
-        cyear='.nat'
-        WRITE(lunout,*) 'get_aero 1 iyr_in=', iyr_in,'   ',cyear
-        ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
-        ! pt_out has dimensions (klon, klev_src, 12)
-        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
-        
-     ELSE IF (iyr_in .GE. 2100) THEN
-        cyear='2100'
-        WRITE(lunout,*) 'get_aero 2 iyr_in=', iyr_in,'   ',cyear
-        ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
-        ! pt_out has dimensions (klon, klev_src, 12)
-        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
-        
-     ELSE
-        ! Read data from 2 decades and interpolate to actual year
-        ! a) from actual 10-yr-period
-        IF (iyr_in.LT.1900) THEN
-           iyr1 = 1850
-           iyr2 = 1900
-        ELSE IF (iyr_in.GE.1900.AND.iyr_in.LT.1920) THEN
-           iyr1 = 1900
-           iyr2 = 1920
-        ELSE 
-           iyr1 = INT(iyr_in/10)*10
-           iyr2 = INT(1+iyr_in/10)*10
-        ENDIF
-        
-        WRITE(cyear,'(I4)') iyr1
-        WRITE(lunout,*) 'get_aero 3 iyr_in=', iyr_in,'   ',cyear
-        ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
-        ! pt_out has dimensions (klon, klev_src, 12)
-        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
-        
-        ! If to read two decades:
-        IF (.NOT.lonlyone) THEN 
-           
-           ! b) from the next following one
-           WRITE(cyear,'(I4)') iyr2
-           WRITE(lunout,*) 'get_aero 4 iyr_in=', iyr_in,'   ',cyear
-           
-           NULLIFY(pt_2)
-           ! get_aero_fromfile returns pt_2 allocated and initialized with data for 12 month 
-           ! pt_2 has dimensions (klon, klev_src, 12)
-           CALL get_aero_fromfile(name_aero, cyear, filename, klev_src2, pt_ap, pt_b, pt_2, psurf2, load2)
-           ! Test for same number of vertical levels
-           IF (klev_src /= klev_src2) THEN
-              WRITE(lunout,*) 'Two aerosols files with different number of vertical levels is not allowded'
-              CALL abort_physic('readaersosol','Error in number of vertical levels',1)
-           END IF
-           
-           ! Linare interpolate to the actual year:
-           DO it=1,12
-              DO k=1,klev_src
-                 DO i = 1, klon
-                    pt_out(i,k,it) = &
-                         pt_out(i,k,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * &
-                         (pt_out(i,k,it) - pt_2(i,k,it))
-                 END DO
-              END DO
-
-              DO i = 1, klon
-                 psurf(i,it) = &
-                      psurf(i,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * &
-                      (psurf(i,it) - psurf2(i,it))
-
-                 load(i,it) = &
-                      load(i,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * &
-                      (load(i,it) - load2(i,it))
-              END DO
-           END DO
-
-           ! Deallocate pt_2 no more needed
-           DEALLOCATE(pt_2)
-           
-        END IF ! lonlyone
-     END IF ! iyr_in .LT. 1850
-
-  ELSE
-     WRITE(lunout,*)'This option is not implemented : aer_type = ', type,' name_aero=',name_aero
-     CALL abort_physic('readaerosol','Error : aer_type parameter not accepted',1)
-  END IF ! type
-
-
-END SUBROUTINE readaerosol
-
-
-  SUBROUTINE init_aero_fromfile(flag_aerosol)
-  USE netcdf
-  USE mod_phys_lmdz_para
-  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
-#ifdef CPP_XIOS
-  USE xios
-#endif
-  IMPLICIT NONE
-  INTEGER, INTENT(IN) :: flag_aerosol
-#ifdef CPP_XIOS
-  REAL,ALLOCATABLE :: lat_src(:)
-  REAL,ALLOCATABLE :: lon_src(:)
-  CHARACTER(LEN=*),PARAMETER :: file_aerosol='aerosols.nat.nc'
-  CHARACTER(LEN=*),PARAMETER :: file_so4='so4.nat.nc'
-  INTEGER :: klev_src
-  INTEGER :: ierr ,ncid, dimID, varid
-  REAL :: null_array(0)
-
-  IF (flag_aerosol>0 .AND. grid_type==unstructured) THEN
-  
-    IF (is_omp_root) THEN
-  
-      IF (is_mpi_root) THEN
-    
-        IF (nf90_open(TRIM(file_aerosol), NF90_NOWRITE, ncid) /= NF90_NOERR) THEN
-          CALL check_err( nf90_open(TRIM(file_so4), NF90_NOWRITE, ncid), "pb open "//trim(file_so4) )
-        ENDIF
-
-        ! Read and test longitudes
-        CALL check_err( nf90_inq_dimid(ncid, "lon", dimID),"pb inq dim lon") 
-        CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lon_src),"pb inq dim lon")
-        CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
-        ALLOCATE(lon_src(nbp_lon_src))
-        CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
-
-        ! Read and test latitudes
-        CALL check_err( nf90_inq_dimid(ncid, "lat", dimID),"pb inq dim lat") 
-        CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lat_src),"pb inq dim lat")
-        CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
-        ALLOCATE(lat_src(nbp_lat_src))
-        CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
-        IF (nf90_inq_dimid(ncid, 'lev', dimid) /= NF90_NOERR) THEN
-          IF (nf90_inq_dimid(ncid, 'presnivs', dimid)/= NF90_NOERR) THEN
-             CALL check_err(nf90_inq_dimid(ncid, 'PRESNIVS', dimid),'dimension lev,PRESNIVS or presnivs not in file')
-          ENDIF
-        ENDIF
-        CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),"pb inq dim for PRESNIVS or lev" )
-        CALL check_err( nf90_close(ncid),"pb in close" )   
-      ENDIF
-
-      CALL bcast_mpi(nbp_lat_src)
-      CALL bcast_mpi(nbp_lon_src)
-      CALL bcast_mpi(klev_src)
-
-      IF (is_mpi_root ) THEN
-        CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=nbp_lat_src, jbegin=0, latvalue_1d=lat_src)
-        CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=nbp_lon_src, ibegin=0, lonvalue_1d=lon_src)
-      ELSE
-        CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=0, jbegin=0, latvalue_1d=null_array )
-        CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=0, ibegin=0, lonvalue_1d=null_array)
-      ENDIF
-      CALL xios_set_axis_attr("axis_aerosol",n_glo=klev_src)
-      CALL xios_set_fieldgroup_attr("aerosols", enabled=.TRUE.)
-  
-    ENDIF
-    
-  ENDIF    
-#endif 
-  END SUBROUTINE init_aero_fromfile
-
-
-    
-
-  SUBROUTINE get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, pt_year, psurf_out, load_out)
-!****************************************************************************************
-! Read 12 month aerosol from file and distribute to local process on physical grid. 
-! Vertical levels, klev_src, may differ from model levels if new file format.
-!
-! For mpi_root and master thread :
-! 1) Open file 
-! 2) Find vertical dimension klev_src
-! 3) Read field month by month
-! 4) Close file  
-! 5) Transform the global field from 2D(nbp_lon,nbp_lat) to 1D(klon_glo)
-!     - Also the levels and the latitudes have to be inversed
-!
-! For all processes and threads :
-! 6) Scatter global field(klon_glo) to local process domain(klon)
-! 7) Test for negative values
-!****************************************************************************************
-
-    USE netcdf
-    USE dimphy
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon_=>nbp_lon, nbp_lat_=>nbp_lat, klon_glo, &
-                                 grid2Dto1D_glo, grid_type, unstructured
-    USE mod_phys_lmdz_para
-    USE iophy, ONLY : io_lon, io_lat
-    USE print_control_mod, ONLY: lunout
-#ifdef CPP_XIOS
-    USE xios
-#endif
-    IMPLICIT NONE
-      
-! Input argumets
-    CHARACTER(len=7), INTENT(IN)          :: varname
-    CHARACTER(len=4), INTENT(IN)          :: cyr
-    CHARACTER(len=8), INTENT(IN)          :: filename
-
-! Output arguments
-    INTEGER, INTENT(OUT)                  :: klev_src     ! Number of vertical levels in file
-    REAL, POINTER, DIMENSION(:)           :: pt_ap        ! Pointer for describing the vertical levels      
-    REAL, POINTER, DIMENSION(:)           :: pt_b         ! Pointer for describing the vertical levels      
-    REAL, POINTER, DIMENSION(:,:,:)       :: pt_year      ! Pointer-variabale from file, 12 month, grid : klon,klev_src
-    REAL, POINTER, DIMENSION(:,:,:)       :: pt_year_mpi  ! Pointer-variabale from file, 12 month, grid : klon,klev_src
-    REAL, DIMENSION(klon,12), INTENT(OUT) :: psurf_out    ! Surface pression for 12 months
-    REAL, DIMENSION(klon_mpi,12)          :: psurf_out_mpi    ! Surface pression for 12 months
-    REAL, DIMENSION(klon,12), INTENT(OUT) :: load_out     ! Aerosol mass load in each column
-    REAL, DIMENSION(klon_mpi,12)          :: load_out_mpi     ! Aerosol mass load in each column
-    INTEGER                               :: nbr_tsteps   ! number of month in file read
-
-! Local variables
-    CHARACTER(len=30)     :: fname
-    CHARACTER(len=30)     :: cvar
-    INTEGER               :: ncid, dimid, varid
-    INTEGER               :: imth, i, j, k, ierr
-    REAL                  :: npole, spole
-    REAL, ALLOCATABLE, DIMENSION(:,:,:)   :: varmth
-    REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: varyear       ! Global variable read from file, 12 month
-    REAL, ALLOCATABLE, DIMENSION(:,:,:)   :: varyear_glo1D !(klon_glo, klev_src, 12)
-    REAL, ALLOCATABLE, DIMENSION(:)       :: varktmp
-
-    REAL,  ALLOCATABLE                    :: psurf_glo2D(:,:,:)   ! Surface pression for 12 months on dynamics global grid
-    REAL, DIMENSION(klon_glo,12)          :: psurf_glo1D   ! -"- on physical global grid
-    REAL,  ALLOCATABLE                    :: load_glo2D(:,:,:)    ! Load for 12 months on dynamics global grid
-    REAL, DIMENSION(klon_glo,12)          :: load_glo1D    ! -"- on physical global grid
-    REAL, ALLOCATABLE, DIMENSION(:,:)     :: vartmp
-    REAL, ALLOCATABLE,DIMENSION(:)        :: lon_src              ! longitudes in file
-    REAL, ALLOCATABLE,DIMENSION(:)        :: lat_src, lat_src_inv ! latitudes in file
-    LOGICAL                               :: new_file             ! true if new file format detected
-    LOGICAL                               :: invert_lat           ! true if the field has to be inverted for latitudes
-    INTEGER                               :: nbp_lon, nbp_lat
-    LOGICAL,SAVE                          :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
-    
-    IF (grid_type==unstructured) THEN
-      nbp_lon=nbp_lon_src
-      nbp_lat=nbp_lat_src
-    ELSE
-      nbp_lon=nbp_lon_
-      nbp_lat=nbp_lat_
-    ENDIF
-    
-    IF (is_mpi_root) THEN
-    
-      ALLOCATE(psurf_glo2D(nbp_lon,nbp_lat,12))
-      ALLOCATE(load_glo2D(nbp_lon,nbp_lat,12))
-      ALLOCATE(vartmp(nbp_lon,nbp_lat))
-      ALLOCATE(lon_src(nbp_lon))
-      ALLOCATE(lat_src(nbp_lat))
-      ALLOCATE(lat_src_inv(nbp_lat))
-    ELSE
-      ALLOCATE(varyear(0,0,0,0))
-      ALLOCATE(psurf_glo2D(0,0,0))
-      ALLOCATE(load_glo2D(0,0,0))
-    ENDIF
-            
-    ! Deallocate pointers
-    IF (ASSOCIATED(pt_ap)) DEALLOCATE(pt_ap)
-    IF (ASSOCIATED(pt_b))  DEALLOCATE(pt_b)
-
-    IF (is_mpi_root .AND. is_omp_root) THEN
-
-! 1) Open file 
-!****************************************************************************************
-! Add suffix to filename
-       fname = trim(filename)//cyr//'.nc'
-  
-       WRITE(lunout,*) 'reading variable ',TRIM(varname),' in file ', TRIM(fname)
-       CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid), "pb open "//trim(fname) )
-
-
-       IF (grid_type/=unstructured) THEN
-
-! Test for equal longitudes and latitudes in file and model
-!****************************************************************************************
-       ! Read and test longitudes
-         CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
-         CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
-       
-         IF (maxval(ABS(lon_src - io_lon)) > 0.001) THEN
-            WRITE(lunout,*) 'Problem in longitudes read from file : ',TRIM(fname)
-            WRITE(lunout,*) 'longitudes in file ', TRIM(fname),' : ', lon_src
-            WRITE(lunout,*) 'longitudes in model :', io_lon
-          
-            CALL abort_physic('get_aero_fromfile', 'longitudes are not the same in file and model',1)
-         END IF
-
-         ! Read and test latitudes
-         CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
-         CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
-
-         ! Invert source latitudes
-         DO j = 1, nbp_lat
-            lat_src_inv(j) = lat_src(nbp_lat +1 -j)
-         END DO
-
-         IF (maxval(ABS(lat_src - io_lat)) < 0.001) THEN
-            ! Latitudes are the same
-            invert_lat=.FALSE.
-         ELSE IF (maxval(ABS(lat_src_inv - io_lat)) < 0.001) THEN
-            ! Inverted source latitudes correspond to model latitudes
-            WRITE(lunout,*) 'latitudes will be inverted for file : ',TRIM(fname)
-            invert_lat=.TRUE.
-         ELSE
-            WRITE(lunout,*) 'Problem in latitudes read from file : ',TRIM(fname)
-            WRITE(lunout,*) 'latitudes in file ', TRIM(fname),' : ', lat_src      
-            WRITE(lunout,*) 'latitudes in model :', io_lat
-            CALL abort_physic('get_aero_fromfile', 'latitudes do not correspond between file and model',1)
-         END IF
-       ENDIF
-
-! 2) Check if old or new file is avalabale.
-!    New type of file should contain the dimension 'lev'
-!    Old type of file should contain the dimension 'PRESNIVS'
-!****************************************************************************************
-       ierr = nf90_inq_dimid(ncid, 'lev', dimid) 
-       IF (ierr /= NF90_NOERR) THEN
-          ! Coordinate axe lev not found. Check for presnivs.
-          ierr = nf90_inq_dimid(ncid, 'presnivs', dimid) 
-          IF (ierr /= NF90_NOERR) THEN
-             ierr = nf90_inq_dimid(ncid, 'PRESNIVS', dimid)
-             IF (ierr /= NF90_NOERR) THEN
-                ! Dimension PRESNIVS not found either
-                CALL abort_physic('get_aero_fromfile', 'dimension lev,PRESNIVS or presnivs not in file',1)
-             ELSE 
-                ! Old file found
-                new_file=.FALSE.
-                WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will not be done'
-             END IF
-          ELSE
-             ! New file found
-             new_file=.TRUE.
-             WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will be done'
-          ENDIF
-       ELSE
-          ! New file found
-          new_file=.TRUE.
-          WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will be done'
-       END IF
-       
-! 2) Find vertical dimension klev_src
-!****************************************************************************************
-       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),"pb inq dim for PRESNIVS or lev" )
-       
-     ! Allocate variables depending on the number of vertical levels
-       ALLOCATE(varmth(nbp_lon,nbp_lat, klev_src), varyear(nbp_lon,nbp_lat, klev_src, 12), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 1',1)
-
-       ALLOCATE(pt_ap(klev_src), pt_b(klev_src), varktmp(klev_src), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 2',1)
-
-! 3) Read all variables from file
-!    There is 2 options for the file structure :
-!    new_file=TRUE  : read varyear, ps, pt_ap and pt_b
-!    new_file=FALSE : read varyear month by month
-!****************************************************************************************
-
-       IF (new_file) THEN
-! ++) Check number of month in file opened
-!**************************************************************************************************
-       ierr = nf90_inq_dimid(ncid, 'TIME',dimid)
-       if (ierr /= NF90_NOERR) THEN
-          ierr = nf90_inq_dimid(ncid, 'time_counter', dimid)
-       ENDIF
-       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps),"pb inq dim TIME or time_counter" )
-!       IF (nbr_tsteps /= 12 .AND. nbr_tsteps /= 14) THEN
-       IF (nbr_tsteps /= 12 ) THEN
-    CALL abort_physic('get_aero_fromfile', 'not the right number of months in aerosol file read (should be 12 for the moment)' &
-                     ,1)
-       ENDIF
-
-! ++) Read the aerosol concentration month by month and concatenate to total variable varyear
-!****************************************************************************************
-          ! Get variable id
-          !CALL check_err( nf90_inq_varid(ncid, TRIM(varname), varid),"pb inq var "//TRIM(varname) )
-          print *,'readaerosol ', TRIM(varname)
-          IF ( nf90_inq_varid(ncid, TRIM(varname), varid) /= NF90_NOERR ) THEN 
-            ! Variable is not there
-            WRITE(lunout,*) 'Attention '//TRIM(varname)//' is not in aerosol input file'
-            varyear(:,:,:,:)=0.0
-          ELSE 
-            ! Get the variable
-            CALL check_err( nf90_get_var(ncid, varid, varyear(:,:,:,:)),"pb get var "//TRIM(varname) )
-          ENDIF
-          
-! ++) Read surface pression, 12 month in one variable
-!****************************************************************************************
-          ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "ps", varid),"pb inq var ps" )
-          ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, psurf_glo2D),"pb get var ps" )
-          
-! ++) Read mass load, 12 month in one variable
-!****************************************************************************************
-          ! Get variable id
-          !CALL check_err( nf90_inq_varid(ncid, "load_"//TRIM(varname), varid) ,"pb inq var load_"//TRIM(varname))
-          IF ( nf90_inq_varid(ncid, "load_"//TRIM(varname), varid) /= NF90_NOERR ) THEN 
-            WRITE(lunout,*) 'Attention load_'//TRIM(varname)//' is not in aerosol input file'
-            load_glo2D(:,:,:)=0.0
-          ELSE
-            ! Get the variable
-            CALL check_err( nf90_get_var(ncid, varid, load_glo2D),"pb get var load_"//TRIM(varname) )
-          ENDIF
-          
-! ++) Read ap
-!****************************************************************************************
-          ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "ap", varid),"pb inq var ap" )
-          ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, pt_ap),"pb get var ap" )
-
-! ++) Read b
-!****************************************************************************************
-          ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "b", varid),"pb inq var b" )
-          ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, pt_b),"pb get var b" )
-
-          
-
-       ELSE  ! old file
-
-! ++) Read the aerosol concentration month by month and concatenate to total variable varyear
-!****************************************************************************************
-          DO imth=1, 12
-             IF (imth.EQ.1) THEN
-                cvar=TRIM(varname)//'JAN'
-             ELSE IF (imth.EQ.2) THEN
-                cvar=TRIM(varname)//'FEB'
-             ELSE IF (imth.EQ.3) THEN
-                cvar=TRIM(varname)//'MAR'
-             ELSE IF (imth.EQ.4) THEN
-                cvar=TRIM(varname)//'APR'
-             ELSE IF (imth.EQ.5) THEN
-                cvar=TRIM(varname)//'MAY'
-             ELSE IF (imth.EQ.6) THEN
-                cvar=TRIM(varname)//'JUN'
-             ELSE IF (imth.EQ.7) THEN
-                cvar=TRIM(varname)//'JUL'
-             ELSE IF (imth.EQ.8) THEN
-                cvar=TRIM(varname)//'AUG'
-             ELSE IF (imth.EQ.9) THEN
-                cvar=TRIM(varname)//'SEP'
-             ELSE IF (imth.EQ.10) THEN
-                cvar=TRIM(varname)//'OCT'
-             ELSE IF (imth.EQ.11) THEN
-                cvar=TRIM(varname)//'NOV'
-             ELSE IF (imth.EQ.12) THEN
-                cvar=TRIM(varname)//'DEC'
-             END IF
-             
-             ! Get variable id
-             CALL check_err( nf90_inq_varid(ncid, TRIM(cvar), varid),"pb inq var "//TRIM(cvar) )
-             
-             ! Get the variable
-             CALL check_err( nf90_get_var(ncid, varid, varmth),"pb get var "//TRIM(cvar) )
-             
-             ! Store in variable for the whole year
-             varyear(:,:,:,imth)=varmth(:,:,:)
-             
-          END DO
-          
-          ! Putting dummy 
-          psurf_glo2D(:,:,:) = not_valid
-          load_glo2D(:,:,:)  = not_valid
-          pt_ap(:) = not_valid
-          pt_b(:)  = not_valid
-
-       END IF
-
-! 4) Close file  
-!****************************************************************************************
-       CALL check_err( nf90_close(ncid),"pb in close" )
-     
-
-! 5) Transform the global field from 2D(nbp_lon,nbp_lat) to 1D(klon_glo)
-!****************************************************************************************
-! Test if vertical levels have to be inversed
-
-       IF ((pt_b(1) < pt_b(klev_src)) .OR. .NOT. new_file) THEN
-!          WRITE(lunout,*) 'Vertical axis in file ',TRIM(fname), ' needs to be inverted'
-!          WRITE(lunout,*) 'before pt_ap = ', pt_ap
-!          WRITE(lunout,*) 'before pt_b = ', pt_b
-          
-          ! Inverse vertical levels for varyear 
-          DO imth=1, 12
-             varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly
-             DO k=1, klev_src
-                DO j=1, nbp_lat
-                   DO i=1, nbp_lon
-                      varyear(i,j,k,imth) = varmth(i,j,klev_src+1-k)
-                   END DO
-                END DO
-             END DO
-          END DO
-           
-          ! Inverte vertical axes for pt_ap and pt_b
-          varktmp(:) = pt_ap(:)
-          DO k=1, klev_src
-             pt_ap(k) = varktmp(klev_src+1-k)
-          END DO
-
-          varktmp(:) = pt_b(:)
-          DO k=1, klev_src
-             pt_b(k) = varktmp(klev_src+1-k)
-          END DO
-          WRITE(lunout,*) 'after pt_ap = ', pt_ap
-          WRITE(lunout,*) 'after pt_b = ', pt_b
-
-       ELSE 
-          WRITE(lunout,*) 'Vertical axis in file ',TRIM(fname), ' is ok, no vertical inversion is done'
-          WRITE(lunout,*) 'pt_ap = ', pt_ap
-          WRITE(lunout,*) 'pt_b = ', pt_b
-       END IF
-
-
-       IF (grid_type/=unstructured) THEN
-  !     - Invert latitudes if necessary
-         DO imth=1, 12
-            IF (invert_lat) THEN
-
-               ! Invert latitudes for the variable
-               varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly
-               DO k=1,klev_src
-                  DO j=1,nbp_lat
-                     DO i=1,nbp_lon
-                        varyear(i,j,k,imth) = varmth(i,nbp_lat+1-j,k)
-                     END DO
-                  END DO
-               END DO
-             
-               ! Invert latitudes for surface pressure
-               vartmp(:,:) = psurf_glo2D(:,:,imth)
-               DO j=1,nbp_lat
-                  DO i=1,nbp_lon
-                     psurf_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)
-                  END DO
-               END DO
-             
-               ! Invert latitudes for the load
-               vartmp(:,:) = load_glo2D(:,:,imth)
-               DO j=1,nbp_lat
-                  DO i=1,nbp_lon
-                     load_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)
-                  END DO
-               END DO
-            END IF ! invert_lat
-             
-            ! Do zonal mead at poles and distribut at whole first and last latitude
-            DO k=1, klev_src
-               npole=0.  ! North pole, j=1
-               spole=0.  ! South pole, j=nbp_lat        
-               DO i=1,nbp_lon
-                  npole = npole + varyear(i,1,k,imth)
-                  spole = spole + varyear(i,nbp_lat,k,imth)
-               END DO
-               npole = npole/REAL(nbp_lon)
-               spole = spole/REAL(nbp_lon)
-               varyear(:,1,    k,imth) = npole
-               varyear(:,nbp_lat,k,imth) = spole
-            END DO
-         END DO ! imth
-       
-         ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr)
-         IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 3',1)
-       
-         ! Transform from 2D to 1D field
-         CALL grid2Dto1D_glo(varyear,varyear_glo1D)
-         CALL grid2Dto1D_glo(psurf_glo2D,psurf_glo1D)
-         CALL grid2Dto1D_glo(load_glo2D,load_glo1D)
-      
-      ENDIF
-      
-    ELSE
-        ALLOCATE(varyear_glo1D(0,0,0))        
-    END IF ! is_mpi_root .AND. is_omp_root
-
-!$OMP BARRIER
-  
-! 6) Distribute to all processes
-!    Scatter global field(klon_glo) to local process domain(klon)
-!    and distribute klev_src to all processes
-!****************************************************************************************
-
-    ! Distribute klev_src
-    CALL bcast(klev_src)
-
-    ! Allocate and distribute pt_ap and pt_b
-    IF (.NOT. ASSOCIATED(pt_ap)) THEN  ! if pt_ap is allocated also pt_b is allocated
-       ALLOCATE(pt_ap(klev_src), pt_b(klev_src), stat=ierr)
-       IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 4',1)
-    END IF
-    CALL bcast(pt_ap)
-    CALL bcast(pt_b)
-
-    ! Allocate space for output pointer variable at local process
-    IF (ASSOCIATED(pt_year)) DEALLOCATE(pt_year)
-    ALLOCATE(pt_year(klon, klev_src, 12), stat=ierr)
-    ALLOCATE(pt_year_mpi(klon_mpi, klev_src, 12), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 5',1)
-
-    IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
-      IF (is_omp_master) THEN
-        CALL xios_send_field(TRIM(varname)//"_in",varyear)
-        CALL xios_recv_field(TRIM(varname)//"_out",pt_year_mpi)
-        CALL xios_send_field("load_"//TRIM(varname)//"_in",load_glo2D)
-        CALL xios_recv_field("load_"//TRIM(varname)//"_out",load_out_mpi)
-        IF (first) THEN
-          ALLOCATE(psurf_interp(klon_mpi,12))
-          CALL xios_send_field("psurf_aerosol_in",psurf_glo2D)
-          CALL xios_recv_field("psurf_aerosol_out",psurf_interp)
-        ENDIF
-      ENDIF
-      CALL scatter_omp(pt_year_mpi,pt_year)
-      CALL scatter_omp(load_out_mpi,load_out)
-      CALL scatter_omp(psurf_interp,psurf_out)
-      first=.FALSE.
-#endif
-    ELSE
-      ! Scatter global field to local domain at local process
-      CALL scatter(varyear_glo1D, pt_year)
-      CALL scatter(psurf_glo1D, psurf_out)
-      CALL scatter(load_glo1D,  load_out)
-    ENDIF
-! 7) Test for negative values
-!****************************************************************************************
-    IF (MINVAL(pt_year) < 0.) THEN
-       WRITE(lunout,*) 'Warning! Negative values read from file :', fname
-    END IF
-
-  END SUBROUTINE get_aero_fromfile
-
-
-  SUBROUTINE check_err(status,text)
-    USE netcdf
-    USE print_control_mod, ONLY: lunout
-    IMPLICIT NONE
-
-    INTEGER, INTENT (IN) :: status
-    CHARACTER(len=*), INTENT (IN), OPTIONAL :: text
-
-    IF (status /= NF90_NOERR) THEN
-       WRITE(lunout,*) 'Error in get_aero_fromfile, netcdf error code = ',status
-       IF (PRESENT(text)) THEN
-          WRITE(lunout,*) 'Error in get_aero_fromfile : ',text
-       END IF
-       CALL abort_physic('get_aero_fromfile',trim(nf90_strerror(status)),1)
-    END IF
-
-  END SUBROUTINE check_err
-
-
-END MODULE readaerosol_mod
+link ../phylmd/readaerosol_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/readaerosol_optic.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/readaerosol_optic.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/readaerosol_optic.F90	(revision 3940)
@@ -1,220 +1,1 @@
-! $Id: readaerosol_optic.F90 3630 2020-02-10 10:04:40Z fairhead $
-!
-SUBROUTINE readaerosol_optic(debut, flag_aerosol, itap, rjourvrai, &
-     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
-     mass_solu_aero, mass_solu_aero_pi, &
-     tau_aero, piz_aero, cg_aero, &
-     tausum_aero, tau3d_aero )
-
-! This routine will :
-! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
-! 2) calculate the optical properties for the aerosols
-!
-  
-  USE dimphy
-  USE aero_mod
-  USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
-      concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
-      load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7
-  IMPLICIT NONE
-
-! Input arguments
-!****************************************************************************************
-  LOGICAL, INTENT(IN)                      :: debut
-  INTEGER, INTENT(IN)                      :: flag_aerosol
-  INTEGER, INTENT(IN)                      :: itap
-  REAL, INTENT(IN)                         :: rjourvrai
-  REAL, INTENT(IN)                         :: pdtphys
-  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
-  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
-  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
-  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
-  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
-
-! Output arguments
-!****************************************************************************************
-  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
-  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
-!  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
-!  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
-!--correction mini bug OB
-  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
-  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
-
-! Local variables
-!****************************************************************************************
-  REAL, DIMENSION(klon)        :: aerindex ! POLDER aerosol index 
-  REAL, DIMENSION(klon,klev)   :: sulfate  ! SO4 aerosol concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: bcsol    ! BC soluble concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: bcins    ! BC insoluble concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: pomsol   ! POM soluble concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: pomins   ! POM insoluble concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: cidust    ! DUST aerosol concentration  [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: sscoarse  ! SS Coarse concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: sssupco   ! SS Super Coarse concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: ssacu     ! SS Acumulation concentration [ug/m3]
-  REAL, DIMENSION(klon,klev)   :: sulfate_pi
-  REAL, DIMENSION(klon,klev)   :: bcsol_pi
-  REAL, DIMENSION(klon,klev)   :: bcins_pi
-  REAL, DIMENSION(klon,klev)   :: pomsol_pi
-  REAL, DIMENSION(klon,klev)   :: pomins_pi
-  REAL, DIMENSION(klon,klev)   :: cidust_pi
-  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
-  REAL, DIMENSION(klon,klev)   :: sssupco_pi
-  REAL, DIMENSION(klon,klev)   :: ssacu_pi
-  REAL, DIMENSION(klon,klev)   :: pdel
-  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
-  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF  
-!  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
-
-  INTEGER :: k, i
-  
-!****************************************************************************************
-! 1) Get aerosol mass
-!    
-!****************************************************************************************
-! Read and interpolate sulfate
-  IF ( flag_aerosol .EQ. 1 .OR. &
-       flag_aerosol .EQ. 6 ) THEN 
-
-     CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4)
-  ELSE
-     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
-     loadso4=0.
-  END IF
-
-! Read and interpolate bcsol and bcins
-  IF ( flag_aerosol .EQ. 2 .OR. &
-       flag_aerosol .EQ. 6 ) THEN 
-
-     ! Get bc aerosol distribution 
-     CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1)
-     CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2)
-     loadbc(:)=load_tmp1(:)+load_tmp2(:)
-  ELSE
-     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
-     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
-     loadbc=0.
-  END IF
-
-
-! Read and interpolate pomsol and pomins
-  IF ( flag_aerosol .EQ. 3 .OR. &
-       flag_aerosol .EQ. 6 ) THEN
-
-     CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
-     CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
-     loadoa(:)=load_tmp3(:)+load_tmp4(:)
-  ELSE
-     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
-     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
-     loadoa=0.
-  END IF
-
-
-! Read and interpolate csssm, ssssm, assssm
-  IF (flag_aerosol .EQ. 4 .OR. &
-      flag_aerosol .EQ. 6 ) THEN 
-
-      CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi,  load_tmp5) 
-      CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6) 
-      CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu,   ssacu_pi,    load_tmp7) 
-      loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
-  ELSE
-      sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0. 
-      ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0. 
-      sssupco(:,:)  = 0. ; sssupco_pi = 0. 
-      loadss=0.
-  ENDIF
-
-! Read and interpolate cidustm
-  IF (flag_aerosol .EQ. 5 .OR.  &
-      flag_aerosol .EQ. 6 ) THEN 
-
-      CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust) 
-  ELSE
-      cidust(:,:) = 0. ; cidust_pi(:,:) = 0. 
-      loaddust=0.
-  ENDIF
-
-!
-! Store all aerosols in one variable
-!
-  m_allaer(:,:,id_ASBCM_phy)  = bcsol(:,:)        ! ASBCM
-  m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:)       ! ASPOMM
-  m_allaer(:,:,id_ASSO4M_phy) = sulfate(:,:)      ! ASSO4M (= SO4) 
-  m_allaer(:,:,id_CSSO4M_phy) = 0.                ! CSSO4M 
-  m_allaer(:,:,id_SSSSM_phy)  = sssupco(:,:)      ! SSSSM
-  m_allaer(:,:,id_CSSSM_phy)  = sscoarse(:,:)     ! CSSSM
-  m_allaer(:,:,id_ASSSM_phy)  = ssacu(:,:)        ! ASSSM
-  m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:)       ! CIDUSTM
-  m_allaer(:,:,id_AIBCM_phy)  = bcins(:,:)        ! AIBCM
-  m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:)       ! AIPOMM
-  m_allaer(:,:,id_ASNO3M_phy) = 0.0
-  m_allaer(:,:,id_CSNO3M_phy) = 0.0
-  m_allaer(:,:,id_CINO3M_phy) = 0.0
-
-!RAF
-  m_allaer_pi(:,:,id_ASBCM_phy)   = bcsol_pi(:,:)        ! ASBCM pre-ind
-  m_allaer_pi(:,:,id_ASPOMM_phy)  = pomsol_pi(:,:)       ! ASPOMM pre-ind
-  m_allaer_pi(:,:,id_ASSO4M_phy)  = sulfate_pi(:,:)      ! ASSO4M (= SO4) pre-ind
-  m_allaer_pi(:,:,id_CSSO4M_phy)  = 0.                   ! CSSO4M pre-ind
-  m_allaer_pi(:,:,id_SSSSM_phy)   = sssupco_pi(:,:)      ! SSSSM pre-ind
-  m_allaer_pi(:,:,id_CSSSM_phy)   = sscoarse_pi(:,:)     ! CSSSM pre-ind
-  m_allaer_pi(:,:,id_ASSSM_phy)   = ssacu_pi(:,:)        ! ASSSM pre-ind
-  m_allaer_pi(:,:,id_CIDUSTM_phy) = cidust_pi(:,:)       ! CIDUSTM pre-ind
-  m_allaer_pi(:,:,id_AIBCM_phy)   = bcins_pi(:,:)        ! AIBCM pre-ind
-  m_allaer_pi(:,:,id_AIPOMM_phy)  = pomins_pi(:,:)       ! AIPOMM pre-ind
-  m_allaer_pi(:,:,id_ASNO3M_phy) = 0.0
-  m_allaer_pi(:,:,id_CSNO3M_phy) = 0.0
-  m_allaer_pi(:,:,id_CINO3M_phy) = 0.0
-!
-! Calculate the total mass of all soluble aersosols
-!
-  mass_solu_aero(:,:)    = sulfate(:,:)    + bcsol(:,:)    + pomsol(:,:) + ssacu(:,:)
-  mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + ssacu_pi(:,:)
-
-!****************************************************************************************
-! 2) Calculate optical properties for the aerosols
-!
-!****************************************************************************************
-  DO k = 1, klev
-     DO i = 1, klon
-        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
-     END DO
-  END DO
-
-! RAF delete??     fractnat_allaer(:,:) = 0.
-! RAF fractnat_allaer -> m_allaer_pi
-
-     CALL aeropt_2bands( &
-          pdel, m_allaer, pdtphys, rhcl, & 
-          tau_aero, piz_aero, cg_aero,   &
-          m_allaer_pi, flag_aerosol, &
-          pplay, t_seri, presnivs) 
-     
-     ! aeropt_5wv only for validation and diagnostics.
-     CALL aeropt_5wv(                    &
-          pdel, m_allaer,                &
-          pdtphys, rhcl, aerindex,       & 
-          flag_aerosol, pplay, t_seri,   &
-          tausum_aero, tau3d_aero, presnivs)
-
-! Diagnostics calculation for CMIP5 protocol
-  sconcso4(:)=m_allaer(:,1,id_ASSO4M_phy)*1.e-9
-  sconcno3(:)=m_allaer(:,1,id_ASNO3M_phy)*1.e-9
-  sconcoa(:)=(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
-  sconcbc(:)=(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
-  sconcss(:)=(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
-  sconcdust(:)=m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
-  concso4(:,:)=m_allaer(:,:,id_ASSO4M_phy)*1.e-9
-  concno3(:,:)=m_allaer(:,:,id_ASNO3M_phy)*1.e-9
-  concoa(:,:)=(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
-  concbc(:,:)=(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
-  concss(:,:)=(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
-  concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
-
-END SUBROUTINE readaerosol_optic
+link ../phylmd/readaerosol_optic.F90
Index: LMDZ6/trunk/libf/phylmdiso/readaerosolstrato.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/readaerosolstrato.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/readaerosolstrato.F90	(revision 3940)
@@ -1,209 +1,1 @@
-subroutine readaerosolstrato(debut)
-
-    use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
-                        nf95_inq_varid, nf95_open
-    use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
-
-    USE phys_cal_mod, ONLY : mth_cur
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, &
-                                 grid2dto1d_glo, grid_type, unstructured
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
-    USE mod_phys_lmdz_para 
-    USE phys_state_var_mod
-    USE phys_local_var_mod
-    USE aero_mod
-    USE dimphy
-    USE print_control_mod, ONLY: prt_level,lunout
-#ifdef CPP_XIOS
-    USE xios
-#endif
-    implicit none
-
-    include "YOMCST.h"
-
-! Variable input
-    logical debut
-
-! Variables locales
-    integer n_lat   ! number of latitudes in the input data
-    integer n_lon   ! number of longitudes in the input data
-    integer n_lev   ! number of levels in the input data
-    integer n_month ! number of months in the input data
-    real, pointer:: latitude(:)
-    real, pointer:: longitude(:)
-    real, pointer:: time(:)
-    real, pointer:: lev(:)
-    integer i, k, band, wave
-    integer, save :: mth_pre=1
-!$OMP THREADPRIVATE(mth_pre)
-
-    real, allocatable, dimension(:,:), save :: tau_aer_strat
-!$OMP THREADPRIVATE(tau_aer_strat)
-
-! Champs reconstitues
-    real, allocatable:: tauaerstrat(:, :, :, :)
-    real, allocatable:: tauaerstrat_mois(:, :, :)
-    real, allocatable:: tauaerstrat_mois_glo(:, :)
-    real, allocatable:: tau_aer_strat_mpi(:, :)
-
-! For NetCDF:
-    integer ncid_in  ! IDs for input files
-    integer varid, ncerr
-
-! Stratospheric aerosols optical properties
-! alpha_strat over the 2 bands is normalised by the 550 nm extinction coefficient
-! alpha_strat_wave is *not* normalised by the 550 nm extinction coefficient
-    real, dimension(nbands) :: alpha_strat, piz_strat, cg_strat
-    data alpha_strat/0.9922547, 0.7114912 /
-    data piz_strat  /0.9999998, 0.99762493/
-    data cg_strat   /0.73107845,0.73229635/
-    real, dimension(nwave_sw) :: alpha_strat_wave
-    data alpha_strat_wave/3.36780953,3.34667683,3.20444202,3.0293026,2.82108808/
-
-    CHARACTER (len = 20)                      :: modname = 'readaerosolstrato'
-    CHARACTER (len = 80)                      :: abort_message
-
-!--------------------------------------------------------
-
-    IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon,klev))
-
-!--only read file if beginning of run or start of new month
-    IF (debut.OR.mth_cur.NE.mth_pre) THEN
-
-!--only root reads
-    IF (is_mpi_root.AND.is_omp_root) THEN
-
-    IF (nbands.NE.2) THEN 
-        abort_message='nbands doit etre egal a 2 dans readaerosolstrat'
-        CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    CALL nf95_open("taustrat.nc", nf90_nowrite, ncid_in)
-
-    CALL nf95_inq_varid(ncid_in, "LEV", varid)
-    CALL nf95_gw_var(ncid_in, varid, lev)
-    n_lev = size(lev)
-    IF (n_lev.NE.klev) THEN 
-       abort_message='Le nombre de niveaux n est pas egal a klev'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    CALL nf95_inq_varid(ncid_in, "LAT", varid)
-    CALL nf95_gw_var(ncid_in, varid, latitude)
-    n_lat = size(latitude)
-    WRITE(lunout,*) 'LAT aerosol strato=', n_lat, latitude
-    IF (grid_type/=unstructured) THEN
-      IF (n_lat.NE.nbp_lat) THEN 
-         abort_message='Le nombre de lat n est pas egal a nbp_lat'
-         CALL abort_physic(modname,abort_message,1)
-      ENDIF
-    ENDIF
-    
-    CALL nf95_inq_varid(ncid_in, "LON", varid)
-    CALL nf95_gw_var(ncid_in, varid, longitude)
-    n_lon = size(longitude)
-    IF (grid_type/=unstructured) THEN
-      WRITE(lunout,*) 'LON aerosol strato=', n_lon, longitude
-      IF (n_lon.NE.nbp_lon) THEN 
-         abort_message='Le nombre de lon n est pas egal a nbp_lon'
-         CALL abort_physic(modname,abort_message,1)
-      ENDIF
-    ENDIF
-    
-    CALL nf95_inq_varid(ncid_in, "TIME", varid)
-    CALL nf95_gw_var(ncid_in, varid, time)
-    n_month = size(time)
-    WRITE(lunout,*) 'TIME aerosol strato=', n_month, time
-    IF (n_month.NE.12) THEN 
-       abort_message='Le nombre de month n est pas egal a 12'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    IF (.not.ALLOCATED(tauaerstrat))          ALLOCATE(tauaerstrat(n_lon, n_lat, n_lev, n_month))
-    IF (.not.ALLOCATED(tauaerstrat_mois))     ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev))
-    IF (.not.ALLOCATED(tauaerstrat_mois_glo)) ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev))
-
-!--reading stratospheric AOD at 550 nm
-    CALL nf95_inq_varid(ncid_in, "TAUSTRAT", varid)
-    ncerr = nf90_get_var(ncid_in, varid, tauaerstrat)
-    WRITE(lunout,*) 'code erreur readaerosolstrato=', ncerr, varid
-
-    CALL nf95_close(ncid_in)
-
-!---select the correct month
-    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
-     WRITE(lunout,*) 'probleme avec le mois dans readaerosolstrat =', mth_cur
-    ENDIF
-    tauaerstrat_mois(:,:,:) = tauaerstrat(:,:,:,mth_cur)
-
-!---reduce to a klon_glo grid 
-    CALL grid2dTo1d_glo(tauaerstrat_mois,tauaerstrat_mois_glo)
-
-    ELSE
-      ALLOCATE(tauaerstrat_mois(0,0,0))
-    ENDIF !--is_mpi_root and is_omp_root
-
-!$OMP BARRIER
-
-    IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
-      IF (is_omp_master) THEN
-        CALL xios_send_field("taustrat_in",tauaerstrat_mois)
-        ALLOCATE(tau_aer_strat_mpi(klon_mpi, klev))
-        CALL xios_recv_field("taustrat_out",tau_aer_strat_mpi)
-      ELSE
-        ALLOCATE(tau_aer_strat_mpi(0,0))
-      ENDIF
-      CALL scatter_omp(tau_aer_strat_mpi,tau_aer_strat)
-#endif
-    ELSE  
-!--scatter on all proc
-      CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
-    ENDIF
-
-!--keep memory of previous month
-    mth_pre=mth_cur
-!
-    IF (is_mpi_root.AND.is_omp_root) THEN
-!
-    DEALLOCATE(tauaerstrat)
-    DEALLOCATE(tauaerstrat_mois)
-    DEALLOCATE(tauaerstrat_mois_glo)
-!
-    ENDIF !-is_mpi_root and is_omp_root
-
-!$OMP BARRIER
-
-    ENDIF !--debut ou nouveau mois
-
-!--total vertical aod at the 6 wavelengths
-    DO wave=1, nwave_sw
-    DO k=1, klev
-    tausum_aero(:,wave,id_STRAT_phy)=tausum_aero(:,wave,id_STRAT_phy)+tau_aer_strat(:,k)*alpha_strat_wave(wave)/alpha_strat_wave(2)
-    ENDDO
-    ENDDO
-
-!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
-    DO band=1, nbands
-!--anthropogenic aerosols bands 1 and 2
-    cg_aero(:,:,3,band)  = ( cg_aero(:,:,3,band)*piz_aero(:,:,3,band)*tau_aero(:,:,3,band) +          &
-                             cg_strat(band)*piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) /  &
-                             MAX( piz_aero(:,:,3,band)*tau_aero(:,:,3,band) +                         &
-                                  piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 )
-    piz_aero(:,:,3,band)  = ( piz_aero(:,:,3,band)*tau_aero(:,:,3,band) +                             &
-                              piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) /                &
-                              MAX( tau_aero(:,:,3,band) + alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 )
-    tau_aero(:,:,3,band)  = tau_aero(:,:,3,band) + alpha_strat(band)*tau_aer_strat(:,:)
-!--natural aerosols bands 1 and 2
-    cg_aero(:,:,2,band)  = ( cg_aero(:,:,2,band)*piz_aero(:,:,2,band)*tau_aero(:,:,2,band) +          &
-                             cg_strat(band)*piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) /  &
-                             MAX( piz_aero(:,:,2,band)*tau_aero(:,:,2,band) +                         &
-                                  piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 )
-    piz_aero(:,:,2,band)  = ( piz_aero(:,:,2,band)*tau_aero(:,:,2,band) +                             & 
-                              piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) /                &
-                              MAX( tau_aero(:,:,2,band) + alpha_strat(band)*tau_aer_strat(:,:),1.e-15 )
-    tau_aero(:,:,2,band)  = tau_aero(:,:,2,band) + alpha_strat(band)*tau_aer_strat(:,:)
-    ENDDO
-
-end subroutine readaerosolstrato
+link ../phylmd/readaerosolstrato.F90
Index: LMDZ6/trunk/libf/phylmdiso/readaerosolstrato_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/readaerosolstrato_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/readaerosolstrato_m.F90	(revision 3940)
@@ -1,138 +1,1 @@
-MODULE readaerosolstrato_m
-
-
-CONTAINS
-
-  SUBROUTINE init_readaerosolstrato(flag_aerosol_strat)
-  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
-  IMPLICIT NONE
-  INTEGER,INTENT(IN) :: flag_aerosol_strat
-    
-    IF (grid_type==unstructured)  THEN 
-   
-      IF (flag_aerosol_strat == 1) THEN
-        CALL init_readaerosolstrato1
-      ELSE IF (flag_aerosol_strat == 2) THEN
-        CALL init_readaerosolstrato2
-      ENDIF
-  
-    ENDIF
-  
-  END SUBROUTINE init_readaerosolstrato
-  
-
-
-  SUBROUTINE init_readaerosolstrato1
-#ifdef CPP_XIOS
-  USE netcdf
-  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
-                      nf95_inq_varid, nf95_open
-  USE mod_phys_lmdz_para
-  USE xios
-!  USE YOERAD, ONLY : NLW
-  IMPLICIT NONE
-  REAL, POINTER:: latitude(:)
-  REAL, POINTER:: longitude(:)
-  INTEGER :: nlat, nlon
-  REAL    :: null_array(0)
-  INTEGER :: ncid_in, varid
-  
-    IF (is_omp_master) THEN  
-      IF (is_mpi_root) THEN
-        CALL nf95_open("taustrat.nc", nf90_nowrite, ncid_in)
-        CALL nf95_inq_varid(ncid_in, "LAT", varid)
-        CALL nf95_gw_var(ncid_in, varid, latitude)
-        CALL nf95_inq_varid(ncid_in, "LON", varid)
-        CALL nf95_gw_var(ncid_in, varid, longitude)
-        CALL nf95_close(ncid_in)
-        nlat=size(latitude)
-        nlon=size(longitude)
-      ENDIF
-      CALL bcast_mpi(nlat)
-      CALL bcast_mpi(nlon)
-
-      IF (is_mpi_root) THEN
-        CALL xios_set_domain_attr("domain_taustrat",nj_glo=nlat, nj=nlat, jbegin=0, latvalue_1d=latitude)
-        CALL xios_set_domain_attr("domain_taustrat",ni_glo=nlon, ni=nlon, ibegin=0, lonvalue_1d = longitude)
-       ELSE
-        CALL xios_set_domain_attr("domain_taustrat",nj_glo=nlat, nj=0, jbegin=0, latvalue_1d=null_array )
-        CALL xios_set_domain_attr("domain_taustrat",ni_glo=nlon, ni=0, ibegin=0, lonvalue_1d=null_array)
-      ENDIF    
-  
-      CALL xios_set_fieldgroup_attr("aerosol_strato1",enabled=.TRUE.)
-    ENDIF
-    
-#endif
-  END SUBROUTINE init_readaerosolstrato1
-  
-  SUBROUTINE init_readaerosolstrato2
-#ifdef CPP_XIOS
-  USE netcdf
-  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
-                      nf95_inq_varid, nf95_open
-  USE mod_phys_lmdz_para
-  USE xios
-!  USE YOERAD, ONLY : NLW
-  IMPLICIT NONE
-  REAL, POINTER:: latitude(:)
-  REAL, POINTER:: wav(:)
-  INTEGER :: nlat,n_wav
-  REAL    :: null_array(0)
-  INTEGER :: ncid_in, varid
-
-    IF (is_omp_master) THEN    
-      IF (is_mpi_root) THEN
-        CALL nf95_open("tauswstrat.2D.nc", nf90_nowrite, ncid_in)
-        CALL nf95_inq_varid(ncid_in, "LAT", varid)
-        CALL nf95_gw_var(ncid_in, varid, latitude)
-        CALL nf95_inq_varid(ncid_in, "WAV", varid)
-        CALL nf95_gw_var(ncid_in, varid, wav)
-        CALL nf95_close(ncid_in)
-        nlat=size(latitude)
-        n_wav = size(wav)
-      ENDIF
-      CALL bcast_mpi(nlat)
-      CALL bcast_mpi(n_wav)
-
-      IF (is_mpi_root) THEN
-        CALL xios_set_domain_attr("domain_tauswstrat",nj_glo=nlat, nj=nlat, jbegin=0, latvalue_1d=latitude)
-        CALL xios_set_domain_attr("domain_tauswstrat",ni_glo=8, ni=8, ibegin=0, lonvalue_1d = (/ 0.,45.,90.,135.,180.,225.,270., 315. /))
-        DEALLOCATE(latitude)
-      ELSE
-        CALL xios_set_domain_attr("domain_tauswstrat",nj_glo=nlat, nj=0, jbegin=0, latvalue_1d=null_array )
-        CALL xios_set_domain_attr("domain_tauswstrat",ni_glo=8, ni=0, ibegin=0, lonvalue_1d=null_array)
-      ENDIF    
-      CALL  xios_set_axis_attr("nsw", n_glo=n_wav)
-    
-      IF (is_mpi_root) THEN
-        CALL nf95_open("taulwstrat.2D.nc", nf90_nowrite, ncid_in)
-        CALL nf95_inq_varid(ncid_in, "LAT", varid)
-        CALL nf95_gw_var(ncid_in, varid, latitude)
-        CALL nf95_inq_varid(ncid_in, "WAV", varid)
-        CALL nf95_gw_var(ncid_in, varid, wav)
-        CALL nf95_close(ncid_in)
-        nlat=size(latitude)
-        n_wav = size(wav)
-      ENDIF
-      CALL bcast_mpi(nlat)
-      CALL bcast_mpi(n_wav)
-
-      IF (is_mpi_root) THEN
-        CALL xios_set_domain_attr("domain_taulwstrat",nj_glo=nlat, nj=nlat, jbegin=0, latvalue_1d=latitude)
-        CALL xios_set_domain_attr("domain_taulwstrat",ni_glo=8, ni=8, ibegin=0, lonvalue_1d = (/ 0.,45.,90.,135.,180.,225.,270., 315. /))
-        DEALLOCATE(latitude)
-      ELSE
-        CALL xios_set_domain_attr("domain_taulwstrat",nj_glo=nlat, nj=0, jbegin=0, latvalue_1d=null_array )
-        CALL xios_set_domain_attr("domain_taulwstrat",ni_glo=8, ni=0, ibegin=0, lonvalue_1d=null_array)
-      ENDIF    
-    
-      CALL  xios_set_axis_attr("nlw", n_glo=n_wav)
-      CALL xios_set_fieldgroup_attr("aerosol_strato2",enabled=.TRUE.)
-
-    ENDIF
-#endif    
-  END SUBROUTINE init_readaerosolstrato2
-  
-
-END MODULE readaerosolstrato_m
-
+link ../phylmd/readaerosolstrato_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/readchlorophyll.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/readchlorophyll.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/readchlorophyll.F90	(revision 3940)
@@ -1,123 +1,1 @@
-!
-! $Id$
-!
-!--This routine is to be tested with MPI / OMP parallelism 
-!--OB 26/03/2018
-
-SUBROUTINE readchlorophyll(debut)
-
-    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, nf95_inq_varid, nf95_open
-    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
-    USE phys_cal_mod, ONLY: mth_cur
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dto1d_glo
-    USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
-    USE mod_phys_lmdz_omp_data, ONLY: is_omp_root
-    USE mod_phys_lmdz_para, ONLY: scatter 
-    USE phys_state_var_mod, ONLY: chl_con
-    USE print_control_mod, ONLY: prt_level,lunout
-
-    IMPLICIT NONE
-
-    INCLUDE "YOMCST.h"
-
-! Variable input
-    LOGICAL debut
-
-! Variables locales
-    INTEGER n_lat   ! number of latitudes in the input data
-    INTEGER n_lon   ! number of longitudes in the input data
-    INTEGER n_lev   ! number of levels in the input data
-    INTEGER n_month ! number of months in the input data
-    REAL, POINTER :: latitude(:)
-    REAL, POINTER :: longitude(:)
-    REAL, POINTER :: time(:)
-    INTEGER i, k
-    INTEGER, SAVE :: mth_pre
-!$OMP THREADPRIVATE(mth_pre)
-
-! Champs reconstitues
-    REAL, ALLOCATABLE :: chlorocon(:, :, :)
-    REAL, ALLOCATABLE :: chlorocon_mois(:, :)
-    REAL, ALLOCATABLE :: chlorocon_mois_glo(:)
-
-! For NetCDF:
-    INTEGER ncid_in  ! IDs for input files
-    INTEGER varid, ncerr
-
-!--------------------------------------------------------
-    CHARACTER (len = 20)  :: modname = 'readchlorophyll'
-    CHARACTER (len = 80)  :: abort_message
-
-!--only read file if beginning of run or start of new month
-    IF (debut.OR.mth_cur.NE.mth_pre) THEN
-
-    IF (is_mpi_root.AND.is_omp_root) THEN
-
-    CALL nf95_open("chlorophyll.nc", nf90_nowrite, ncid_in)
-
-    CALL nf95_inq_varid(ncid_in, "lon", varid)
-    CALL nf95_gw_var(ncid_in, varid, longitude)
-    n_lon = size(longitude)
-    IF (n_lon.NE.nbp_lon) THEN
-       abort_message='Le nombre de lon n est pas egal a nbp_lon'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    CALL nf95_inq_varid(ncid_in, "lat", varid)
-    CALL nf95_gw_var(ncid_in, varid, latitude)
-    n_lat = size(latitude)
-    IF (n_lat.NE.nbp_lat) THEN 
-       abort_message='Le nombre de lat n est pas egal a jnbp_lat'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    CALL nf95_inq_varid(ncid_in, "time", varid)
-    CALL nf95_gw_var(ncid_in, varid, time)
-    n_month = size(time)
-    IF (n_month.NE.12) THEN 
-       abort_message='Le nombre de month n est pas egal a 12'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    IF (.not.ALLOCATED(chlorocon))          ALLOCATE(chlorocon(n_lon, n_lat, n_month))
-    IF (.not.ALLOCATED(chlorocon_mois))     ALLOCATE(chlorocon_mois(n_lon, n_lat))
-    IF (.not.ALLOCATED(chlorocon_mois_glo)) ALLOCATE(chlorocon_mois_glo(klon_glo))
-
-!--reading stratospheric AOD at 550 nm
-    CALL nf95_inq_varid(ncid_in, "CHL", varid)
-    ncerr = nf90_get_var(ncid_in, varid, chlorocon)
-    WRITE(lunout,*)'code erreur readchlorophyll=', ncerr, varid
-
-    CALL nf95_close(ncid_in)
-
-!---select the correct month
-    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
-      WRITE(lunout,*)'probleme avec le mois dans readchlorophyll =', mth_cur
-    ENDIF
-    chlorocon_mois(:,:) = chlorocon(:,:,mth_cur)
-
-!---reduce to a klon_glo grid 
-    CALL grid2dTo1d_glo(chlorocon_mois,chlorocon_mois_glo)
-
-    WRITE(lunout,*)"chrolophyll current month",mth_cur
-    DO i=1,klon_glo
-!      if(isnan(chlorocon_mois_glo(i)))then ! isnan() is not in the Fortran standard...
-!      Another way to check for NaN:
-       IF (chlorocon_mois_glo(i).NE.chlorocon_mois_glo(i)) chlorocon_mois_glo(i)=0.
-    ENDDO
-
-!    DEALLOCATE(chlorocon)
-!    DEALLOCATE(chlorocon_mois)
-!    DEALLOCATE(chlorocon_mois_glo)
-  
-    ENDIF !--is_mpi_root and is_omp_root
-
-!--scatter on all proc
-    CALL scatter(chlorocon_mois_glo,chl_con)
-
-!--keep memory of previous month
-    mth_pre=mth_cur
-
-    ENDIF !--debut ou nouveau mois
-
-END SUBROUTINE readchlorophyll
+link ../phylmd/readchlorophyll.F90
Index: LMDZ6/trunk/libf/phylmdiso/regdim.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/regdim.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/regdim.h	(revision 3940)
@@ -1,17 +1,1 @@
-!
-! $Header$
-!
-!     Valid and equivalent for either free source form or fixed source form
-      INTEGER i1_deb, i1_fin
-      INTEGER i2_deb, i2_fin
-!cc      PARAMETER (i1_deb=21, i1_fin=40)
-!cc      PARAMETER (i2_deb=41, i2_fin=44)
-!ccc      PARAMETER (i1_deb=47, i1_fin=77)
-!ccc      PARAMETER (i2_deb=78, i2_fin=79)
-      PARAMETER (i1_deb=16, i1_fin=30)
-      PARAMETER (i2_deb=31, i2_fin=33)
-!
-      INTEGER j_deb, j_fin
-!cc      PARAMETER (j_deb=29, j_fin=61)
-!ccc      PARAMETER (j_deb=21, j_fin=51)
-      PARAMETER (j_deb=18, j_fin=39)
+link ../phylmd/regdim.h
Index: LMDZ6/trunk/libf/phylmdiso/regr_horiz_time_climoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/regr_horiz_time_climoz_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/regr_horiz_time_climoz_m.F90	(revision 3940)
@@ -1,737 +1,1 @@
-MODULE regr_horiz_time_climoz_m
-
-  USE interpolation,     ONLY: locate
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
-  USE nrtype,            ONLY: pi
-  USE netcdf,   ONLY: NF90_CLOBBER, NF90_FLOAT,     NF90_GET_VAR, NF90_OPEN,   &
-                      NF90_NOWRITE, NF90_NOERR,     NF90_GET_ATT, NF90_GLOBAL
-  USE netcdf95, ONLY: NF95_DEF_DIM, NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION,    &
-                      NF95_DEF_VAR, NF95_INQ_VARID, NF95_INQUIRE_VARIABLE,     &
-          NF95_OPEN,  NF95_CREATE,  NF95_GET_ATT,   NF95_GW_VAR,  HANDLE_ERR,  &
-          NF95_CLOSE, NF95_ENDDEF,  NF95_PUT_ATT,   NF95_PUT_VAR, NF95_COPY_ATT
-  USE print_control_mod, ONLY: lunout
-  USE dimphy
-  IMPLICIT NONE
-  PRIVATE
-  PUBLIC :: regr_horiz_time_climoz
-  REAL, PARAMETER :: deg2rad=pi/180.
-  CHARACTER(LEN=13), PARAMETER :: vars_in(2)=['tro3         ','tro3_daylight']
-
-  INTEGER :: nlat_ou, nlon_ou
-  REAL, ALLOCATABLE :: latitude_glo(:)
-!$OMP THREADPRIVATE(latitude_glo)
-  INTEGER, ALLOCATABLE :: ind_cell_glo_glo(:)
-!$OMP THREADPRIVATE(ind_cell_glo_glo)
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE regr_horiz_time_climoz(read_climoz,interpt)
-!
-!-------------------------------------------------------------------------------
-! Purpose: Regrid horizontally and in time zonal or 3D ozone climatologies.
-!   * Read ozone climatology from netcdf file
-!   * Regrid it horizontaly to LMDZ grid (quasi-conservative method)
-!   * If interpt=T, interpolate linearly in time (one record each day)
-!     If interpt=F, keep original time sampling  (14 months).
-!   * Save it to a new netcdf file.
-!-------------------------------------------------------------------------------
-! Remarks:
-!   * Up to 2 variables treated: "tro3" and "tro3_daylight" (if read_climoz=2)
-!   * Input fields coordinates: (longitudes, latitudes, pressure_levels, time)
-!   * Output grid cells centers coordinates given by [rlonv,] rlatu.
-!   * Output grid cells edges   coordinates given by [rlonu,] rlatv.
-!   * Input file [longitudes and] latitudes given in degrees.
-!   * Input file pressure levels are given in Pa or hPa.
-!   * All coordinates variables are stricly monotonic.
-!   * Monthly fields are interpolated linearly in time to get daily values.
-!   * Fields are known at the middle of the months, so interpolation requires an
-!     additional record both for 1st half of january and 2nd half of december:
-!     - For a 14-records "climoz.nc": records 1 and 14.
-!     - For 12-records files:
-!       record 12 of "climoz_m.nc" if available, or record 1  of "climoz.nc".
-!       record 1  of "climoz_p.nc" if available, or record 12 of "climoz.nc".
-!   * Calendar is taken into account to get one record each day (not 360 always).
-!   * Missing values are filled in from sky to ground by copying lowest valid one.
-!     Attribute "missing_value" or "_FillValue" must be present in input file.
-!-------------------------------------------------------------------------------
-  USE assert_m,           ONLY: assert
-  USE cal_tools_m,        ONLY: year_len, mid_month
-!!  USE control_mod,        ONLY: anneeref
-  USE time_phylmdz_mod,   ONLY: annee_ref
-  USE ioipsl,             ONLY: ioget_year_len, ioget_calendar
-  USE regr_conserv_m,     ONLY: regr_conserv
-  USE regr_lint_m,        ONLY: regr_lint
-  USE regular_lonlat_mod, ONLY: boundslon_reg, boundslat_reg, south, west, east
-  USE slopes_m,           ONLY: slopes
-#ifdef CPP_XIOS
-  USE xios
-#endif
-  USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_master, is_omp_master, gather, gather_mpi, bcast_mpi, klon_mpi
-  USE geometry_mod, ONLY : latitude_deg, ind_cell_glo
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN) :: read_climoz ! read ozone climatology, 1 or 2
-!                         1: read a single ozone climatology used day and night
-!                         2: same + read also a daylight climatology
-  LOGICAL, INTENT(IN) :: interpt     ! TRUE  => daily interpolation
-                                     ! FALSE => no interpolation (14 months)
-!-------------------------------------------------------------------------------
-! Local variables:
-
-!--- Input files variables
-  INTEGER :: nlon_in                       ! Number of longitudes
-  INTEGER :: nlat_in                       ! Number of latitudes
-  INTEGER :: nlev_in                       ! Number of pressure levels
-  INTEGER :: nmth_in                       ! Number of months
-  REAL, POINTER     :: lon_in(:)           ! Longitudes   (ascending order, rad)
-  REAL, POINTER     :: lat_in(:)           ! Latitudes    (ascending order, rad)
-  REAL, POINTER     :: lev_in(:)           ! Pressure levels (ascen. order, hPa)
-  REAL, ALLOCATABLE :: lon_in_edge(:)      ! Longitude intervals edges
-                                           !              (ascending order,  / )
-  REAL, ALLOCATABLE :: sinlat_in_edge(:)   ! Sinus of latitude intervals edges
-                                           !              (ascending order,  / )
-  LOGICAL :: ldec_lon, ldec_lat, ldec_lev  ! Decreasing order in input file
-  CHARACTER(LEN=20) :: cal_in              ! Calendar
-  REAL, ALLOCATABLE :: o3_in3(:,:,:,:,:)   ! Ozone climatologies
-  REAL, ALLOCATABLE :: o3_in3bis(:,:,:,:,:)   ! Ozone climatologies
-  REAL, ALLOCATABLE :: o3_in2  (:,:,:,:)   ! Ozone climatologies
-  REAL, ALLOCATABLE :: o3_in2bis(:,:,:,:,:)   ! Ozone climatologies
-  ! last index: 1 for the day-night average, 2 for the daylight field.
-  REAL :: NaN
-
-!--- Partially or totally regridded variables      (:,:,nlev_in,:,read_climoz)
-  REAL, ALLOCATABLE :: o3_regr_lon   (:,:,:,:,:) ! (nlon_ou,nlat_in,:,0:13   ,:)
-  REAL, ALLOCATABLE :: o3_regr_lonlat(:,:,:,:,:) ! (nlon_ou,nlat_ou,:,0:13   ,:)
-  REAL, ALLOCATABLE :: o3_out3       (:,:,:,:,:) ! (nlon_ou,nlat_ou,:,ntim_ou,:)
-  REAL, ALLOCATABLE :: o3_out3_glo   (:,:,:,:) !   (nbp_lat,:,ntim_ou,:)
-  REAL, ALLOCATABLE :: o3_regr_lat     (:,:,:,:) !         (nlat_in,:,0:13   ,:)
-  REAL, ALLOCATABLE :: o3_out2         (:,:,:,:) !         (nlat_ou,:,ntim_ou,:)
-  REAL, ALLOCATABLE :: o3_out2_glo     (:,:,:,:) !         (nbp_lat,:,ntim_ou,:)
-  REAL, ALLOCATABLE :: o3_out          (:,:,:,:) !         (nbp_lat,:,ntim_ou,:)
-! Dimension number  | Interval                | Contains  | For variables:
-!   1 (longitude)   | [rlonu(i-1), rlonu(i)]  | rlonv(i)  | all
-!   2 (latitude)    | [rlatv(j), rlatv(j-1)]  | rlatu(j)  | all but o3_regr_lon
-!   3 (press level) |                         |   lev(k)  | all
-! Note that rlatv(0)=pi/2 and rlatv(nlat_ou)=-pi/2.
-! Dimension 4 is: month number                             (all vars but o3_out)
-!                 days elapsed since Jan. 1st 0h at mid-day (o3_out only)
-  REAL, ALLOCATABLE :: v1(:)
-
-!--- For NetCDF:
-  INTEGER :: fID_in_m, fID_in, levID_ou, dimid, vID_in(read_climoz), ntim_ou
-  INTEGER :: fID_in_p, fID_ou, timID_ou, varid, vID_ou(read_climoz), ndims, ncerr
-  INTEGER, POINTER :: dIDs(:)
-  CHARACTER(LEN=20) :: cal_ou     !--- Calendar; no time inter => same as input
-  CHARACTER(LEN=80) :: press_unit !--- Pressure unit
-  REAL    :: tmidmonth(0:13)      !--- Elapsed days since Jan-1 0h at mid-months
-                                  ! Additional records 0, 13 for interpolation
-  REAL, ALLOCATABLE :: tmidday(:) !--- Output times (mid-days since Jan 1st 0h)
-  LOGICAL :: lprev, lnext         !--- Flags: previous/next files are present
-  LOGICAL :: l3D, l2D             !--- Flag:  input fields are 3D or zonal
-  INTEGER :: ii, i, j, k, l, m, dln, ib, ie, iv, dx1, dx2
-  INTEGER, ALLOCATABLE :: sta(:), cnt(:)
-  CHARACTER(LEN=80) :: sub, dim_nam, msg
-  REAL :: null_array(0)
-  LOGICAL,SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(first)  
-  REAL, ALLOCATABLE :: test_o3_in(:,:)
-  REAL, ALLOCATABLE :: test_o3_out(:)
-
-
-  IF (grid_type==unstructured) THEN 
-    IF (first) THEN
-      IF (is_master) THEN
-        ALLOCATE(latitude_glo(klon_glo))
-        ALLOCATE(ind_cell_glo_glo(klon_glo))
-      ELSE
-        ALLOCATE(latitude_glo(0))
-        ALLOCATE(ind_cell_glo_glo(0))
-      ENDIF
-      CALL gather(latitude_deg,  latitude_glo)
-      CALL gather(ind_cell_glo,  ind_cell_glo_glo)
-    ENDIF 
-  ENDIF
-    
-  IF (is_omp_master) THEN
-    nlat_ou=nbp_lat
-    nlon_ou=nbp_lon
-    
-   !-------------------------------------------------------------------------------
-    IF (is_mpi_root) THEN
-      sub="regr_horiz_time_climoz"
-      WRITE(lunout,*)"Call sequence information: "//TRIM(sub)
-      CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz")
-
-      CALL  NF95_OPEN("climoz.nc"  , NF90_NOWRITE, fID_in)
-      lprev=NF90_OPEN("climoz_m.nc", NF90_NOWRITE, fID_in_m)==NF90_NOERR
-      lnext=NF90_OPEN("climoz_p.nc", NF90_NOWRITE, fID_in_p)==NF90_NOERR
-
-      !--- Get coordinates from the input file. Converts lon/lat in radians.
-      !    Few inversions because "regr_conserv" and gcm need ascending vectors.
-      CALL NF95_INQ_VARID(fID_in, vars_in(1), varid)
-      CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids=dIDs, ndims=ndims)
-      l3D=ndims==4; l2D=ndims==3
-      IF(l3D) WRITE(lunout,*)"Input files contain full 3D ozone fields."
-      IF(l2D) WRITE(lunout,*)"Input files contain zonal 2D ozone fields."
-      DO i=1,ndims
-        CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), name=dim_nam, nclen=dln)
-        CALL NF95_INQ_VARID(fID_in, dim_nam, varid)
-        ii=i; IF(l2D) ii=i+1                              !--- ndims==3:NO LONGITUDE 
-        SELECT CASE(ii)
-          CASE(1)                                         !--- LONGITUDE
-            CALL NF95_GW_VAR(fID_in, varid, lon_in)
-            ldec_lon=lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in=lon_in(dln:1:-1)
-            nlon_in=dln; lon_in=lon_in*deg2rad
-          CASE(2)                                         !--- LATITUDE
-            CALL NF95_GW_VAR(fID_in, varid, lat_in)
-            ldec_lat=lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in=lat_in(dln:1:-1)
-            nlat_in=dln; lat_in=lat_in*deg2rad
-          CASE(3)                                         !--- PRESSURE LEVELS
-            CALL NF95_GW_VAR(fID_in, varid, lev_in)
-            ldec_lev=lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in=lev_in(dln:1:-1)
-            nlev_in=dln
-            CALL NF95_GET_ATT(fID_in, varid, "units", press_unit)
-            k=LEN_TRIM(press_unit)
-            DO WHILE(ICHAR(press_unit(k:k))==0)
-              press_unit(k:k)=' '; k=LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR
-            END DO
-            IF(press_unit ==  "Pa") THEN
-              lev_in = lev_in/100.                        !--- CONVERT TO hPa
-            ELSE IF(press_unit /= "hPa") THEN
-              CALL abort_physic(sub, "the only recognized units are Pa and hPa.",1)
-            END IF
-          CASE(4)                                         !--- TIME
-            CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), nclen=nmth_in)
-            cal_in='gregorian'
-            IF(NF90_GET_ATT(fID_in, varid, 'calendar', cal_in)/=NF90_NOERR)        &  
-            WRITE(lunout,*)'WARNING: missing "calendar" attribute for "'//       &
-            TRIM(dim_nam)//'" in "climoz.nc". Choosing default: "gregorian".'
-            k=LEN_TRIM(cal_in)
-            DO WHILE(ICHAR(cal_in(k:k))==0)
-              cal_in(k:k)=' '; k=LEN_TRIM(cal_in)         !--- REMOVE NULL END CHAR
-            END DO
-        END SELECT
-      END DO
-
-      !--- Prepare quantities for time interpolation
-      tmidmonth=mid_month(annee_ref, cal_in)
-      IF(interpt) THEN
-        ntim_ou=ioget_year_len(annee_ref)
-        ALLOCATE(tmidday(ntim_ou))
-        tmidday=[(REAL(k)-0.5,k=1,ntim_ou)]
-        CALL ioget_calendar(cal_ou)
-      ELSE
-        ntim_ou=14
-        cal_ou=cal_in
-      END IF
-    ENDIF
-
-    IF (grid_type==unstructured) THEN
-      CALL bcast_mpi(nlon_in)
-      CALL bcast_mpi(nlat_in)
-      CALL bcast_mpi(nlev_in)
-      CALL bcast_mpi(l3d)
-      CALL bcast_mpi(tmidmonth)
-      CALL bcast_mpi(tmidday)
-      CALL bcast_mpi(ntim_ou)
-
-#ifdef CPP_XIOS    
-      IF (is_mpi_root) THEN
-        CALL xios_set_domain_attr("domain_climoz",nj_glo=nlat_in, nj=nlat_in, jbegin=0, latvalue_1d=lat_in/deg2rad)
-        IF (l3D) THEN
-          CALL xios_set_domain_attr("domain_climoz",ni_glo=nlon_in, ni=nlon_in, ibegin=0, lonvalue_1d=lon_in/deg2rad)
-        ELSE
-          CALL xios_set_domain_attr("domain_climoz",ni_glo=8, ni=8, ibegin=0, lonvalue_1d = (/ 0.,45.,90.,135.,180.,225.,270., 315. /))
-        ENDIF
-      ELSE
-        CALL xios_set_domain_attr("domain_climoz",nj_glo=nlat_in, nj=0, jbegin=0, latvalue_1d=null_array )
-        IF (l3D) THEN
-          CALL xios_set_domain_attr("domain_climoz",ni_glo=nlon_in, ni=0, ibegin=0, lonvalue_1d=null_array)
-        ELSE
-          CALL xios_set_domain_attr("domain_climoz",ni_glo=8, ni=0, ibegin=0, lonvalue_1d=null_array)
-        ENDIF
-      ENDIF
-      CALL  xios_set_axis_attr("axis_climoz", n_glo=nlev_in)
-      CALL  xios_set_axis_attr("time_axis_climoz", n_glo=ntim_ou)
-      CALL  xios_set_axis_attr("time_axis_climoz", n_glo=ntim_ou)
-      CALL  xios_set_axis_attr("tr_climoz", n_glo=read_climoz)
-      CALL  xios_set_field_attr("tro3_out", enabled=.TRUE.)
-      CALL  xios_set_field_attr("tro3_out", enabled=.TRUE.)
-#endif
-      
-      IF (first) THEN
-        first=.FALSE.
-        RETURN
-      ENDIF
-    ENDIF
-    
-    
-    IF (is_mpi_root) THEN     
-      !--- Longitudes management:
-      !    * Need to shift data if the origin of input file longitudes /= -pi
-      !    * Need to add some margin in longitude to ensure input interval contains
-      !      all the output intervals => at least one longitudes slice has to be
-      !      duplicated, possibly more for undersampling.
-      IF(l3D) THEN
-        IF (grid_type==unstructured) THEN
-          dx2=0
-        ELSE
-          !--- Compute input edges longitudes vector (no end point yet)
-          ALLOCATE(v1(nlon_in+1))
-          v1(1)=(lon_in(nlon_in)+lon_in(1))/2.-pi
-          FORALL(i=2:nlon_in) v1(i)=(lon_in(i-1)+lon_in(i))/2.
-          v1(nlon_in+1)=v1(1)+2.*pi
-          DEALLOCATE(lon_in)
-
-          !--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west)
-          v1=v1+2*pi*REAL(FLOOR((boundslon_reg(1,west)-v1(1))/(2.*pi)))
-
-          !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west)
-          dx1=locate(v1,boundslon_reg(1,west))-1
-          v1=CSHIFT(v1,SHIFT=dx1,DIM=1) 
-          v1(nlon_in-dx1+2:)=v1(nlon_in-dx1+2:)+2.*pi
-    
-          !--- Extend input longitudes vector until last interval contains boundslon_reg(nlat_ou,east)
-          dx2=0; DO WHILE(v1(1+dx2)+2.*pi<=boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO
-
-          !--- Final edges longitudes vector (with margin and end point)
-          ALLOCATE(lon_in_edge(nlon_in+dx2+1)); lon_in_edge=[v1,v1(2:1+dx2)+2.*pi]
-          DEALLOCATE(v1)
-        ENDIF
-      END IF
-
-      !--- Compute sinus of intervals edges latitudes:
-      ALLOCATE(sinlat_in_edge(nlat_in+1))
-      sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in+1) = 1.
-      FORALL(j=2:nlat_in) sinlat_in_edge(j)=SIN((lat_in(j-1)+lat_in(j))/2.)
-      DEALLOCATE(lat_in)
-
-
-
-      !--- Check for contiguous years:
-      ib=0; ie=13
-      IF(nmth_in == 14) THEN; lprev=.FALSE.; lnext=.FALSE.
-        WRITE(lunout,*)'Using 14 months ozone climatology "climoz.nc"...'
-      ELSE  
-        IF(     lprev) WRITE(lunout,*)'Using "climoz_m.nc" last record (previous year).'
-        IF(.NOT.lprev) WRITE(lunout,*)"No previous year file ; assuming periodicity."
-        IF(     lnext) WRITE(lunout,*)'Using "climoz_p.nc" first record (next year).'
-        IF(.NOT.lnext) WRITE(lunout,*)"No next year file ; assuming periodicity."
-        IF(.NOT.lprev) ib=1
-        IF(.NOT.lnext) ie=12
-      END IF
-      ALLOCATE(sta(ndims),cnt(ndims)); sta(:)=1  
-      IF(l3D) cnt=[nlon_in,nlat_in,nlev_in,1]
-      IF(l2D) cnt=[        nlat_in,nlev_in,1]  
-      IF(l3D) ALLOCATE(o3_in3(nlon_in+dx2,nlat_in,nlev_in,ib:ie,read_climoz))
-      IF(l2D) ALLOCATE(o3_in2(            nlat_in,nlev_in,ib:ie,read_climoz))
-
-      !--- Read full current file and one record each available contiguous file
-      DO iv=1,read_climoz
-        msg=TRIM(sub)//" NF90_GET_VAR "//TRIM(vars_in(iv))
-        CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv))
-        IF(l3D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv))
-        IF(l2D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in2(          :,:,1:12,iv))
-        CALL handle_err(TRIM(msg), ncerr, fID_in)
-        IF(lprev) THEN; sta(ndims)=12  
-          CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv))
-          IF(l3D) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt)
-          IF(l2d) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in2(          :,:, 0,iv),sta,cnt)
-          CALL handle_err(TRIM(msg)//" previous", ncerr, fID_in_m)
-        END IF
-        IF(lnext) THEN; sta(ndims)=1  
-          CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv))
-          IF(l3D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt)
-          IF(l2D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in2(          :,:,13,iv),sta,cnt)
-          CALL handle_err(TRIM(msg)//" next", ncerr, fID_in_p)
-        END IF
-      END DO
-      IF(lprev.OR.lnext) DEALLOCATE(sta,cnt)
-      IF(lprev) CALL NF95_CLOSE(fID_in_m)
-      IF(lnext) CALL NF95_CLOSE(fID_in_p)
-
-      !--- Revert decreasing coordinates vector
-      IF(l3D) THEN
-        IF(ldec_lon) o3_in3(1:nlon_in,:,:,:,:) = o3_in3(nlon_in:1:-1,:,:,:,:)
-        IF(ldec_lat) o3_in3 = o3_in3(:,nlat_in:1:-1,:,:,:)
-        IF(ldec_lev) o3_in3 = o3_in3(:,:,nlev_in:1:-1,:,:)
-        
-        IF (grid_type /= unstructured) THEN
-          !--- Shift values for longitude and duplicate some longitudes slices
-          o3_in3(1:nlon_in,:,:,:,:)=CSHIFT(o3_in3(1:nlon_in,:,:,:,:),SHIFT=dx1,DIM=1)
-          o3_in3(nlon_in+1:nlon_in+dx2,:,:,:,:)=o3_in3(1:dx2,:,:,:,:)
-        ENDIF
-      ELSE
-        IF(ldec_lat) o3_in2 = o3_in2(  nlat_in:1:-1,:,:,:)
-        IF(ldec_lev) o3_in2 = o3_in2(  :,nlev_in:1:-1,:,:)
-      END IF
-
-     !--- Deal with missing values 
-      DO m=1, read_climoz
-        WRITE(msg,'(a,i0)')"regr_lat_time_climoz: field Nr.",m
-        IF(NF90_GET_ATT(fID_in,vID_in(m),"missing_value",NaN)/= NF90_NOERR) THEN
-          IF(NF90_GET_ATT(fID_in, vID_in(m),"_FillValue",NaN)/= NF90_NOERR) THEN
-            WRITE(lunout,*)TRIM(msg)//": no missing value attribute found."; CYCLE
-          END IF
-        END IF
-        WRITE(lunout,*)TRIM(msg)//": missing value attribute found."
-        WRITE(lunout,*)"Trying to fill in NaNs ; a full field would be better."
-
-        !--- Check top layer contains no NaNs & search NaNs from top to ground
-        msg=TRIM(sub)//": NaNs in top layer !"
-        IF(l3D) THEN
-          IF(ANY(o3_in3(:,:,1,:,m)==NaN)) CALL abort_physic(sub,msg,1)
-          DO k = 2,nlev_in
-            WHERE(o3_in3(:,:,k,:,m)==NaN) o3_in3(:,:,k,:,m)=o3_in3(:,:,k-1,:,m)
-          END DO
-        ELSE
-          IF(ANY(o3_in2(  :,1,:,m)==NaN)) THEN
-            WRITE(lunout,*)msg
-            !--- Fill in latitudes where all values are missing
-            DO l=1,nmth_in
-              !--- Next to south pole
-              j=1;       DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
-              IF(j>1) &
-                o3_in2(:j-1,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=j-1)
-              !--- Next to north pole
-              j=nlat_in; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
-              IF(j<nlat_in) &
-                o3_in2(j+1:,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=nlat_in-j)
-            END DO
-          END IF
-
-          !--- Fill in high latitudes missing values
-          !--- Highest level been filled-in, so has always valid values.
-          DO k = 2,nlev_in
-            WHERE(o3_in2(:,k,:,m)==NaN) o3_in2(:,k,:,m)=o3_in2(:,k-1,:,m)
-          END DO
-        END IF
-      END DO
-
-    ENDIF
-    
-    !=============================================================================
-    IF(l3D) THEN                                                   !=== 3D FIELDS
-    !=============================================================================
-     IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
-       nlat_ou=klon_mpi
-       
-       IF (is_mpi_root) THEN 
-         ALLOCATE(o3_in3bis(nlon_in,nlat_in,nlev_in,0:13,read_climoz)) 
-         o3_in3bis(:,:,:,ib:ie,:)=o3_in3(1:nlon_in,:,:,ib:ie,:)
-       ELSE
-         ALLOCATE(o3_in3bis(0,0,0,0,read_climoz))
-       ENDIF
-       ALLOCATE(o3_regr_lonlat(1, nlat_ou, nlev_in, 0:13, read_climoz))
-       
-       CALL xios_send_field("tro3_in",o3_in3bis(:,:,:,:,:))
-       CALL xios_recv_field("tro3_out",o3_regr_lonlat(1,:,:,:,:))
-#endif
-     ELSE
-          
-       !--- Regrid in longitude
-        ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie-ib+1, read_climoz))
-        CALL regr_conserv(1, o3_in3, xs = lon_in_edge,                             &
-                            xt = [boundslon_reg(1,west),boundslon_reg(:,east)],    &
-                            vt = o3_regr_lon, slope = slopes(1,o3_in3, lon_in_edge))
-        DEALLOCATE(o3_in3)
-
-        !--- Regrid in latitude: averaging with respect to SIN(lat) is
-        !                        equivalent to weighting by COS(lat)
-        !--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing)
-        ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz))
-        CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge,                     &
-                        xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
-                        vt = o3_regr_lonlat(:,nlat_ou:1:- 1,:,ib:ie,:),            &
-                   slope = slopes(2,o3_regr_lon, sinlat_in_edge))
-        DEALLOCATE(o3_regr_lon)
-
-     ENDIF
-
-     !--- Duplicate previous/next record(s) if they are not available
-     IF(.NOT.lprev) o3_regr_lonlat(:,:,:, 0,:) = o3_regr_lonlat(:,:,:,12,:)
-     IF(.NOT.lnext) o3_regr_lonlat(:,:,:,13,:) = o3_regr_lonlat(:,:,:, 1,:)
-      
-     !--- Regrid in time by linear interpolation:
-     ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz))
-     IF(     interpt) CALL regr_lint(4,o3_regr_lonlat,tmidmonth,tmidday,o3_out3)
-     IF(.NOT.interpt) o3_out3=o3_regr_lonlat
-     DEALLOCATE(o3_regr_lonlat)
-
-     nlat_ou=nbp_lat
-     IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
-       CALL xios_send_field('o3_out',o3_out3)
-       ndims=3 
-       ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz))
-       CALL gather_mpi(o3_out3(1,:,:,:,:), o3_out3_glo)
-#endif
-     ENDIF
-
-    !--- Create the output file and get the variable IDs:
-    CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, &
-                     ndims, cal_ou)
-
-    IF (is_mpi_root) THEN
-      !--- Write remaining coordinate variables:
-      CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in)
-      IF(     interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday)
-      IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth)
-
-      !--- Write to file (the order of "rlatu" is inverted in the output file):
-        IF (grid_type==unstructured) THEN
-
-          ALLOCATE(o3_out(nlat_ou, nlev_in, ntim_ou, read_climoz))
-          DO i=1,klon_glo
-            o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out3_glo(i,:,:,:)
-          ENDDO
-
-          DO m = 1, read_climoz
-            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m))
-          END DO
-          
-        ELSE
-          DO m = 1, read_climoz
-            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:,nlat_ou:1:-1,:,:,m))
-          END DO
-      ENDIF
-      CALL NF95_CLOSE(fID_ou)
-
-
-    ENDIF
-
-
-    !=============================================================================
-    ELSE                                                         !=== ZONAL FIELDS
-    !=============================================================================
-   
-     IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
-       nlat_ou=klon_mpi
-
-       IF (is_mpi_root) THEN 
-         ALLOCATE(o3_in2bis(8,nlat_in,nlev_in,0:13,read_climoz)) 
-         o3_in2bis(:,:,:,ib:ie,:)=SPREAD(o3_in2,1,8)
-       ELSE
-         ALLOCATE(o3_in2bis(0,0,0,0,read_climoz))
-       ENDIF
-       ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz))
-       CALL xios_send_field("tro3_in",o3_in2bis(:,:,:,:,:))
-       CALL xios_recv_field("tro3_out",o3_regr_lat(:,:,:,:))
-       IF(.NOT.lprev) o3_regr_lat(:,:, 0, :) = o3_regr_lat(:,:,12,:)
-       IF(.NOT.lnext) o3_regr_lat(:,:,13, :) = o3_regr_lat(:,:, 1,:)
-#endif       
-     
-     ELSE 
-        !--- Regrid in latitude: averaging with respect to SIN(lat) is
-        !                        equivalent to weighting by COS(lat)
-        !--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing)
-        ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz))
-        CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge,                          &
-                        xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
-                        vt = o3_regr_lat(nlat_ou:1:- 1,:,ib:ie,:),                 &
-                     slope = slopes(1,o3_in2, sinlat_in_edge))
-        DEALLOCATE(o3_in2)
-
-        !--- Duplicate previous/next record(s) if they are not available
-        IF(.NOT.lprev) o3_regr_lat(:,:, 0,:) = o3_regr_lat(:,:,12,:)
-        IF(.NOT.lnext) o3_regr_lat(:,:,13,:) = o3_regr_lat(:,:, 1,:)
-
-     ENDIF
-     
-      !--- Regrid in time by linear interpolation:
-      ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz))
-      IF(     interpt) CALL regr_lint(3,o3_regr_lat, tmidmonth, tmidday, o3_out2)
-      IF(.NOT.interpt) o3_out2=o3_regr_lat
-      DEALLOCATE(o3_regr_lat)
-
-      nlat_ou=nbp_lat
-    
-      IF (grid_type==unstructured) THEN
-        ndims=3 
-        ALLOCATE(o3_out2_glo(nlat_ou, nlev_in, ntim_ou, read_climoz))
-        CALL gather_mpi(o3_out2, o3_out2_glo)
-      ENDIF
-      
-      !--- Create the output file and get the variable IDs:
-      CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, &
-                         ndims, cal_ou)
-
-      IF (is_mpi_root) THEN
-      
-        !--- Write remaining coordinate variables:
-        CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in)
-        IF(     interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday)
-        IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth)
-
-        IF (grid_type==unstructured) THEN
-
-          ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz))
-          DO i=1,klon_glo
-            o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out2_glo(i,:,:,:)
-          ENDDO
-
-
-          DO m = 1, read_climoz
-            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m))
-          END DO
-        ELSE
-          !--- Write to file (the order of "rlatu" is inverted in the output file):
-          DO m = 1, read_climoz
-            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1,:,:,m))
-          END DO
-        ENDIF
-        
-        CALL NF95_CLOSE(fID_ou)
-      
-      ENDIF
-
-    !=============================================================================
-    END IF
-    !=============================================================================
-
-    IF (is_mpi_root) CALL NF95_CLOSE(fID_in)
-
-  ENDIF ! is_omp_master
-
-  first=.FALSE.
-END SUBROUTINE regr_horiz_time_climoz
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE prepare_out(fID_in, nlev_in, ntim_ou, fID_ou, vlevID, vtimID, &
-                       vID_ou, ndims, cal_ou)
-!-------------------------------------------------------------------------------
-! Purpose:  This subroutine creates the NetCDF output file, defines
-!     dimensions and variables, and writes some of the coordinate variables.
-!-------------------------------------------------------------------------------
-  USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
-  USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
-  USE mod_phys_lmdz_para, ONLY: is_mpi_root
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-!
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: fID_in, nlev_in, ntim_ou
-  INTEGER, INTENT(OUT) :: fID_ou, vlevID,  vtimID
-  INTEGER, INTENT(OUT) :: vID_ou(:)      ! dim(1/2) 1: O3day&night 2: O3daylight
-  INTEGER, INTENT(IN)  :: ndims          ! fields rank (3 or 4)
-  CHARACTER(LEN=*), INTENT(IN) :: cal_ou ! calendar
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: dlonID, dlatID, dlevID, dtimID, dIDs(4)
-  INTEGER :: vlonID, vlatID, ncerr,  is
-  REAL,ALLOCATABLE    :: latitude_glo_(:)
-  CHARACTER(LEN=80) :: sub
-  INTEGER :: i
-
-
-!-------------------------------------------------------------------------------
-  
-  IF (is_mpi_root) THEN  
-    sub="prepare_out"
-    WRITE(lunout,*)"CALL sequence information: "//TRIM(sub)
-    CALL NF95_CREATE("climoz_LMDZ.nc", NF90_clobber, fID_ou)
-
-  !--- Dimensions:
-    IF(ndims==4) &
-    CALL NF95_DEF_DIM(fID_ou, "rlonv", nlon_ou, dlonID)
-    CALL NF95_DEF_DIM(fID_ou, "rlatu", nlat_ou, dlatID)
-    CALL NF95_DEF_DIM(fID_ou, "plev",  nlev_in, dlevID)
-    CALL NF95_DEF_DIM(fID_ou, "time",  ntim_ou, dtimID)
-
-    !--- Define coordinate variables:
-    IF(ndims==4) &
-    CALL NF95_DEF_VAR(fID_ou, "rlonv", NF90_FLOAT, dlonID, vlonID)
-    CALL NF95_DEF_VAR(fID_ou, "rlatu", NF90_FLOAT, dlatID, vlatID)
-    CALL NF95_DEF_VAR(fID_ou, "plev",  NF90_FLOAT, dlevID, vlevID)
-    CALL NF95_DEF_VAR(fID_ou, "time",  NF90_FLOAT, dtimID, vtimID)
-    IF(ndims==4) &
-    CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east")
-    CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north")
-    CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar")
-    CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1")
-    IF(ndims==4) &
-    CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude")
-    CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude")
-    CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure")
-    CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time")
-    CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name",     "air pressure")
-    CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar",      cal_ou)
-
-  !--- Define the main variables:
-    IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID]
-    IF(ndims==4) dIDs=[dlonID, dlatID, dlevID, dtimID]
-    CALL NF95_DEF_VAR(fID_ou, vars_in(1), NF90_FLOAT, dIDs(1:ndims), vID_ou(1))
-    CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction")
-    CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone&
-      &_in_air")
-    IF(SIZE(vID_ou) == 2) THEN
-      CALL NF95_DEF_VAR(fID_ou, vars_in(2), NF90_FLOAT, dIDs(1:ndims), vID_ou(2))
-      CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name","ozone mole fraction in da&
-        &ylight")
-    END IF
-
-  !--- Global attributes:
-  ! The following commands, copying attributes, may fail. That is OK.
-  ! It should just mean that the attribute is not defined in the input file.
-    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"Conventions",fID_ou,NF90_GLOBAL, ncerr)
-    CALL handle_err_copy_att("Conventions")
-    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"title",      fID_ou,NF90_GLOBAL, ncerr)
-    CALL handle_err_copy_att("title")
-    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"institution",fID_ou,NF90_GLOBAL, ncerr)
-    CALL handle_err_copy_att("institution")
-    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"source",     fID_ou,NF90_GLOBAL, ncerr)
-    CALL handle_err_copy_att("source")
-    CALL NF95_PUT_ATT (fID_ou,NF90_GLOBAL,"comment", "Regridded for LMDZ")
-    CALL NF95_ENDDEF(fID_ou)
-
-    IF (grid_type==unstructured) THEN
-      ALLOCATE(latitude_glo_(klon_glo))
-      DO i=1,klon_glo
-        latitude_glo_(ind_cell_glo_glo(i))=latitude_glo(i)
-      ENDDO
-      CALL NF95_PUT_VAR(fID_ou, vlatID, latitude_glo_)
-    ELSE
-      !--- Write one of the coordinate variables:
-      IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg/deg2rad)
-      CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1)/deg2rad)
-    !    (convert from rad to degrees and sort in ascending order)
-    ENDIF
-  ENDIF
-  
-CONTAINS
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE handle_err_copy_att(att_name)
-!
-!-------------------------------------------------------------------------------
-  USE netcdf, ONLY: NF90_NOERR, NF90_strerror
-!-------------------------------------------------------------------------------
-! Arguments:
-  CHARACTER(LEN=*), INTENT(IN) :: att_name
-!-------------------------------------------------------------------------------
-  IF(ncerr /= NF90_NOERR) &
-    WRITE(lunout,*)TRIM(sub)//" prepare_out NF95_COPY_ATT "//TRIM(att_name)//  &
-                      " -- "//TRIM(NF90_strerror(ncerr))
-
-END SUBROUTINE handle_err_copy_att
-!
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE prepare_out
-!
-!-------------------------------------------------------------------------------
-
-END MODULE regr_horiz_time_climoz_m
-!
-!-------------------------------------------------------------------------------
+link ../phylmd/regr_horiz_time_climoz_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/regr_lat_time_coefoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/regr_lat_time_coefoz_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/regr_lat_time_coefoz_m.F90	(revision 3940)
@@ -1,348 +1,1 @@
-! $Id$
-module regr_lat_time_coefoz_m
-
-  ! Author: Lionel GUEZ
-
-  implicit none
-
-  private
-  public regr_lat_time_coefoz
-
-contains
-
-  subroutine regr_lat_time_coefoz
-
-    ! "regr_lat_time_coefoz" stands for "regrid latitude time
-    ! coefficients ozone".
-
-    ! This procedure reads from a NetCDF file coefficients for ozone
-    ! chemistry, regrids them in latitude and time, and writes the
-    ! regridded fields to a new NetCDF file.
-
-    ! The input fields depend on time, pressure level and latitude.
-    ! We assume that the input fields are step functions of latitude.
-    ! Regridding in latitude is made by averaging, with a cosine of
-    ! latitude factor.
-    ! The target LMDZ latitude grid is the "scalar" grid: "rlatu".
-    ! The values of "rlatu" are taken to be the centers of intervals.
-    ! Regridding in time is by linear interpolation.
-    ! Monthly values are processed to get daily values, on the basis
-    ! of a 360-day calendar.
-
-    ! We assume that in the input file:
-    ! -- the latitude is in degrees and strictly monotonic (as all
-    ! NetCDF coordinate variables should be);
-    ! -- time increases from January to December (even though we do
-    ! not use values of the input time coordinate);
-    ! -- pressure is in hPa and in strictly ascending order (even
-    ! though we do not use pressure values here, we write the unit of
-    ! pressure in the NetCDF header, and we will use the assumptions later,
-    ! when we regrid in pressure).
-
-    use mod_grid_phy_lmdz, ONLY : nbp_lat
-    use regr_conserv_m, only: regr_conserv
-    use regr_lint_m, only: regr_lint
-    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, handle_err, &
-         nf95_put_var, nf95_gw_var
-    use netcdf, only: nf90_nowrite, nf90_get_var
-    use nrtype, only: pi
-    use regular_lonlat_mod, only: boundslat_reg, south
-
-    ! Variables local to the procedure:
-
-    integer ncid_in, ncid_out ! NetCDF IDs for input and output files
-    integer n_plev ! number of pressure levels in the input data
-    integer n_lat! number of latitudes in the input data
-
-    real, pointer:: latitude(:)
-    ! (of input data, converted to rad, sorted in strictly ascending order)
-
-    real, allocatable:: lat_in_edg(:)
-    ! (edges of latitude intervals for input data, in rad, in strictly
-    ! ascending order)
-
-    real, pointer:: plev(:) ! pressure level of input data
-    logical desc_lat ! latitude in descending order in the input file
-
-    real, allocatable:: o3_par_in(:, :, :) ! (n_lat, n_plev, 12)
-    ! (ozone parameter from the input file)
-    ! ("o3_par_in(j, l, month)" is at latitude "latitude(j)" and pressure
-    ! level "plev(l)". "month" is between 1 and 12.)
-
-    real, allocatable:: v_regr_lat(:, :, :) ! (jjm + 1, n_plev, 0:13)
-    ! (mean of a variable "v" over a latitude interval)
-    ! (First dimension is latitude interval.
-    ! The latitude interval for "v_regr_lat(j,:, :)" contains "rlatu(j)".
-    ! If "j" is between 2 and "jjm" then the interval is:
-    ! [rlatv(j), rlatv(j-1)]
-    ! If "j" is 1 or "jjm + 1" then the interval is:
-    ! [rlatv(1), pi / 2]
-    ! or:
-    ! [- pi / 2, rlatv(jjm)]
-    ! respectively.
-    ! "v_regr_lat(:, l, :)" is for pressure level "plev(l)".
-    ! Last dimension is month number.)
-
-    real, allocatable:: o3_par_out(:, :, :) ! (jjm + 1, n_plev, ndays)
-    ! (regridded ozone parameter)
-    ! ("o3_par_out(j, l, day)" is at latitude "rlatu(j)", pressure
-    ! level "plev(l)" and date "January 1st 0h" + "tmidday(day)", in a
-    ! 360-day calendar.)
-
-    integer j
-    integer i_v ! index of ozone parameter
-    integer, parameter:: n_o3_param = 8 ! number of ozone parameters
-
-    character(len=11) name_in(n_o3_param)
-    ! (name of NetCDF primary variable in the input file)
-
-    character(len=9) name_out(n_o3_param)
-    ! (name of NetCDF primary variable in the output file)
-
-    integer varid_in(n_o3_param), varid_out(n_o3_param), varid_plev, varid_time
-    integer ncerr, varid
-    ! (for NetCDF)
-
-    real, parameter:: tmidmonth(0:13) = (/(-15. + 30. * j, j = 0, 13)/)
-    ! (time to middle of month, in days since January 1st 0h, in a
-    ! 360-day calendar)
-    ! (We add values -15 and 375 so that, for example, day 3 of the year is
-    ! interpolated between the December and the January value.)
-
-    real, parameter:: tmidday(360) = (/(j + 0.5, j = 0, 359)/)
-    ! (time to middle of day, in days since January 1st 0h, in a
-    ! 360-day calendar)
-
-    !---------------------------------
-
-    print *, "Call sequence information: regr_lat_time_coefoz"
-
-    ! Names of ozone parameters:
-    i_v = 0
-
-    i_v = i_v + 1
-    name_in(i_v) = "P_net"
-    name_out(i_v) = "P_net_Mob"
-
-    i_v = i_v + 1
-    name_in(i_v) = "a2"
-    name_out(i_v) = "a2"
-
-    i_v = i_v + 1
-    name_in(i_v) = "tro3"
-    name_out(i_v) = "r_Mob"
-
-    i_v = i_v + 1
-    name_in(i_v) = "a4"
-    name_out(i_v) = "a4"
-
-    i_v = i_v + 1
-    name_in(i_v) = "temperature"
-    name_out(i_v) = "temp_Mob"
-
-    i_v = i_v + 1
-    name_in(i_v) = "a6"
-    name_out(i_v) = "a6"
-
-    i_v = i_v + 1
-    name_in(i_v) = "Sigma"
-    name_out(i_v) = "Sigma_Mob"
-
-    i_v = i_v + 1
-    name_in(i_v) = "R_Het"
-    name_out(i_v) = "R_Het"
-
-    call nf95_open("coefoz.nc", nf90_nowrite, ncid_in)
-
-    ! Get coordinates from the input file:
-
-    call nf95_inq_varid(ncid_in, "latitude", varid)
-    call nf95_gw_var(ncid_in, varid, latitude)
-    ! Convert from degrees to rad, because "boundslat_reg" is in rad:
-    latitude = latitude / 180. * pi
-    n_lat = size(latitude)
-    ! We need to supply the latitudes to "regr_conserv" in
-    ! ascending order, so invert order if necessary:
-    desc_lat = latitude(1) > latitude(n_lat)
-    if (desc_lat) latitude = latitude(n_lat:1:-1)
-
-    ! Compute edges of latitude intervals:
-    allocate(lat_in_edg(n_lat + 1))
-    lat_in_edg(1) = - pi / 2
-    forall (j = 2:n_lat) lat_in_edg(j) = (latitude(j - 1) + latitude(j)) / 2
-    lat_in_edg(n_lat + 1) = pi / 2
-    deallocate(latitude) ! pointer
-
-    call nf95_inq_varid(ncid_in, "plev", varid)
-    call nf95_gw_var(ncid_in, varid, plev)
-    n_plev = size(plev)
-    ! (We only need the pressure coordinate to copy it to the output file.)
-
-    ! Get the IDs of ozone parameters in the input file:
-    do i_v = 1, n_o3_param
-       call nf95_inq_varid(ncid_in, trim(name_in(i_v)), varid_in(i_v))
-    end do
-
-    ! Create the output file and get the variable IDs:
-    call prepare_out(ncid_in, varid_in, n_plev, name_out, ncid_out, &
-         varid_out, varid_plev, varid_time)
-
-    ! Write remaining coordinate variables:
-    call nf95_put_var(ncid_out, varid_time, tmidday)
-    call nf95_put_var(ncid_out, varid_plev, plev)
-
-    deallocate(plev) ! pointer
-
-    allocate(o3_par_in(n_lat, n_plev, 12))
-    allocate(v_regr_lat(nbp_lat, n_plev, 0:13))
-    allocate(o3_par_out(nbp_lat, n_plev, 360))
-
-    do i_v = 1, n_o3_param
-       ! Process ozone parameter "name_in(i_v)"
-
-       ncerr = nf90_get_var(ncid_in, varid_in(i_v), o3_par_in)
-       call handle_err("nf90_get_var", ncerr, ncid_in)
-
-       if (desc_lat) o3_par_in = o3_par_in(n_lat:1:-1, :, :)
-
-       ! Regrid in latitude:
-       ! We average with respect to sine of latitude, which is
-       ! equivalent to weighting by cosine of latitude:
-       call regr_conserv(1, o3_par_in, xs = sin(lat_in_edg), &
-            xt = (/-1., sin((/boundslat_reg(nbp_lat-1:1:-1,south)/)), 1./), &
-            vt = v_regr_lat(nbp_lat:1:-1, :, 1:12))
-       ! (invert order of indices in "v_regr_lat" because "rlatu" is
-       ! in descending order)
-
-       ! Duplicate January and December values, in preparation of time
-       ! interpolation:
-       v_regr_lat(:, :, 0) = v_regr_lat(:, :, 12)
-       v_regr_lat(:, :, 13) = v_regr_lat(:, :, 1)
-
-       ! Regrid in time by linear interpolation:
-       call regr_lint(3, v_regr_lat, tmidmonth, tmidday, o3_par_out)
-
-       ! Write to file:
-       call nf95_put_var(ncid_out, varid_out(i_v), &
-            o3_par_out(nbp_lat:1:-1, :, :))
-       ! (The order of "rlatu" is inverted in the output file)
-    end do
-
-    call nf95_close(ncid_out)
-    call nf95_close(ncid_in)
-
-  end subroutine regr_lat_time_coefoz
-
-  !********************************************
-
-  subroutine prepare_out(ncid_in, varid_in, n_plev, name_out, ncid_out, &
-       varid_out, varid_plev, varid_time)
-
-    ! This subroutine creates the NetCDF output file, defines
-    ! dimensions and variables, and writes one of the coordinate variables.
-
-    use mod_grid_phy_lmdz, ONLY : nbp_lat
-    use assert_eq_m, only: assert_eq
-
-    use netcdf95, only: nf95_create, nf95_def_dim, nf95_def_var, &
-         nf95_put_att, nf95_enddef, nf95_copy_att, nf95_put_var
-    use netcdf, only: nf90_clobber, nf90_float, nf90_copy_att, nf90_global
-    use nrtype, only: pi
-    use regular_lonlat_mod, only : lat_reg
-
-    integer, intent(in):: ncid_in, varid_in(:), n_plev
-    character(len=*), intent(in):: name_out(:) ! of NetCDF variables
-    integer, intent(out):: ncid_out, varid_out(:), varid_plev, varid_time
-
-    ! Variables local to the procedure:
-
-    integer ncerr
-    integer dimid_rlatu, dimid_plev, dimid_time
-    integer varid_rlatu
-    integer i, n_o3_param
-
-    !---------------------------
-
-    print *, "Call sequence information: prepare_out"
-    n_o3_param = assert_eq(size(varid_in), size(varid_out), &
-         size(name_out), "prepare_out") 
-
-    call nf95_create("coefoz_LMDZ.nc", nf90_clobber, ncid_out)
-
-    ! Dimensions:
-    call nf95_def_dim(ncid_out, "time", 360, dimid_time)
-    call nf95_def_dim(ncid_out, "plev", n_plev, dimid_plev)
-    call nf95_def_dim(ncid_out, "rlatu", nbp_lat, dimid_rlatu)
-
-    ! Define coordinate variables:
-
-    call nf95_def_var(ncid_out, "time", nf90_float, dimid_time, varid_time)
-    call nf95_put_att(ncid_out, varid_time, "units", "days since 2000-1-1")
-    call nf95_put_att(ncid_out, varid_time, "calendar", "360_day")
-    call nf95_put_att(ncid_out, varid_time, "standard_name", "time")
-
-    call nf95_def_var(ncid_out, "plev", nf90_float, dimid_plev, varid_plev)
-    call nf95_put_att(ncid_out, varid_plev, "units", "millibar")
-    call nf95_put_att(ncid_out, varid_plev, "standard_name", "air_pressure")
-    call nf95_put_att(ncid_out, varid_plev, "long_name", "air pressure")
-
-    call nf95_def_var(ncid_out, "rlatu", nf90_float, dimid_rlatu, varid_rlatu)
-    call nf95_put_att(ncid_out, varid_rlatu, "units", "degrees_north")
-    call nf95_put_att(ncid_out, varid_rlatu, "standard_name", "latitude")
-
-    ! Define primary variables:
-
-    do i = 1, n_o3_param
-       call nf95_def_var(ncid_out, name_out(i), nf90_float, &
-            (/dimid_rlatu, dimid_plev, dimid_time/), varid_out(i))
-
-       ! The following commands may fail. That is OK. It should just
-       ! mean that the attribute is not defined in the input file.
-
-       ncerr = nf90_copy_att(ncid_in, varid_in(i), "long_name",&
-            & ncid_out, varid_out(i))
-       call handle_err_copy_att("long_name")
-
-       ncerr = nf90_copy_att(ncid_in, varid_in(i), "units", ncid_out,&
-            & varid_out(i))
-       call handle_err_copy_att("units")
-
-       ncerr = nf90_copy_att(ncid_in, varid_in(i), "standard_name", ncid_out,&
-            & varid_out(i))
-       call handle_err_copy_att("standard_name")
-    end do
-
-    ! Global attributes:
-    call nf95_copy_att(ncid_in, nf90_global, "Conventions", ncid_out, &
-         nf90_global)
-    call nf95_copy_att(ncid_in, nf90_global, "title", ncid_out, nf90_global)
-    call nf95_copy_att(ncid_in, nf90_global, "source", ncid_out, nf90_global)
-    call nf95_put_att(ncid_out, nf90_global, "comment", "Regridded for LMDZ")
-
-    call nf95_enddef(ncid_out)
-
-    ! Write one of the coordinate variables:
-    call nf95_put_var(ncid_out, varid_rlatu, lat_reg(nbp_lat:1:-1) / pi * 180.)
-    ! (convert from rad to degrees and sort in ascending order)
-
-  contains
-
-    subroutine handle_err_copy_att(att_name)
-
-      use netcdf, only: nf90_noerr, nf90_strerror
-
-      character(len=*), intent(in):: att_name
-
-      !----------------------------------------
-
-      if (ncerr /= nf90_noerr) then
-         print *, "prepare_out " // trim(name_out(i)) &
-              // " nf90_copy_att " // att_name // " -- " &
-              // trim(nf90_strerror(ncerr))
-      end if
-
-    end subroutine handle_err_copy_att
-
-  end subroutine prepare_out
-
-end module regr_lat_time_coefoz_m
+link ../phylmd/regr_lat_time_coefoz_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/regr_pr_comb_coefoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/regr_pr_comb_coefoz_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/regr_pr_comb_coefoz_m.F90	(revision 3940)
@@ -1,163 +1,1 @@
-! $Id$
-module regr_pr_comb_coefoz_m
-
-  implicit none
-
-  ! The five module variables declared here are on the partial
-  ! "physics" grid.
-  ! The value of each variable for index "(i, k)" is at longitude
-  ! "rlon(i)", latitude "rlat(i)" and middle of layer "k".
-
-  real, allocatable, save:: c_Mob(:, :)
-  ! (sum of Mobidic terms in the net mass production rate of ozone
-  ! by chemistry, per unit mass of air, in s-1)
-
-  real, allocatable, save:: a2(:, :)
-  ! (derivative of mass production rate of ozone per unit mass of
-  ! air with respect to ozone mass fraction, in s-1)
-
-  real, allocatable, save:: a4_mass(:, :)
-  ! (derivative of mass production rate of ozone per unit mass of
-  ! air with respect to temperature, in s-1 K-1)
-
-  real, allocatable, save:: a6_mass(:, :)
-  ! (derivative of mass production rate of ozone per unit mass of
-  ! air with respect to mass column-density of ozone above, in m2 s-1 kg-1)
-
-  real, allocatable, save:: r_het_interm(:, :)
-  ! (net mass production rate by heterogeneous chemistry, per unit
-  ! mass of ozone, corrected for chlorine content and latitude, but
-  ! not for temperature and sun direction, in s-1)
-
-  !$omp threadprivate(c_Mob, a2, a4_mass, a6_mass, r_het_interm)
-
-contains
-
-  subroutine alloc_coefoz
-
-    ! This procedure is called once per run.
-    ! It allocates module variables.
-
-    use dimphy, only: klon
-    use mod_grid_phy_lmdz, only: nbp_lev
-
-    ! Variables local to the procedure:
-
-    !---------------------------------------
-
-    !$omp master
-    print *, "Call sequence information: alloc_coefoz"
-    !$omp end master
-    allocate(c_Mob(klon, nbp_lev), a2(klon, nbp_lev), a4_mass(klon, nbp_lev))
-    allocate(a6_mass(klon, nbp_lev), r_het_interm(klon, nbp_lev))
-
-  end subroutine alloc_coefoz
-
-  !*******************************************************
-
-  subroutine regr_pr_comb_coefoz(julien, rlat, paprs, pplay)
-
-    ! "regr_pr_comb_coefoz" stands for "regrid pressure combine
-    ! coefficients ozone".
-
-    ! In this subroutine:
-    ! -- the master thread of the root process reads from a file all
-    !    eight coefficients for ozone chemistry, at the current day;
-    ! -- the coefficients are packed to the "physics" horizontal grid
-    !    and scattered to all threads of all processes;
-    ! -- in all the threads of all the processes, the coefficients are
-    !    regridded in pressure to the LMDZ vertical grid;
-    ! -- in all the threads of all the processes, the eight
-    !    coefficients are combined to define the five module variables.
-
-    use netcdf95, only: nf95_open, nf95_close
-    use netcdf, only: nf90_nowrite
-    use assert_m, only: assert
-    use dimphy, only: klon
-    use mod_phys_lmdz_mpi_data, only: is_mpi_root
-    use regr_pr_time_av_m, only: regr_pr_time_av
-    use regr_pr_int_m, only: regr_pr_int
-    use press_coefoz_m, only: press_in_edg, plev
-    use mod_grid_phy_lmdz, only: nbp_lev
-
-    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
-
-    REAL, intent(in):: rlat(:)
-    ! (latitude on the partial "physics" grid, in degrees)
-
-    real, intent(in):: paprs(:, :) ! (klon, nbp_lev + 1)
-    ! (pression pour chaque inter-couche, en Pa)
-
-    real, intent(in):: pplay(:, :) ! (klon, nbp_lev)
-    ! (pression pour le mileu de chaque couche, en Pa)
-
-    ! Variables local to the procedure:
-
-    integer ncid ! for NetCDF
-
-    real coefoz(klon, nbp_lev, 7)
-    ! (temporary storage for 7 ozone coefficients)
-    ! (On the partial "physics" grid.
-    ! "coefoz(i, k, :)" is at longitude "rlon(i)", latitude "rlat(i)",
-    ! middle of layer "k".)
-
-    real a6(klon, nbp_lev)
-    ! (derivative of "P_net_Mob" with respect to column-density of ozone
-    ! above, in cm2 s-1)
-    ! (On the partial "physics" grid.
-    ! "a6(i, k)" is at longitude "rlon(i)", latitude "rlat(i)",
-    ! middle of layer "k".)
-
-    real, parameter:: amu = 1.6605402e-27 ! atomic mass unit, in kg
-
-    real, parameter:: Clx = 3.8e-9
-    ! (total chlorine content in the upper stratosphere)
-
-    integer k
-
-    !------------------------------------
-
-    !!print *, "Call sequence information: regr_pr_comb_coefoz"
-    call assert((/size(rlat), size(paprs, 1), size(pplay, 1)/) == klon, &
-         "regr_pr_comb_coefoz klon")
-    call assert((/size(paprs, 2) - 1, size(pplay, 2)/) == nbp_lev, &
-         "regr_pr_comb_coefoz nbp_lev")
-
-    !$omp master
-    if (is_mpi_root) call nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
-    !$omp end master
-
-    call regr_pr_time_av(ncid, (/"a2           ", "a4           ", "a6           ", &
-         "P_net_Mob    ", "r_Mob        ", "temp_Mob     ", "R_Het        "/),      &
-         REAL(julien-1), 'I', press_in_edg, paprs, coefoz)
-    a2 = coefoz(:, :, 1)
-    a4_mass = coefoz(:, :, 2) * 48. / 29.
-
-    ! Compute "a6_mass" avoiding underflow, do not divide by 1e4
-    ! before dividing by molecular mass:
-    a6_mass = coefoz(:, :, 3) / (1e4 * 29. * amu)
-    ! (factor 1e4: conversion from cm2 to m2)
-
-    ! We can overwrite "coefoz(:, :, 1)", which was saved to "a2":
-    call regr_pr_int(ncid, "Sigma_Mob", julien, plev, pplay, top_value=0., &
-         v3=coefoz(:, :, 1))
-
-    ! Combine coefficients to get "c_Mob":
-    c_mob = (coefoz(:, :, 4) - a2 * coefoz(:, :, 5) &
-         - coefoz(:, :, 3) * coefoz(:, :, 1)) * 48. / 29. &
-         - a4_mass * coefoz(:, :, 6)
-
-    r_het_interm = coefoz(:, :, 7)
-    ! Heterogeneous chemistry is only at high latitudes:
-    forall (k = 1: nbp_lev)
-       where (abs(rlat) <= 45.) r_het_interm(:, k) = 0.
-    end forall
-    r_het_interm = r_het_interm * (Clx / 3.8e-9)**2
-
-    !$omp master
-    if (is_mpi_root) call nf95_close(ncid)
-    !$omp end master
-
-  end subroutine regr_pr_comb_coefoz
-
-end module regr_pr_comb_coefoz_m
+link ../phylmd/regr_pr_comb_coefoz_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/regr_pr_int_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/regr_pr_int_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/regr_pr_int_m.F90	(revision 3940)
@@ -1,106 +1,1 @@
-! $Id$
-module regr_pr_int_m
-
-  ! Author: Lionel GUEZ
-
-  implicit none
-
-contains
-
-  subroutine regr_pr_int(ncid, name, julien, plev, pplay, top_value, v3)
-
-    ! "regr_pr_int" stands for "regrid pressure interpolation".
-    ! In this procedure:
-    ! -- the root process reads a 2D latitude-pressure field from a
-    !    NetCDF file, at a given day.
-    ! -- the field is packed to the LMDZ horizontal "physics"
-    !    grid and scattered to all threads of all processes;
-    ! -- in all the threads of all the processes, the field is regridded in
-    !    pressure to the LMDZ vertical grid.
-    ! We assume that, in the input file, the field has 3 dimensions:
-    ! latitude, pressure, julian day.
-    ! We assume that latitudes are in ascending order in the input file.
-    ! The target vertical LMDZ grid is the grid of mid-layers.
-    ! Regridding is by linear interpolation.
-
-    use dimphy, only: klon
-    use netcdf95, only: nf95_inq_varid, handle_err
-    use netcdf, only: nf90_get_var
-    use assert_m, only: assert
-    use regr_lint_m, only: regr_lint
-    use mod_phys_lmdz_mpi_data, only: is_mpi_root
-    use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, nbp_lev
-    use mod_phys_lmdz_transfert_para, only: scatter2d
-    ! (pack to the LMDZ horizontal "physics" grid and scatter)
-
-    integer, intent(in):: ncid ! NetCDF ID of the file
-    character(len=*), intent(in):: name ! of the NetCDF variable
-    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
-
-    real, intent(in):: plev(:)
-    ! (pressure level of input data, in Pa, in strictly ascending order)
-
-    real, intent(in):: pplay(:, :) ! (klon, nbp_lev)
-    ! (pression pour le mileu de chaque couche, en Pa)
-
-    real, intent(in):: top_value
-    ! (extra value of field at 0 pressure)
-
-    real, intent(out):: v3(:, :) ! (klon, nbp_lev)
-    ! (regridded field on the partial "physics" grid)
-    ! ("v3(i, k)" is at longitude "xlon(i)", latitude
-    ! "xlat(i)", middle of layer "k".)
-
-    ! Variables local to the procedure:
-
-    integer varid, ncerr ! for NetCDF
-
-    real  v1(nbp_lon, nbp_lat, 0:size(plev))
-    ! (input field at day "julien", on the global "dynamics" horizontal grid)
-    ! (First dimension is for longitude.
-    ! The value is the same for all longitudes.
-    ! "v1(:, j, k >=1)" is at latitude "rlatu(j)" and pressure "plev(k)".)
-
-    real v2(klon, 0:size(plev))
-    ! (field scattered to the partial "physics" horizontal grid)
-    ! "v2(i, k >= 1)" is at longitude "xlon(i)", latitude "xlat(i)"
-    ! and pressure "plev(k)".)
-
-    integer i
-
-    !--------------------------------------------
-
-    call assert(shape(v3) == (/klon, nbp_lev/), "regr_pr_int v3")
-    call assert(shape(pplay) == (/klon, nbp_lev/), "regr_pr_int pplay")
-
-    !$omp master
-    if (is_mpi_root) then
-       call nf95_inq_varid(ncid, name, varid)
-
-       ! Get data at the right day from the input file:
-       ncerr = nf90_get_var(ncid, varid, v1(1, :, 1:), start=(/1, 1, julien/))
-       call handle_err("regr_pr_int nf90_get_var " // name, ncerr, ncid)
-       ! Latitudes are in ascending order in the input file while
-       ! "rlatu" is in descending order so we need to invert order:
-       v1(1, :, 1:) = v1(1, nbp_lat:1:-1, 1:)
-
-       ! Complete "v1" with the value at 0 pressure:
-       v1(1, :, 0) = top_value
-
-       ! Duplicate on all longitudes:
-       v1(2:, :, :) = spread(v1(1, :, :), dim=1, ncopies=nbp_lon-1)
-    end if
-    !$omp end master
-
-    call scatter2d(v1, v2)
-
-    ! Regrid in pressure at each horizontal position:
-    do i = 1, klon
-       call regr_lint(1, v2(i, :), (/0., plev/), pplay(i, nbp_lev:1:-1), &
-                         v3(i, nbp_lev:1:-1))
-       ! (invert order of indices because "pplay" is in descending order)
-    end do
-
-  end subroutine regr_pr_int
-
-end module regr_pr_int_m
+link ../phylmd/regr_pr_int_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/regr_pr_o3_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/regr_pr_o3_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/regr_pr_o3_m.F90	(revision 3940)
@@ -1,101 +1,1 @@
-! $Id$
-module regr_pr_o3_m
-
-  implicit none
-
-contains
-
-  subroutine regr_pr_o3(p3d, o3_mob_regr)
-
-    ! "regr_pr_o3" stands for "regrid pressure ozone".
-    ! This procedure reads Mobidic ozone mole fraction from
-    ! "coefoz_LMDZ.nc" at the initial day of the run and regrids it in
-    ! pressure.
-    ! Ozone mole fraction from "coefoz_LMDZ.nc" at the initial day is
-    ! a 2D latitude -- pressure variable.
-    ! The target horizontal LMDZ grid is the "scalar" grid: "rlonv", "rlatu".
-    ! The target vertical LMDZ grid is the grid of layer boundaries.
-    ! We assume that the input variable is already on the LMDZ "rlatu"
-    ! latitude grid.
-    ! The input variable does not depend on longitude, but the
-    ! pressure at LMDZ layers does.
-    ! Therefore, the values on the LMDZ grid do depend on longitude.
-    ! Regridding is by averaging, assuming a step function.
-    ! We assume that, in the input file, the pressure levels are in
-    ! hPa and strictly increasing.
-
-    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, handle_err
-    use netcdf, only:  nf90_nowrite, nf90_get_var
-    use assert_m, only: assert
-    use regr_conserv_m, only: regr_conserv
-    use press_coefoz_m, only: press_in_edg
-    use time_phylmdz_mod, only: day_ref
-    use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, nbp_lev
-
-    REAL, intent(in):: p3d(:, :, :) ! pressure at layer interfaces, in Pa
-    ! ("p3d(i, j, l)" is at longitude "rlonv(i)", latitude "rlatu(j)",
-    ! for interface "l")
-
-    real, intent(out):: o3_mob_regr(:, :, :) ! (iim + 1, jjm + 1, llm)
-    ! (ozone mole fraction from Mobidic adapted to the LMDZ grid)
-    ! ("o3_mob_regr(i, j, l)" is at longitude "rlonv(i)", latitude
-    ! "rlatu(j)" and pressure level "pls(i, j, l)")
-
-    ! Variables local to the procedure:
-
-    integer ncid, varid, ncerr ! for NetCDF
-    integer i, j
-
-    real r_mob(nbp_lat, size(press_in_edg) - 1)
-    ! (ozone mole fraction from Mobidic at day "day_ref")
-    ! (r_mob(j, k) is at latitude "rlatu(j)", in pressure interval
-    ! "[press_in_edg(k), press_in_edg(k+1)]".)
-
-    !------------------------------------------------------------
-
-    print *, "Call sequence information: regr_pr_o3"
-    call assert(shape(o3_mob_regr) == (/nbp_lon + 1, nbp_lat, nbp_lev/), &
-         "regr_pr_o3 o3_mob_regr")
-    call assert(shape(p3d) == (/nbp_lon + 1, nbp_lat, nbp_lev + 1/), "regr_pr_o3 p3d")
-
-    call nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
-
-    call nf95_inq_varid(ncid, "r_Mob", varid)
-    ! Get data at the right day from the input file:
-    ncerr = nf90_get_var(ncid, varid, r_mob, start=(/1, 1, day_ref/))
-    call handle_err("nf90_get_var r_Mob", ncerr)
-    ! Latitudes are in ascending order in the input file while
-    ! "rlatu" is in descending order so we need to invert order:
-    r_mob = r_mob(nbp_lat:1:-1, :)
-
-    call nf95_close(ncid)
-
-    ! Regrid in pressure by averaging a step function of pressure:
-
-    ! Poles:
-    do j = 1, nbp_lat, nbp_lat-1
-       call regr_conserv(1, r_mob(j, :), press_in_edg, &
-            p3d(1, j, nbp_lev + 1:1:-1), o3_mob_regr(1, j, nbp_lev:1:-1))
-       ! (invert order of indices because "p3d" is in descending order)
-    end do
-
-    ! Other latitudes:
-    do j = 2, nbp_lat-1
-       do i = 1, nbp_lon
-          call regr_conserv(1, r_mob(j, :), press_in_edg, &
-               p3d(i, j, nbp_lev + 1:1:-1), o3_mob_regr(i, j, nbp_lev:1:-1))
-          ! (invert order of indices because "p3d" is in descending order)
-       end do
-    end do
-
-    ! Duplicate pole values on all longitudes:
-    o3_mob_regr(2:, 1, :) = spread(o3_mob_regr(1, 1, :), dim=1, ncopies=nbp_lon)
-    o3_mob_regr(2:, nbp_lat, :) &
-         = spread(o3_mob_regr(1, nbp_lat, :), dim=1, ncopies=nbp_lon)
-
-    ! Duplicate first longitude to last longitude:
-    o3_mob_regr(nbp_lon + 1, 2:nbp_lat-1, :) = o3_mob_regr(1, 2:nbp_lat-1, :)
-
-  end subroutine regr_pr_o3
-
-end module regr_pr_o3_m
+link ../phylmd/regr_pr_o3_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/regr_pr_time_av_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/regr_pr_time_av_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/regr_pr_time_av_m.F90	(revision 3940)
@@ -1,717 +1,1 @@
-! $Id$
-MODULE regr_pr_time_av_m
-
-  USE write_field_phy
-  USE mod_phys_lmdz_transfert_para, ONLY: bcast
-  USE mod_phys_lmdz_para, ONLY: mpi_rank, omp_rank
-  USE print_control_mod,  ONLY: prt_level
-  IMPLICIT NONE
-
-!-------------------------------------------------------------------------------
-! Purpose: Regrid pressure with an averaging method. Operations done:
-!  * on the root process: read a NetCDF 3D or 4D field at a given day.
-!  * pack the fields to the LMDZ "horizontal "physics" grid and scatter
-!    to all threads of all processes;
-!  * in all the threads of all the processes, regrid the fields in pressure
-!    to the LMDZ vertical grid.
-!  * the forcing fields are stretched if the following arguments are present:
-!     - "lat_in":  input file latitudes.
-!     - "Ptrp_ou": target grid (LMDZ) tropopause pressure.
-!   so that the tropopause is shifted to the position of the one of LMDZ.
-!  Note that the ozone quantity conservation is not ensured.
-!-------------------------------------------------------------------------------
-! Initial routine: regr_pr_av_m module (L. Guez).
-! Present version: David Cugnet ; corresponding additions:
-!    - time interpolation
-!    - 3D compliant
-!    - vertical stretching of the field to allow tropopause matching between
-!    input field and current lmdz field.
-!-------------------------------------------------------------------------------
-! Remarks:
-!  * 3D fields are zonal means, with dimensions (latitude, pressure, julian day)
-!  * 4D fields have the dimensions:  (longitude, latitude, pressure, julian day)
-!  * All the fields are already on the horizontal grid (rlatu) or (rlatu,rlonv),
-!    except that the latitudes are in ascending order in the input file.
-!  * We assume that all the input fields have the same coordinates.
-!  * The target vertical LMDZ grid is the grid of layer centers.
-!  * Regridding in pressure can be:
-!    - Ploc=='I': pressures provided at Interfaces    => conservative 2nd order
-!         OK for ozone coefficients regridding in Cariolle routines.
-!    - Ploc=='C': pressures provides at cells Centers => classical linear       
-!         OK for ozone vertical regridding, especially when torpopause
-!      adjustment is activated, to avoid "strairs shape effect" on profiles.
-!  * All the fields are regridded as a single multi-dimensional array, so it
-!    saves CPU time to call this procedure once for several NetCDF variables
-!    rather than several times, each time for a single NetCDF variable.
-!  * The input file pressure at tropopause can be (in decreasing priority):
-!    1) read from the file if "tropopause_air_pressure" field is available.
-!    2) computed using "tro3" and "tro3_at_tropopause' (if available).
-!    3) computed using "tro3" and a fixed threshold otherwise, constant or
-!    determined using an empirical three parameters law:
-!         o3t(ppbV)=co1+co2*SIN(PI*(month-2)/6)*TANH(lat_deg/co3)
-!       => co1 and co2 are in ppbV, and co3 in degrees.
-!       => co3 allow a smooth transition between north and south hemispheres.
-!  * If available, the field "ps" (input file pressure at surface) is used.
-!    If not, the current LMDZ ground pressure is taken instead.
-!  * Fields with suffix "m"/"p" are at the closest records earlier/later than
-!  the mid-julian day "julien", on the global "dynamics" horizontal grid.
-!  * Fields(i,j,k,l) are at longitude-latitude-name "rlonv(i)-rlatu(j)-nam(l)",
-!    pressure level/interval (Ploc=="C"/"I") "pcen_in(k)"/"pcen_in(k:k+1)]".
-!  * In the 2D file case, the values are the same for all longitudes.
-!  * The tropopause correction works like this: the input fields (file) are
-!  interpolated on output (LMDZ) pressure field, which is streched using a power
-!  law in a limited zone made of 2 layers:
-!    1) between lower bound (lower than lowest tropopause) and LMDZ tropopause
-!    2) between LMDZ tropopause and upper bound (higher thzn highest tropopause)
-!  The stretching function has the following form:
-!        Sigma_str = Sigma^(1+alpha*phi(Sigma)), where:
-!   * alpha=LOG(SigT_in/SigT_ou)/LOG(SigT_ou)
-!     This value shifts the file tropopause to the height of the one of LMDZ.
-!   * phi is quasi-linear (sections of 1/log function) in the adjacent intervals:
-!       - from 0 to 1 in [Sig_top,SigT_ou]
-!       - from 1 to 0 in [SigT_ou,Sig_bot]
-!  This quasi-triangular localization function ponderates alpha-law from one near
-!  the tropopause to zero each side apart.
-!
-! * The following fields are on the global "dynamics" grid, as read from files:
-  REAL,    SAVE, ALLOCATABLE :: v1 (:,:,:,:)       !--- Current  time ozone fields
-! v1: Field read/interpol at time "julien" on the global "dynamics" horiz. grid.
-  REAL,    SAVE, ALLOCATABLE :: v1m(:,:,:,:)       !--- Previous time ozone fields
-  REAL,    SAVE, ALLOCATABLE :: v1p(:,:,:,:)       !--- Next     time ozone fields
-  REAL,    SAVE, ALLOCATABLE :: pgm(:,:), pgp(:,:) !--- Ground     pressure
-  REAL,    SAVE, ALLOCATABLE :: ptm(:,:), ptp(:,:) !--- Tropopause pressure
-  REAL,    SAVE, ALLOCATABLE :: otm(:,:), otp(:,:) !--- Tropopause o3 mix. ratio
-  INTEGER, SAVE :: ntim_in                         !--- Records nb in input file
-  INTEGER, SAVE :: itrp0                           !--- idx above chem tropop.
-  INTEGER, SAVE :: irec                            !--- Current time index
-!      * for daily   input files: current julian day number
-!      * for monthly input files: julien is in [time_in(irec),time_in(irec+1)]
-  LOGICAL, SAVE :: linterp                         !--- Interpolation in time
-  LOGICAL, SAVE :: lPrSfile                        !--- Surface pressure flag
-  LOGICAL, SAVE :: lPrTfile                        !--- Tropopause pressure flag
-  LOGICAL, SAVE :: lO3Tfile                        !--- Tropopause ozone flag
-  LOGICAL, SAVE :: lfirst=.TRUE.                   !--- First call flag
-!$OMP THREADPRIVATE(lfirst)
-  REAL,    PARAMETER :: pTropUp=9.E+3 !--- Value  <  tropopause pressure (Pa)
-  REAL,    PARAMETER :: gamm   =0.4   !--- Max. stretched layer sigma ratio
-  REAL,    PARAMETER :: rho    =1.4   !--- Max tropopauses sigma ratio
-  REAL,    PARAMETER :: o3t0   =1.E-7 !--- Nominal O3 vmr at tropopause
-  LOGICAL, PARAMETER :: lO3Tpara=.FALSE. !--- Parametrized O3 vmr at tropopause
-  LOGICAL, PARAMETER :: ldebug=.FALSE.!--- Force writefield_phy multiple outputs
-  REAL, PARAMETER :: ChemPTrMin=9.E+3 !--- Thresholds for minimum and maximum
-  REAL, PARAMETER :: ChemPTrMax=4.E+4 !    chemical  tropopause pressure (Pa).
-  REAL, PARAMETER :: DynPTrMin =8.E+3 !--- Thresholds for minimum and maximum
-  REAL, PARAMETER :: DynPTrMax =4.E+4 !    dynamical tropopause pressure (Pa).
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE regr_pr_time_av(fID, nam, julien, Ploc, Pre_in, Pre_ou, v3, Pgnd_ou,&
-                                             time_in, lon_in, lat_in, Ptrp_ou)
-!
-!-------------------------------------------------------------------------------
-  USE dimphy,         ONLY: klon
-  USE netcdf95,       ONLY: NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, handle_err, &
-                            NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION
-  USE netcdf,         ONLY: NF90_INQ_VARID, NF90_GET_VAR, NF90_NOERR
-  USE assert_m,       ONLY: assert
-  USE assert_eq_m,    ONLY: assert_eq
-!!  USE comvert_mod,    ONLY: scaleheight
-  USE interpolation,  ONLY: locate
-  USE regr_conserv_m, ONLY: regr_conserv
-  USE regr_lint_m,    ONLY: regr_lint
-  USE slopes_m,       ONLY: slopes
-  USE mod_phys_lmdz_para,           ONLY: is_mpi_root,is_master
-  USE mod_grid_phy_lmdz,            ONLY: nlon=>nbp_lon, nlat=>nbp_lat, nlev_ou=>nbp_lev, klon_glo, grid_type, unstructured
-  USE mod_phys_lmdz_transfert_para, ONLY: scatter2d, scatter, gather
-  USE phys_cal_mod,                 ONLY: calend, year_len, days_elapsed, jH_cur
-  USE geometry_mod,                 ONLY: ind_cell_glo
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER,           INTENT(IN) :: fID        !--- NetCDF file ID
-  CHARACTER(LEN=13), INTENT(IN) :: nam(:)     !--- NetCDF variables names
-  REAL,              INTENT(IN) :: julien     !--- Days since Jan 1st
-  CHARACTER(LEN=1),  INTENT(IN) :: Ploc       !--- Pressures locations
-  !--- File/LMDZ (resp. decreasing & increasing order) pressure, Pa
-  !    At cells centers or interfaces depending on "Ploc" keyword (C/I)
-  REAL,    INTENT(IN)  :: Pre_in(:)           !--- in:  file      (nlev_in[+1])
-  REAL,    INTENT(IN)  :: Pre_ou(:,:)         !--- out: LMDZ (klon,nlev_ou[+1])
-  REAL,    INTENT(OUT) :: v3(:,:,:)           !--- Regr. fld (klon,nlev_ou,n_var)
-  REAL,    INTENT(IN), OPTIONAL :: Pgnd_ou(:) !--- LMDZ ground pressure   (klon)
-  REAL,    INTENT(IN), OPTIONAL :: time_in(:) !--- Records times, in days
-                                              !    since Jan 1 of current year
-  REAL,    INTENT(IN), OPTIONAL :: lon_in(:)  !--- File longitudes vector (klon)
-  REAL,    INTENT(IN), OPTIONAL :: lat_in(:)  !--- File latitudes  vector (klon)
-  REAL,    INTENT(IN), OPTIONAL :: Ptrp_ou(:) !--- LMDZ tropopause pres   (klon)
-!-------------------------------------------------------------------------------
-! Local variables:
-  include "clesphys.h"
-  include "YOMCST.h"
-  CHARACTER(LEN=80)  :: sub
-  CHARACTER(LEN=320) :: str
-  INTEGER :: vID, ncerr, n_var, ibot, iout, nn
-  INTEGER :: i, nlev_in, n_dim, itop, itrp, i0
-  LOGICAL :: lAdjTro                          !--- Need to adjust tropopause
-  REAL    :: y_frac                           !--- Elapsed year fraction
-  REAL    :: alpha, beta, al                  !--- For stretching/interpolation
-  REAL    :: SigT_in, SigT_ou                 !--- Input and output tropopauses
-  REAL    :: Sig_bot, Sig_top                 !--- Bounds of quasi-hat function
-  REAL    :: Sig_bo0, Sig_to0                 !--- Lower/upper tropopauses
-  REAL    :: Sig_in (SIZE(Pre_in))            !--- Input field sigma levels
-  REAL    :: Sig_ou (SIZE(Pre_ou,2))          !--- Output LMDZ sigma levels
-  REAL    :: phi    (SIZE(Pre_ou,2))          !--- Stretching exponent anomaly
-  REAL    :: Pstr_ou(SIZE(Pre_ou,2))          !--- Stretched pressure levels
-  REAL    :: Pres_ou(SIZE(Pre_ou,2))          !--- Pre_ou(i,:), reversed order
-  REAL, DIMENSION(nlon, nlat) :: pg1,      pt1,      ot1
-  REAL, DIMENSION(klon)       :: Pgnd_in,  Ptrp_in,  Otrp_in
-  REAL, DIMENSION(klon)       :: Ptrop_ou, Pgrnd_ou
-! * The following fields are scattered to the partial "physics" horizontal grid.
-  REAL, POINTER :: v2(:,:,:)                  !--- Current  time ozone fields
-!     In the 2D file case, the values are the same for all longitudes.
-!     "v2(i, k, l)" is at longitude-latitude "xlon(i)-xlat(i)" and name "nam(l)"
-! Both are:          * if Ploc=='I' in pressure interval "press_in_edg(k:k+1)"
-!                    * if Ploc=='C' at pressure          "press_in_cen(k)"
-  REAL, TARGET :: &
-    v2i(klon,SIZE(Pre_in)-1,SIZE(nam)), &     !--- v2 in Ploc=='I' case
-    v2c(klon,SIZE(Pre_in)  ,SIZE(nam))        !--- v2 in Ploc=='C' case
-  INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:)
-  LOGICAL :: ll
-!--- For debug
-  REAL, DIMENSION(klon)             :: Ptrop_in, Ptrop_ef
-  REAL, DIMENSION(klon)             :: dzStrain, dzStrain0
-  REAL, DIMENSION(klon,SIZE(Pre_ou,2)) :: Pstrn_ou, phii
-!-------------------------------------------------------------------------------
-  sub="regr_pr_time_av"
-  nlev_in=SIZE(Pre_in); IF(Ploc=='I') nlev_in=nlev_in-1
-  IF(Ploc=='I') THEN; v2 => v2i; ELSE; v2 => v2c; END IF
-  CALL assert(SIZE(Pre_ou,1)==klon,TRIM(sub)//" Pre_ou klon")
-  CALL assert(SIZE(v3,1)==klon,    TRIM(sub)//" v3 klon")
-  CALL assert(SIZE(v3,2)==nlev_ou, TRIM(sub)//" v3 nlev_ou")
-  IF(Ploc=='I') CALL assert(SIZE(Pre_ou,2)==nlev_ou+1,TRIM(sub)//" Pre_ou nlev_ou+1")
-  IF(Ploc=='C') CALL assert(SIZE(Pre_ou,2)==nlev_ou  ,TRIM(sub)//" Pre_ou nlev_ou")
-  n_var = assert_eq(SIZE(nam),SIZE(v3,3),TRIM(sub)//" v3 n_var")
-  IF(PRESENT(Pgnd_ou)) CALL assert(SIZE(Pgnd_ou)==klon,TRIM(sub)//" Pgnd_ou klon")
-  IF(PRESENT(lon_in))  CALL assert(SIZE(lon_in )==klon,TRIM(sub)//" lon_in klon")
-  IF(PRESENT(lat_in))  CALL assert(SIZE(lat_in )==klon,TRIM(sub)//" lat_in klon")
-  IF(PRESENT(Ptrp_ou)) CALL assert(SIZE(Ptrp_ou)==klon,TRIM(sub)//" Ptrp_ou klon")
-  lAdjTro=PRESENT(Ptrp_ou)
-  IF(lAdjTro) THEN
-    IF(.NOT.PRESENT(lat_in)) &
-      CALL abort_physic(sub, 'Missing lat_in (required if adjust_tropopause=T)', 1)
-    IF(.NOT.PRESENT(Pgnd_ou).AND.Ploc=='C') &
-      CALL abort_physic(sub, 'Missing ground Pr(required if adjust_tropopause=T)', 1)
-    IF(PRESENT(Pgnd_ou)) THEN; Pgrnd_ou=Pgnd_ou; ELSE; Pgrnd_ou=Pre_ou(:,1); END IF
-  END IF
-
-  !$OMP MASTER
-  IF(is_mpi_root) THEN
-
-    !=== CHECK WHICH FIELDS ARE AVAILABLE IN THE INPUT FILE
-    IF(lfirst) THEN
-      lPrSfile=lAdjTro.AND.NF90_INQ_VARID(fID,"ps"                     ,vID)==NF90_NOERR
-      lPrTfile=lAdjTro.AND.NF90_INQ_VARID(fID,"tropopause_air_pressure",vID)==NF90_NOERR
-      lO3Tfile=lAdjTro.AND.NF90_INQ_VARID(fID,"tro3_at_tropopause"     ,vID)==NF90_NOERR
-      CALL NF95_INQ_DIMID(fID,"time",vID)
-      CALL NF95_INQUIRE_DIMENSION(fID,vID,nclen=ntim_in)
-      linterp=PRESENT(time_in).AND.ntim_in==14
-      ALLOCATE(v1(nlon,nlat,nlev_in,n_var))
-      IF(linterp) THEN
-        ALLOCATE(v1m(nlon,nlat,nlev_in,n_var),v1p(nlon,nlat,nlev_in,n_var))
-        IF(lPrSfile) ALLOCATE(pgm(nlon,nlat),pgp(nlon,nlat))
-        IF(lPrTfile) ALLOCATE(ptm(nlon,nlat),ptp(nlon,nlat))
-        IF(lO3Tfile) ALLOCATE(otm(nlon,nlat),otp(nlon,nlat))
-      END IF
-      !--- INITIAL INDEX: LOCATE A LAYER WELL ABOVE TROPOPAUSE (50hPa)
-      IF(lAdjTro) itrp0=locate(Pre_in,pTropUp)
-      CALL msg(linterp,'Monthly O3 files => ONLINE TIME INTERPOLATION.'    ,sub)
-      CALL msg(lPrSfile,'Using GROUND PRESSURE from input O3 forcing file.',sub)
-      CALL msg(lAdjTro ,'o3 forcing file tropopause location uses:'        ,sub)
-      IF(lPrTfile)      THEN; str='    INPUT FILE PRESSURE'
-      ELSE IF(lO3Tfile) THEN; str='    INPUT FILE O3 CONCENTRATION'
-      ELSE IF(lO3Tpara) THEN; str='    PARAMETRIZED O3 concentration'
-      ELSE;                   str='    CONSTANT O3 concentration'; END IF
-      CALL msg(lAdjTro,TRIM(str)//' at tropopause')
-    END IF
-
-    !=== UPDATE (ALWAYS FOR DAILY FILES, EACH MONTH FOR MONTHLY FILES)
-    CALL update_fields()
-
-    !=== TIME INTERPOLATION FOR MONTHLY INPUT FILES
-    IF(linterp) THEN
-      WRITE(str,'(a,f12.8,2(a,f5.1))')'Interpolating O3 at julian day ',julien,&
-        ' from fields at times ',time_in(irec),' and ', time_in(irec+1)
-      CALL msg(.TRUE.,str,sub)
-      al=(time_in(irec+1)-julien)/(time_in(irec+1)-time_in(irec))
-      v1=al*v1m+(1.-al)*v1p
-      IF(lPrSfile) pg1=al*pgm+(1.-al)*pgp
-      IF(lPrTfile) pt1=al*ptm+(1.-al)*ptp
-      IF(lO3Tfile) ot1=al*otm+(1.-al)*otp
-    END IF
-  ELSE
-    IF (lfirst) ALLOCATE(v1(0,0,0,0))
-  END IF
-  !$OMP END MASTER
-  !$OMP BARRIER
-  IF(lfirst) THEN
-    lfirst=.FALSE.;       CALL bcast(lfirst)
-    IF(lAdjTro)           CALL bcast(itrp0)
-    CALL bcast(lPrSfile); CALL bcast(lPrTfile)
-    CALL bcast(lO3Tfile); CALL bcast(linterp)
-  END IF
-  
-  IF (is_master) THEN 
-    ALLOCATE(ind_cell_glo_glo(klon_glo))
-  ELSE
-    ALLOCATE(ind_cell_glo_glo(0))
-  ENDIF
-  CALL gather(ind_cell_glo,ind_cell_glo_glo)
-  IF (is_master .AND. grid_type==unstructured) v1(:,:,:,:)=v1(:,ind_cell_glo_glo(:),:,:)
-  
-  CALL scatter2d(v1,v2)
-
-  !--- No "ps" in input file => assumed to be equal to current LMDZ ground press
-  IF(lPrSfile) THEN
-    IF (is_master .AND. grid_type==unstructured) pg1(:,:)=pg1(:,ind_cell_glo_glo(:))
-    CALL scatter2d(pg1,Pgnd_in)
-  ELSE
-    Pgnd_in=Pre_ou(:,1)
-  END IF
-
-  IF(lPrTfile) THEN
-    IF (is_master .AND. grid_type==unstructured) pt1(:,:)=pt1(:,ind_cell_glo_glo(:))
-    CALL scatter2d(pt1,Ptrp_in)
-  ENDIF
-
-  IF(lO3Tfile) THEN
-    IF (is_master .AND. grid_type==unstructured) ot1(:,:)=ot1(:,ind_cell_glo_glo(:))
-    CALL scatter2d(ot1,Otrp_in)
-  ENDIF
-  !--- No ground pressure in input file => choose it to be the one of LMDZ
-  IF(lAdjTro.AND..NOT.lPrSfile) Pgnd_in(:)=Pgrnd_ou(:)
-
-  !--- REGRID IN PRESSURE ; 3rd index inverted because "paprs" is decreasing
-  IF(.NOT.lAdjTro) THEN
-    DO i=1,klon
-      Pres_ou=Pre_ou(i,SIZE(Pre_ou,2):1:-1)   !--- pplay & paprs are decreasing
-      IF(Ploc=='C') CALL regr_lint   (1,v2(i,:,:), LOG(Pre_in(:)),             &
-        LOG(Pres_ou(:)), v3(i,nlev_ou:1:-1,:))
-      IF(Ploc=='I') CALL regr_conserv(1,v2(i,:,:),     Pre_in(:) ,             &
-            Pres_ou(:) , v3(i,nlev_ou:1:-1,:), slopes(1,v2(i,:,:), Pre_in(:)))
-    END DO
-!-------------------------------------------------------------------------------
-  ELSE                        !--- REGRID IN PRESSURE ; TROPOPAUSE ADJUSTMENT
-!-------------------------------------------------------------------------------
-    y_frac=(REAL(days_elapsed)+jH_cur)/year_len
-
-    !--- OUTPUT SIGMA LEVELS
-    DO i=1,klon
-
-      !--- INPUT/OUTPUT (FILE/LMDZ) SIGMA LEVELS IN CURRENT COLUMN
-      Pres_ou   = Pre_ou(i,SIZE(Pre_ou,2):1:-1)!--- pplay & paprs are decreasing
-      Sig_in(:) = Pre_in (:)/Pgnd_in(i)            !--- increasing values
-      Sig_ou(:) = Pres_ou(:)/Pgnd_ou(i)            !--- increasing values
-
-      !--- INPUT (FILE) SIGMA LEVEL AT TROPOPAUSE ; extreme values are filtered
-      ! to keep tropopause pressure realistic ; high values are usually due to
-      ! ozone hole fooling the crude chemical tropopause detection algorithm.
-      SigT_in = get_SigTrop(i,itrp)
-      SigT_in=MIN(SigT_in,ChemPTrMax/Pgnd_in(i))   !--- too low  value filtered
-      SigT_in=MAX(SigT_in,ChemPTrMin/Pgnd_ou(i))   !--- too high value filtered
-
-      !--- OUTPUT (LMDZ) SIGMA LEVEL AT TROPOPAUSE ; too high variations of the
-      ! dynamical tropopause (especially in filaments) are conterbalanced with
-      ! a filter ensuring it stays within a certain distance around input (file)
-      ! tropopause, hence avoiding avoid a too thick stretched region ; a final
-      ! extra-safety filter keeps the tropopause pressure value realistic.
-      SigT_ou = Ptrp_ou(i)/Pgnd_ou(i)
-      IF(SigT_ou<SigT_in/rho) SigT_ou=SigT_in/rho  !--- too low  value w/r input
-      IF(SigT_ou>SigT_in*rho) SigT_ou=SigT_in*rho  !--- too high value w/r input
-      SigT_ou=MIN(SigT_ou,DynPTrMax/Pgnd_ou(i))    !--- too low  value filtered
-      SigT_ou=MAX(SigT_ou,DynPTrMin/Pgnd_ou(i))    !--- too high value filtered
-      Ptrop_ou(i)=SigT_ou*Pgnd_ou(i)
-      iout = locate(Sig_ou(:),SigT_ou)
-
-      !--- POWER LAW COEFFICIENT FOR TROPOPAUSES MATCHING
-      alpha = LOG(SigT_in/SigT_ou)/LOG(SigT_ou)
-
-      !--- DETERMINE STRETCHING DOMAIN UPPER AND LOWER BOUNDS
-      Sig_bo0 = MAX(SigT_in,SigT_ou)               !--- lowest  tropopause
-      Sig_to0 = MIN(SigT_in,SigT_ou)               !--- highest tropopause
-      beta    = (Sig_bo0/Sig_to0)**gamm            !--- stretching exponent
-      Sig_bot = MIN(Sig_bo0*beta,0.1*(9.+Sig_bo0)) !--- must be <1
-      ibot = locate(Sig_ou(:),Sig_bot)             !--- layer index
-      IF(ibot-iout<2) THEN                         !--- at least one layer thick
-        ibot=MIN(iout+2,nlev_ou); Sig_bot=Sig_ou(ibot)
-      END IF
-      Sig_top = Sig_to0/beta                       !--- upper bound
-      itop = locate(Sig_ou(:),Sig_top)             !--- layer index
-      IF(iout-itop<2) THEN                         !--- at least one layer thick
-        itop=MAX(iout-2,1); Sig_top=Sig_ou(itop)
-      END IF
-
-      !--- STRETCHING POWER LAW LOCALIZATION FUNCTION:
-      !    0 in [0,Sig_top]    0->1 in [Sig_top,SigT_ou]
-      !    0 in [Sig_bot,1]    1->0 in [SigT_ou, Sig_bot]
-      phi(:)=0.
-      phi(itop+1:iout) = (1.-LOG(Sig_top)/LOG(Sig_ou(itop+1:iout)))&
-                            *LOG(SigT_ou)/LOG(SigT_ou/Sig_top)
-      phi(iout+1:ibot) = (1.-LOG(Sig_bot)/LOG(Sig_ou(iout+1:ibot)))&
-                            *LOG(SigT_ou)/LOG(SigT_ou/Sig_bot)
-
-      !--- LOCALY STRECHED OUTPUT (LMDZ) PRESSURE PROFILES (INCREASING ORDER)
-      Pstr_ou(:) = Pres_ou(:) * Sig_ou(:)**(alpha*phi(:))
-
-      !--- REGRID INPUT PROFILE ON STRAINED VERTICAL OUTPUT LEVELS
-      IF(Ploc=='C') CALL regr_lint   (1, v2(i,:,:), LOG(Pre_in(:)),            &
-        LOG(Pstr_ou(:)), v3(i,nlev_ou:1:-1,:))
-      IF(Ploc=='I') CALL regr_conserv(1, v2(i,:,:),     Pre_in(:) ,            &
-            Pstr_ou(:) , v3(i,nlev_ou:1:-1,:), slopes(1,v2(i,:,:), Pre_in(:)))
-
-      !--- CHECK CONCENTRATIONS. strato: 50ppbV-15ppmV ; tropo: 5ppbV-300ppbV.
-      i0=nlev_ou-locate(Pres_ou(:),Ptrop_ou(i))+1
-      ll=check_ozone(v3(i, 1:i0-1   ,1),lon_in(i),lat_in(i),1 ,'troposphere',  &
-                     5.E-9,3.0E-7)
-!     IF(ll) CALL abort_physic(sub, 'Inconsistent O3 values in troposphere', 1)
-      ll=check_ozone(v3(i,i0:nlev_ou,1),lon_in(i),lat_in(i),i0,'stratosphere', &
-                     5.E-8,1.5E-5)
-!     IF(ll) CALL abort_physic(sub, 'Inconsistent O3 values in stratosphere', 1)
-
-      IF(ldebug) THEN
-        dzStrain0(i) = SIGN(7.*LOG(Sig_bo0/Sig_to0),SigT_in-SigT_ou)
-        dzStrain (i) = SIGN(7.*LOG(Sig_bot/Sig_top),SigT_in-SigT_ou)
-        Ptrop_in (i) = SigT_in*Pgnd_in(i)
-        Pstrn_ou(i,:)= Pstr_ou
-        phii(i,:)    = phi(:)
-        Ptrop_ef(i)  = PTrop_chem(i, itrp, locate(Pres_ou(:),PTropUp),    &
-                             Pres_ou(:), v3(:,nlev_ou:1:-1,1),o3trop=o3t0)
-      END IF
-    END DO
-  END IF
-  IF(ldebug.AND.lAdjTro) THEN
-    CALL writefield_phy('PreSt_ou' ,Pstrn_ou,SIZE(Pre_ou,2)) !--- Strained Pres
-    CALL writefield_phy('dzStrain' ,dzStrain ,1)     !--- Strained thickness
-    CALL writefield_phy('dzStrain0',dzStrain0,1)     !--- Tropopauses distance
-    CALL writefield_phy('phi',phii,nlev_ou)          !--- Localization function
-    !--- Tropopauses pressures:
-    CALL writefield_phy('PreTr_in',Ptrop_in,1)       !--- Input and effective
-    CALL writefield_phy('PreTr_ou',Ptrop_ou,1)       !--- LMDz dyn tropopause
-    CALL writefield_phy('PreTr_ef',Ptrop_ef,1)       !--- Effective chem tropop
-  END IF
-  IF(ldebug) THEN
-    CALL writefield_phy('Ozone_in',v2(:,:,1),nlev_in)!--- Raw input O3 field
-    CALL writefield_phy('Ozone_ou',v3(:,:,1),nlev_ou)!--- Output ozone field
-    CALL writefield_phy('Pres_ou' ,Pre_ou,SIZE(Pre_ou,2))!--- LMDZ Pressure
-  END IF
-
-CONTAINS
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE update_fields()
-!
-!-------------------------------------------------------------------------------
-  IF(.NOT.linterp) THEN                 !=== DAILY FILES: NO TIME INTERPOLATION
-    CALL msg(.TRUE.,sub,'Updating Ozone forcing field: read from file.')
-    irec=MIN(INT(julien)+1,ntim_in)     !--- irec is just the julian day number
-    !--- MIN -> Security in the unlikely case of roundup errors.
-    CALL get_3Dfields(v1)               !--- Read ozone field(s)
-    IF(lAdjTro) THEN                    !--- Additional files for fields strain
-      IF(lPrSfile) CALL get_2Dfield(pg1,"ps")
-      IF(lPrTfile) CALL get_2Dfield(pt1,"tropopause_air_pressure")
-      IF(lO3Tfile) CALL get_2Dfield(ot1,"tro3_at_tropopause")
-    END IF
-  ELSE                                  !=== MONTHLY FILES: GET 2 NEAREST RECS
-    IF(lfirst) irec=locate(time_in,julien) !--- Need to locate surrounding times
-    IF(.NOT.lfirst.AND.julien<time_in(irec+1)) RETURN
-    CALL msg(.TRUE.,'Refreshing adjacent Ozone forcing fields.',sub)
-    IF(lfirst) THEN                     !=== READ EARLIEST TIME FIELDS
-      WRITE(str,'(a,i3,a,f12.8,a)')'Previous available field update (step 1): '&
-      //'reading record ',irec,' (time ',time_in(irec),')'
-      CALL msg(.TRUE.,str,sub)
-      CALL get_3Dfields(v1m)            !--- Read ozone field(s)
-      IF(lAdjTro) THEN                  !--- Additional files for fields strain
-        IF(lPrSfile) CALL get_2Dfield(pgm,"ps")
-        IF(lPrTfile) CALL get_2Dfield(ptm,"tropopause_air_pressure")
-        IF(lO3Tfile) CALL get_2Dfield(otm,"tro3_at_tropopause")
-      END IF
-    ELSE                                !=== SHIFT FIELDS
-      irec=irec+1
-      WRITE(str,'(a,i3,a,f12.8,a)')'Previous available field update: shifting'&
-      //' current next one (',irec,', time ',time_in(irec),')'
-      CALL msg(.TRUE.,str,sub)
-      v1m=v1p                           !--- Ozone fields
-      IF(lAdjTro) THEN                  !--- Additional files for fields strain
-        IF(lPrSfile) pgm=pgp             !--- Surface pressure
-        IF(lPrTfile) ptm=ptp             !--- Tropopause pressure
-        IF(lO3Tfile) otm=otp             !--- Tropopause ozone
-      END IF
-    END IF
-    irec=irec+1
-    WRITE(str,'(a,i3,a,f12.8,a)')'Next available field update: reading record'&
-    ,irec,' (time ',time_in(irec),')'
-    CALL msg(.TRUE.,str,sub)
-    CALL get_3Dfields(v1p)              !--- Read ozone field(s)
-    IF(lAdjTro) THEN                    !--- Additional files for fields strain
-      IF(lPrSfile) CALL get_2Dfield(pgp,"ps")
-      IF(lPrTfile) CALL get_2Dfield(ptp,"tropopause_air_pressure")
-      IF(lO3Tfile) CALL get_2Dfield(otp,"tro3_at_tropopause")
-    END IF
-    irec=irec-1
-  END IF
-
-END SUBROUTINE update_fields
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE get_2Dfield(v,var)
-!
-!-------------------------------------------------------------------------------
-! Purpose: Shortcut to get the "irec"th record of the surface field named "var"
-!          from the input file.
-! Remark: In case the field is zonal, it is duplicated along first dimension.
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL,             INTENT(INOUT) :: v(:,:)
-  CHARACTER(LEN=*), INTENT(IN)    :: var
-!-------------------------------------------------------------------------------
-  CALL NF95_INQ_VARID(fID, TRIM(var), vID)
-  CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim)
-  IF(n_dim==2) ncerr=NF90_GET_VAR(fID,vID,v(1,:), start=[  1,irec])
-  IF(n_dim==3) ncerr=NF90_GET_VAR(fID,vID,v(:,:), start=[1,1,irec])
-  CALL handle_err(TRIM(sub)//" NF90_GET_VAR "//TRIM(var),ncerr,fID)
-
-  !--- Flip latitudes: ascending in input file, descending in "rlatu".
-  IF(n_dim==3) THEN
-    v(1,:) = v(1,nlat:1:-1)
-    v(2:,:)= SPREAD(v(1,:),DIM=1,ncopies=nlon-1)  !--- Duplication
-  ELSE
-    v(:,:) = v(:,nlat:1:-1)
-  END IF
-
-END SUBROUTINE get_2Dfield
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE get_3Dfields(v)
-!
-!-------------------------------------------------------------------------------
-! Purpose: Shortcut to get the "irec"th record of the 3D fields named "nam"
-!          from the input file. Fields are stacked on fourth dimension.
-! Remark: In case the field is zonal, it is duplicated along first dimension.
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(INOUT) :: v(:,:,:,:)
-!-------------------------------------------------------------------------------
-  DO i=1,SIZE(nam)
-    CALL NF95_INQ_VARID(fID, TRIM(nam(i)), vID)
-    CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim)
-    IF(n_dim==3) ncerr=NF90_GET_VAR(fID,vID,v(1,:,:,i), start=[  1,1,irec])
-    IF(n_dim==4) ncerr=NF90_GET_VAR(fID,vID,v(:,:,:,i), start=[1,1,1,irec])
-    CALL handle_err(TRIM(sub)//" NF90_GET_VAR "//TRIM(nam(i)),ncerr,fID)
-  END DO
-
-  !--- Flip latitudes: ascending in input file, descending in "rlatu".
-  IF(n_dim==3) THEN
-    v(1,:,:,:) = v(1,nlat:1:-1,:,:)
-    v(2:,:,:,:)= SPREAD(v(1,:,:,:),DIM=1,ncopies=nlon-1)  !--- Duplication
-  ELSE
-    v(:,:,:,:) = v(:,nlat:1:-1,:,:)
-  END IF
-
-END SUBROUTINE get_3Dfields
-!
-!-------------------------------------------------------------------------------
-
-
-
-!-------------------------------------------------------------------------------
-!
-FUNCTION get_SigTrop(ih,it) RESULT(out)
-!
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL                 :: out
-  INTEGER, INTENT(IN)  :: ih
-  INTEGER, INTENT(OUT) :: it
-!-------------------------------------------------------------------------------
-  !--- Pressure at tropopause read from the forcing file
-       IF(lPrTfile) THEN; out=Ptrp_in(ih)/Pgnd_in(ih); RETURN; END IF
-
-  !--- Chemical tropopause definition based on a particular threshold
-       IF(lO3Tfile) THEN; out=PTrop_chem(ih,it,itrp0,Pre_in,v2(:,:,1),Otrp_in(ih))
-  ELSE IF(lO3Tpara) THEN; out=PTrop_chem(ih,it,itrp0,Pre_in,v2(:,:,1))
-  ELSE                  ; out=PTrop_chem(ih,it,itrp0,Pre_in,v2(:,:,1),o3t0); END IF
-  out=out/Pgnd_in(ih)
-
-END FUNCTION get_SigTrop
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-FUNCTION PTrop_chem(ih,it,it0,pres,o3,o3trop) RESULT(out)
-!
-!-------------------------------------------------------------------------------
-! Purpose: Determine the tropopause using chemical criterium, ie the pressure
-!          at which the ozone concentration reaches a certain level.
-!-------------------------------------------------------------------------------
-! Remarks:
-! * Input field is upside down (increasing pressure // increasing vertical idx)
-!   The sweep is done from top to ground, starting at the 50hPa layer (idx it0),
-!   where O3 is about 1,5 ppmV, until the first layer where o3<o3t is reached:
-!   the O3 profile in this zone is decreasing with pressure.
-! * Threshold o3t can be given as an input argument ("o3trop", in ppmV) or
-!   determined using an empirical law roughly derived from ... & al.
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL                        :: out           !--- Pressure at tropopause
-  INTEGER,        INTENT(IN)  :: ih            !--- Horizontal index
-  INTEGER,        INTENT(OUT) :: it            !--- Index of tropopause layer
-  INTEGER,        INTENT(IN)  :: it0           !--- Idx: higher than tropopause
-  REAL,           INTENT(IN)  :: pres(:)       !--- Pressure profile, increasing
-  REAL,           INTENT(IN)  :: o3(:,:)       !--- Ozone field (pptV)
-  REAL, OPTIONAL, INTENT(IN)  :: o3trop        !--- Ozone at tropopause
-!-------------------------------------------------------------------------------
-! Local variables:
-  REAL :: o3t                                  !--- Ozone concent. at tropopause
-  REAL :: al                                   !--- Interpolation coefficient
-  REAL :: coef                                 !--- Coeff of latitude modulation
-  REAL, PARAMETER :: co3(3)=[91.,28.,20.]      !--- Coeff for o3 at tropopause
-!-------------------------------------------------------------------------------
-  !--- DETERMINE THE OZONE CONCENTRATION AT TROPOPAUSE IN THE CURRENT COLUMN
-  IF(PRESENT(o3trop)) THEN                     !=== THRESHOLD FROM ARGUMENTS
-    o3t=o3trop
-  ELSE                                         !=== EMPIRICAL LAW
-    coef = TANH(lat_in(ih)/co3(3))             !--- Latitude  modulation
-    coef = SIN (2.*RPI*(y_frac-1./6.)) * coef  !--- Seasonal  modulation
-    o3t  = 1.E-9 * (co3(1)+co3(2)*coef)        !--- Value from parametrization
-  END IF
-
-  !--- FROM 50hPa, GO DOWN UNTIL "it" IS SUCH THAT o3(ih,it)>o3t>o3(ih,it+1)
-  it=it0; DO WHILE(o3(ih,it+1)>=o3t); it=it+1; END DO
-  al=(o3(ih,it)-o3t)/(o3(ih,it)-o3(ih,it+1))
-  IF(Ploc=='C') out =      pres(it)**(1.-al) * pres(it+1)**al
-  IF(Ploc=='I') out = SQRT(pres(it)**(1.-al) * pres(it+2)**al *pres(it+1))
-  it = locate(pres(:), out)                    !--- pres(it)<Ptrop<pres(it+1)
-
-END FUNCTION PTrop_chem
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-FUNCTION check_ozone(o3col, lon, lat, ilev0, layer, vmin, vmax) RESULT(out)
-!
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  LOGICAL                      :: out          !--- .T. => some wrong values
-  REAL,             INTENT(IN) :: o3col(:), lon, lat
-  INTEGER,          INTENT(IN) :: ilev0
-  CHARACTER(LEN=*), INTENT(IN) :: layer
-  REAL, OPTIONAL,   INTENT(IN) :: vmin
-  REAL, OPTIONAL,   INTENT(IN) :: vmax
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: k
-  LOGICAL :: lmin, lmax
-  REAL    :: fac
-  CHARACTER(LEN=6) :: unt
-!-------------------------------------------------------------------------------
-  !--- NOTHING TO DO
-  lmin=.FALSE.; IF(PRESENT(vmin)) lmin=COUNT(o3col<vmin)/=0
-  lmax=.FALSE.; IF(PRESENT(vmax)) lmax=COUNT(o3col>vmax)/=0
-  out=lmin.OR.lmax; IF(.NOT.out.OR.prt_level>100) RETURN
-
-  !--- SOME TOO LOW VALUES FOUND
-  IF(lmin) THEN
-    CALL unitc(vmin,unt,fac)
-    DO k=1,SIZE(o3col); IF(o3col(k)>vmin) CYCLE
-      WRITE(*,'(a,2f7.1,i3,a,2(f8.3,a))')'WARNING: inconsistent value in '     &
-        //TRIM(layer)//': O3(',lon,lat,k+ilev0-1,')=',fac*o3col(k),unt//' < ', &
-        fac*vmin,unt//' in '//TRIM(layer)
-    END DO
-  END IF
-
-  !--- SOME TOO HIGH VALUES FOUND
-  IF(lmax) THEN
-    CALL unitc(vmax,unt,fac)
-    DO k=1,SIZE(o3col); IF(o3col(k)<vmax) CYCLE
-      WRITE(*,'(a,2f7.1,i3,a,2(f8.3,a))')'WARNING: inconsistent value in '     &
-        //TRIM(layer)//': O3(',lon,lat,k+ilev0-1,')=',fac*o3col(k),unt//' > ', &
-        fac*vmax,unt//' in '//TRIM(layer)
-    END DO
-  END IF
-
-END FUNCTION check_ozone
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE unitc(val,unt,fac)
-!
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL,             INTENT(IN)  :: val
-  CHARACTER(LEN=6), INTENT(OUT) :: unt
-  REAL,             INTENT(OUT) :: fac
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: ndgt
-!-------------------------------------------------------------------------------
-  ndgt=3*FLOOR(LOG10(val)/3.)
-  SELECT CASE(ndgt)
-    CASE(-6);     unt=' ppmV '; fac=1.E6
-    CASE(-9);     unt=' ppbV '; fac=1.E9
-    CASE DEFAULT; unt=' vmr  '; fac=1.0
-  END SELECT
-
-END SUBROUTINE unitc
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE msg(ll,str,sub)
-!
-!-------------------------------------------------------------------------------
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  LOGICAL,                    INTENT(IN) :: ll
-  CHARACTER(LEN=*),           INTENT(IN) :: str
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub
-!-------------------------------------------------------------------------------
-  IF(.NOT.ll) RETURN
-  IF(PRESENT(sub)) THEN
-    WRITE(lunout,*)TRIM(sub)//': '//TRIM(str)
-  ELSE
-    WRITE(lunout,*)TRIM(str)
-  END IF
-
-END SUBROUTINE msg
-!
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE regr_pr_time_av
-!
-!-------------------------------------------------------------------------------
-
-END MODULE regr_pr_time_av_m
+link ../phylmd/regr_pr_time_av_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/screenc_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/screenc_mod.F90	(revision 3940)
+++ LMDZ6/trunk/libf/phylmdiso/screenc_mod.F90	(revision 3940)
@@ -0,0 +1,1 @@
+link ../phylmd/screenc_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/screenp_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/screenp_mod.F90	(revision 3940)
+++ LMDZ6/trunk/libf/phylmdiso/screenp_mod.F90	(revision 3940)
@@ -0,0 +1,1 @@
+link ../phylmd/screenp_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/simu_airs.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/simu_airs.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/simu_airs.F90	(revision 3940)
@@ -1,1306 +1,1 @@
-        
-        module m_simu_airs
-
-        USE print_control_mod, ONLY: prt_level,lunout
-          
-        implicit none
-
-        REAL, PARAMETER :: tau_thresh = 0.05 ! seuil nuages detectables
-        REAL, PARAMETER :: p_thresh = 445.   ! seuil nuages hauts
-        REAL, PARAMETER :: em_min = 0.2      ! seuils nuages semi-transp
-        REAL, PARAMETER :: em_max = 0.85
-        REAL, PARAMETER :: undef = 999.
-
-        contains
-
-        REAL function search_tropopause(P,T,alt,N) result(P_tropo)
-! this function searches for the tropopause pressure in [hPa].
-! The search is based on ideology described in
-! Reichler et al., Determining the tropopause height from gridded data,
-! GRL, 30(20) 2042, doi:10.1029/2003GL018240, 2003
-
-        INTEGER N,i,i_lev,first_point,exit_flag,i_dir
-        REAL P(N),T(N),alt(N),slope(N)
-        REAL P_min, P_max, slope_limit,slope_2km, &
-     & delta_alt_limit,tmp,delta_alt
-        PARAMETER(P_min=75.0, P_max=470.0)   ! hPa
-        PARAMETER(slope_limit=0.002)         ! 2 K/km converted to K/m
-        PARAMETER(delta_alt_limit=2000.0)    ! 2000 meters
-
-        do i=1,N-1
-        slope(i)=-(T(i+1)-T(i))/(alt(i+1)-alt(i))
-        end do
-        slope(N)=slope(N-1)
-
-        if (P(1).gt.P(N)) then
-        i_dir= 1
-        i=1
-        else
-        i_dir=-1
-        i=N
-        end if
-
-        first_point=0
-        exit_flag=0
-        do while(exit_flag.eq.0)
-        if (P(i).ge.P_min.and.P(i).le.P_max) then
-        if (first_point.gt.0) then
-        delta_alt=alt(i)-alt(first_point)
-        if (delta_alt.ge.delta_alt_limit) then
-        slope_2km=(T(first_point)-T(i))/delta_alt
-        if (slope_2km.lt.slope_limit) then
-        exit_flag=1
-        else
-        first_point=0
-        end if
-        end if
-        end if
-        if (first_point.eq.0.and.slope(i).lt.slope_limit) first_point=i
-        end if
-        i=i+i_dir
-        if (i.le.1.or.i.ge.N) exit_flag=1
-        end do
-
-        if (first_point.le.0) P_tropo=65.4321
-        if (first_point.eq.1) P_tropo=64.5432
-        if (first_point.gt.1) then
-        tmp=(slope_limit-slope(first_point))/(slope(first_point+1)- &
-     & slope(first_point))*(P(first_point+1)-P(first_point))
-        P_tropo=P(first_point)+tmp
-        ! print*, 'P_tropo= ', tmp, P(first_point), P_tropo
-        end if
-
-! Ajout Marine
-        if (P_tropo .lt. 60. .or. P_tropo .gt. 470.) then
-        P_tropo = 999.
-        endif
-
-        return
-        end function search_tropopause
-
-
-
-        subroutine cloud_structure(len_cs, rneb_cs, temp_cs, &
-     & emis_cs, iwco_cs, &
-     & pres_cs, dz_cs, rhodz_cs, rad_cs, &
-     & cc_tot_cs, cc_hc_cs, cc_hist_cs, &
-     & cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs, &
-     & pcld_hc_cs, tcld_hc_cs, &
-     & em_hc_cs, iwp_hc_cs, deltaz_hc_cs, &
-     & pcld_Cb_cs, tcld_Cb_cs, em_Cb_cs, &
-     & pcld_ThCi_cs, tcld_ThCi_cs, em_ThCi_cs, &
-     & pcld_Anv_cs, tcld_Anv_cs, em_Anv_cs, &
-     & em_hist_cs, iwp_hist_cs, deltaz_hist_cs, rad_hist_cs)
-
-
-     
-        INTEGER :: i, n, nss
-
-        INTEGER, intent(in) :: len_cs
-        REAL, DIMENSION(:), intent(in) :: rneb_cs, temp_cs
-        REAL, DIMENSION(:), intent(in) :: emis_cs, iwco_cs, rad_cs
-        REAL, DIMENSION(:), intent(in) :: pres_cs, dz_cs, rhodz_cs
-
-        REAL, intent(out) :: cc_tot_cs, cc_hc_cs, cc_hist_cs, &
-     & cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs, &
-     & pcld_hc_cs, tcld_hc_cs, em_hc_cs, iwp_hc_cs, &
-     & pcld_Cb_cs, tcld_Cb_cs, em_Cb_cs, &
-     & pcld_ThCi_cs, tcld_ThCi_cs, em_ThCi_cs, &
-     & pcld_Anv_cs, tcld_Anv_cs, em_Anv_cs, &
-     & em_hist_cs, iwp_hist_cs, &
-     & deltaz_hc_cs, deltaz_hist_cs, rad_hist_cs
-
-        REAL, DIMENSION(len_cs) :: rneb_ord
-        REAL :: rneb_min
-
-        REAL, DIMENSION(:), allocatable :: s, s_hc, s_hist, rneb_max
-        REAL, DIMENSION(:), allocatable :: sCb, sThCi, sAnv
-        REAL, DIMENSION(:), allocatable :: iwp_ss, pcld_ss, tcld_ss,&
-     & emis_ss
-        REAL, DIMENSION(:), allocatable :: deltaz_ss, rad_ss
-
-        CHARACTER (len = 50)      :: modname = 'simu_airs.cloud_structure'
-        CHARACTER (len = 160)     :: abort_message
-        
-
-        write(lunout,*) 'dans cloud_structure'
-
-        call ordonne(len_cs, rneb_cs, rneb_ord)
-       
-
-! Definition des sous_sections
-
-        rneb_min = rneb_ord(1)
-        nss = 1
-
-        do i = 2, size(rneb_cs)
-        if (rneb_ord(i) .gt. rneb_min) then
-        nss = nss+1
-        rneb_min = rneb_ord(i)
-        endif
-        enddo
-
-        allocate (s(nss))
-        allocate (s_hc(nss))
-        allocate (s_hist(nss))
-        allocate (rneb_max(nss))
-        allocate (emis_ss(nss))
-        allocate (pcld_ss(nss))
-        allocate (tcld_ss(nss))
-        allocate (iwp_ss(nss))
-        allocate (deltaz_ss(nss))
-        allocate (rad_ss(nss))
-        allocate (sCb(nss))
-        allocate (sThCi(nss))
-        allocate (sAnv(nss))
-
-        rneb_min = rneb_ord(1)
-        n = 1
-        s(1) = rneb_ord(1)
-        s_hc(1) = rneb_ord(1)
-        s_hist(1) = rneb_ord(1)
-        sCb(1) = rneb_ord(1)
-        sThCi(1) = rneb_ord(1)
-        sAnv(1) = rneb_ord(1)
-
-        rneb_max(1) = rneb_ord(1)
-
-        do i = 2, size(rneb_cs)
-        if (rneb_ord(i) .gt. rneb_min) then
-        n = n+1
-        s(n) = rneb_ord(i)-rneb_min
-        s_hc(n) = rneb_ord(i)-rneb_min
-        s_hist(n) = rneb_ord(i)-rneb_min
-        sCb(n) = rneb_ord(i)-rneb_min
-        sThCi(n) = rneb_ord(i)-rneb_min
-        sAnv(n) = rneb_ord(i)-rneb_min
-
-        rneb_max(n) = rneb_ord(i)
-        rneb_min = rneb_ord(i)
-        endif
-        enddo
-
-! Appel de sous_section
-
-        do i = 1, nss
-         call sous_section(len_cs, rneb_cs, temp_cs, &
-     &  emis_cs, iwco_cs, &
-     &  pres_cs, dz_cs, rhodz_cs, rad_cs, rneb_ord, &
-     &  rneb_max(i),s(i),s_hc(i),s_hist(i), &
-     &  sCb(i), sThCi(i), sAnv(i), &
-     &  emis_ss(i), &
-     &  pcld_ss(i), tcld_ss(i), iwp_ss(i), deltaz_ss(i), rad_ss(i))
-        enddo
-
-! Caracteristiques de la structure nuageuse
-
-        cc_tot_cs = 0.
-        cc_hc_cs = 0.
-        cc_hist_cs = 0.
-
-        cc_Cb_cs = 0.
-        cc_ThCi_cs = 0.
-        cc_Anv_cs = 0.
-
-        em_hc_cs = 0.
-        iwp_hc_cs = 0.
-        deltaz_hc_cs = 0.
-
-        em_hist_cs = 0.
-        iwp_hist_cs = 0.
-        deltaz_hist_cs = 0.
-        rad_hist_cs = 0.
-
-        pcld_hc_cs = 0.
-        tcld_hc_cs = 0.
-
-        pcld_Cb_cs = 0.
-        tcld_Cb_cs = 0.
-        em_Cb_cs = 0.
-
-        pcld_ThCi_cs = 0.
-        tcld_ThCi_cs = 0.
-        em_ThCi_cs = 0.
-
-        pcld_Anv_cs = 0.
-        tcld_Anv_cs = 0.
-        em_Anv_cs = 0.
-
-         do i = 1, nss
-
-        cc_tot_cs = cc_tot_cs + s(i)
-        cc_hc_cs = cc_hc_cs + s_hc(i)
-        cc_hist_cs = cc_hist_cs + s_hist(i)
-
-        cc_Cb_cs = cc_Cb_cs + sCb(i)
-        cc_ThCi_cs = cc_ThCi_cs + sThCi(i)
-        cc_Anv_cs = cc_Anv_cs + sAnv(i)
-
-        iwp_hc_cs = iwp_hc_cs + s_hc(i)*iwp_ss(i)
-        em_hc_cs = em_hc_cs + s_hc(i)*emis_ss(i)
-        deltaz_hc_cs = deltaz_hc_cs + s_hc(i)*deltaz_ss(i)
-
-        iwp_hist_cs = iwp_hist_cs + s_hist(i)*iwp_ss(i)
-        em_hist_cs = em_hist_cs + s_hist(i)*emis_ss(i)
-        deltaz_hist_cs = deltaz_hist_cs + s_hist(i)*deltaz_ss(i)
-        rad_hist_cs = rad_hist_cs + s_hist(i)*rad_ss(i)
-
-        pcld_hc_cs = pcld_hc_cs + s_hc(i)*pcld_ss(i)
-        tcld_hc_cs = tcld_hc_cs + s_hc(i)*tcld_ss(i)
-
-        pcld_Cb_cs = pcld_Cb_cs + sCb(i)*pcld_ss(i)
-        tcld_Cb_cs = tcld_Cb_cs + sCb(i)*tcld_ss(i)
-        em_Cb_cs = em_Cb_cs + sCb(i)*emis_ss(i)
-
-        pcld_ThCi_cs = pcld_ThCi_cs + sThCi(i)*pcld_ss(i)
-        tcld_ThCi_cs = tcld_ThCi_cs + sThCi(i)*tcld_ss(i)
-        em_ThCi_cs = em_ThCi_cs + sThCi(i)*emis_ss(i)
-
-        pcld_Anv_cs = pcld_Anv_cs + sAnv(i)*pcld_ss(i)
-        tcld_Anv_cs = tcld_Anv_cs + sAnv(i)*tcld_ss(i)
-        em_Anv_cs = em_Anv_cs + sAnv(i)*emis_ss(i)
-
-        enddo
-
-        deallocate(s)
-        deallocate (s_hc)
-        deallocate (s_hist)
-        deallocate (rneb_max)
-        deallocate (emis_ss)
-        deallocate (pcld_ss)
-        deallocate (tcld_ss)
-        deallocate (iwp_ss)
-        deallocate (deltaz_ss)
-        deallocate (rad_ss)
-        deallocate (sCb)
-        deallocate (sThCi)
-        deallocate (sAnv)
-
-       call normal_undef(pcld_hc_cs,cc_hc_cs)
-       call normal_undef(tcld_hc_cs,cc_hc_cs)
-       call normal_undef(iwp_hc_cs,cc_hc_cs)
-       call normal_undef(em_hc_cs,cc_hc_cs)
-       call normal_undef(deltaz_hc_cs,cc_hc_cs)
-       
-       call normal_undef(iwp_hist_cs,cc_hist_cs)
-       call normal_undef(em_hist_cs,cc_hist_cs)
-       call normal_undef(deltaz_hist_cs,cc_hist_cs)
-       call normal_undef(rad_hist_cs,cc_hist_cs)
-
-       call normal_undef(pcld_Cb_cs,cc_Cb_cs)
-       call normal_undef(tcld_Cb_cs,cc_Cb_cs)
-       call normal_undef(em_Cb_cs,cc_Cb_cs)
-
-       call normal_undef(pcld_ThCi_cs,cc_ThCi_cs)
-       call normal_undef(tcld_ThCi_cs,cc_ThCi_cs)
-       call normal_undef(em_ThCi_cs,cc_ThCi_cs)
-    
-       call normal_undef(pcld_Anv_cs,cc_Anv_cs)
-       call normal_undef(tcld_Anv_cs,cc_Anv_cs)
-       call normal_undef(em_Anv_cs,cc_Anv_cs)
-
-
-! Tests
-
-        if (cc_tot_cs .gt. maxval(rneb_cs) .and. &
-     & abs(cc_tot_cs-maxval(rneb_cs)) .gt. 1.e-4 )  then
-          WRITE(abort_message,*) 'cc_tot_cs > max rneb_cs', cc_tot_cs, maxval(rneb_cs)
-          CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (iwp_hc_cs .lt. 0.) then
-          abort_message= 'cloud_structure: iwp_hc_cs < 0'
-          CALL abort_physic(modname,abort_message,1)
-        endif
- 
-        end subroutine cloud_structure
-
-
-        subroutine normal_undef(num, den)
-
-        REAL, intent(in) :: den
-        REAL, intent(inout) :: num
-
-        if (den .ne. 0) then
-        num = num/den
-        else
-        num = undef
-        endif
-
-        end subroutine normal_undef
-
-
-        subroutine normal2_undef(res,num,den)
-
-        REAL, intent(in) :: den
-        REAL, intent(in) :: num
-        REAL, intent(out) :: res
-
-        if (den .ne. 0.) then
-        res = num/den
-        else
-        res = undef
-        endif
-
-        end subroutine normal2_undef
-
-
-        subroutine sous_section(len_cs, rneb_cs, temp_cs, &
-     & emis_cs, iwco_cs, &
-     & pres_cs, dz_cs, rhodz_cs, rad_cs, rneb_ord, &
-     & rnebmax, stot, shc, shist, &
-     & sCb, sThCi, sAnv, &
-     & emis, pcld, tcld, iwp, deltaz, rad)
-
-        INTEGER, intent(in) :: len_cs
-        REAL, DIMENSION(len_cs), intent(in) :: rneb_cs, temp_cs
-        REAL, DIMENSION(len_cs), intent(in) :: emis_cs, iwco_cs, &
-     & rneb_ord
-        REAL, DIMENSION(len_cs), intent(in) :: pres_cs, dz_cs, rad_cs
-        REAL, DIMENSION(len_cs), intent(in) :: rhodz_cs
-        REAL, DIMENSION(len_cs) :: tau_cs, w
-        REAL, intent(in) :: rnebmax
-        REAL, intent(inout) :: stot, shc, shist
-        REAL, intent(inout) :: sCb, sThCi, sAnv
-        REAL, intent(out) :: emis, pcld, tcld, iwp, deltaz, rad
-
-        INTEGER :: i, ideb, ibeg, iend, nuage, visible
-        REAL :: som, som_tau, som_iwc, som_dz, som_rad, tau
-
-        CHARACTER (len = 50)      :: modname = 'simu_airs.sous_section'
-        CHARACTER (len = 160)     :: abort_message
-
-
-! Ponderation: 1 pour les nuages, 0 pour les trous
-
-        do i = 1, len_cs
-        if (rneb_cs(i) .ge. rnebmax) then
-        w(i) = 1.
-        else
-        w(i) = 0.
-        endif
-        enddo
-
-! Calcul des epaisseurs optiques a partir des emissivites
-
-        som = 0.
-        do i = 1, len_cs
-        if (emis_cs(i) .eq. 1.) then
-        tau_cs(i) = 10.
-        else
-        tau_cs(i) = -log(1.-emis_cs(i))
-        endif
-        som = som+tau_cs(i)
-        enddo
-
-
-        ideb = 1
-        nuage = 0
-        visible = 0
-
-
-! Boucle sur les nuages
-        do while (ideb .ne. 0 .and. ideb .le. len_cs)   
-
-
-! Definition d'un nuage de la sous-section
-
-        call topbot(ideb, w, ibeg, iend)
-        ideb = iend+1
-
-        if (ibeg .gt. 0) then
-
-        nuage = nuage + 1
-
-! On determine les caracteristiques du nuage
-! (ep. optique, ice water path, pression, temperature)
-
-        call caract(ibeg, iend, temp_cs, tau_cs, iwco_cs, &
-     & pres_cs, dz_cs, rhodz_cs, rad_cs, pcld, tcld, &
-     & som_tau, som_iwc, som_dz, som_rad)
-
-! On masque le nuage s'il n'est pas detectable
-
-        call masque(ibeg, iend, som_tau, visible, w)
-
-        endif
-
-! Fin boucle nuages
-        enddo
-
-
-! Analyse du nuage detecte
-
-        call topbot(1, w, ibeg, iend)
-
-        if (ibeg .gt. 0) then
-
-        call caract(ibeg, iend, temp_cs, tau_cs, iwco_cs, &
-     & pres_cs, dz_cs, rhodz_cs, rad_cs, pcld, tcld, &
-     & som_tau, som_iwc, som_dz, som_rad)
-
-        tau = som_tau
-        emis = 1. - exp(-tau)
-        iwp = som_iwc
-        deltaz = som_dz
-        rad = som_rad
-
-        if (pcld .gt. p_thresh) then
-
-        shc = 0.
-        shist = 0.
-        sCb = 0.
-        sThCi = 0.
-        sAnv = 0.
-
-        else
-
-        if (emis .lt. em_min .or. emis .gt. em_max  &
-     & .or. tcld .gt. 230.) then
-        shist = 0.
-        endif
-
-        if (emis .lt. 0.98) then
-        sCb = 0.
-        endif
-
-        if (emis .gt. 0.5 .or. emis .lt. 0.1) then
-        sThCi = 0.
-        endif
-
-        if (emis .le. 0.5 .or. emis .ge. 0.98) then
-        sAnv = 0.
-        endif
-
-        endif
-
-        else
-
-        tau = 0.
-        emis = 0.
-        iwp = 0.
-        deltaz = 0.
-        pcld = 0.
-        tcld = 0.
-        stot = 0.
-        shc = 0.
-        shist = 0.
-        rad = 0.
-        sCb = 0.
-        sThCi = 0.
-        sAnv = 0.
-
-        endif
-
-
-! Tests
-
-        if (iwp .lt. 0.) then
-          WRITE(abort_message,*) 'ideb iwp =', ideb, iwp
-          CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (deltaz .lt. 0.) then
-          WRITE(abort_message,*)'ideb deltaz =', ideb, deltaz
-          CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (emis .lt. 0.048 .and. emis .ne. 0.) then
-          WRITE(abort_message,*) 'ideb emis =', ideb, emis
-          CALL abort_physic(modname,abort_message,1)
-        endif
-
-        end subroutine sous_section
-
-
-        subroutine masque (ibeg, iend, som_tau, &
-     & visible, w)
-
-        INTEGER, intent(in) :: ibeg, iend
-        REAL, intent(in) :: som_tau
-
-        INTEGER, intent(inout) :: visible
-        REAL, DIMENSION(:), intent(inout) :: w
-
-        INTEGER :: i
-
-
-
-! Masque
-
-! Cas ou il n'y a pas de nuage visible au-dessus
-
-        if (visible .eq. 0) then
-
-        if (som_tau .lt. tau_thresh) then
-        do i = ibeg, iend
-        w(i) = 0.
-        enddo
-        else
-        visible = 1
-        endif
-
-! Cas ou il y a un nuage visible au-dessus
-
-        else
-
-        do i = ibeg, iend
-        w(i) = 0.
-        enddo
-
-        endif
-
-
-        end subroutine masque
-
-
-         subroutine caract (ibeg, iend, temp_cs, tau_cs, iwco_cs, &
-     & pres_cs, dz_cs, rhodz_cs, rad_cs, pcld, tcld, &
-     & som_tau, som_iwc, som_dz, som_rad)
-
-        INTEGER, intent(in) :: ibeg, iend
-        REAL, DIMENSION(:), intent(in) :: tau_cs, iwco_cs, temp_cs
-        REAL, DIMENSION(:), intent(in) :: pres_cs, dz_cs, rad_cs
-        REAL, DIMENSION(:), intent(in) :: rhodz_cs
-        REAL, intent(out) :: som_tau, som_iwc, som_dz, som_rad
-        REAL , intent(out) :: pcld, tcld
-
-        INTEGER :: i, ibase, imid
-
-        CHARACTER (len = 50)      :: modname = 'simu_airs.caract'
-        CHARACTER (len = 160)     :: abort_message
-
-! Somme des epaisseurs optiques et des contenus en glace sur le nuage
-
-        som_tau = 0.
-        som_iwc = 0.
-        som_dz = 0.
-        som_rad = 0.
-        ibase = -100
-
-        do i = ibeg, iend
-
-        som_tau = som_tau + tau_cs(i)
-
-        som_dz = som_dz + dz_cs(i)
-        som_iwc = som_iwc + iwco_cs(i)*1000*rhodz_cs(i)  ! en g/m2
-        som_rad = som_rad + rad_cs(i)*dz_cs(i)
-
-        if (som_tau .gt. 3. .and. ibase .eq. -100) then
-        ibase = i-1
-        endif
-
-        enddo
-
-        if (som_dz .ne. 0.) then
-          som_rad = som_rad/som_dz
-        else
-          write(*,*) 'som_dez = 0 STOP'
-          write(*,*) 'ibeg, iend =', ibeg, iend
-          do i = ibeg, iend
-             write(*,*) dz_cs(i), rhodz_cs(i)
-          enddo
-          abort_message='see above'
-          CALL abort_physic(modname,abort_message,1)
-        endif
-
-! Determination de Pcld et Tcld
-
-       if (ibase .lt. ibeg) then
-       ibase = ibeg
-       endif
-
-       imid = (ibeg+ibase)/2
-
-       pcld = pres_cs(imid)/100.        ! pcld en hPa
-       tcld = temp_cs(imid)
-
-
-       end subroutine caract
- 
-        subroutine topbot(ideb,w,ibeg,iend)
-
-        INTEGER, intent(in) :: ideb
-        REAL, DIMENSION(:), intent(in) :: w
-        INTEGER, intent(out) :: ibeg, iend
-
-        INTEGER :: i, itest
-
-        itest = 0
-        ibeg = 0
-        iend = 0
-
-        do i = ideb, size(w)
-
-        if (w(i) .eq. 1. .and. itest .eq. 0) then
-        ibeg = i
-        itest = 1
-        endif
-
-        enddo
-
-
-        i = ibeg
-        do while (w(i) .eq. 1. .and. i .le. size(w))
-        i = i+1
-        enddo
-        iend = i-1
-
-
-        end subroutine topbot
-
-        subroutine ordonne(len_cs, rneb_cs, rneb_ord)
-
-        INTEGER, intent(in) :: len_cs
-        REAL, DIMENSION(:), intent(in) :: rneb_cs
-        REAL, DIMENSION(:), intent(out) :: rneb_ord
-
-        INTEGER :: i, j, ind_min
-
-        REAL, DIMENSION(len_cs) :: rneb
-        REAL :: rneb_max
-
-
-        do i = 1, size(rneb_cs)
-        rneb(i) = rneb_cs(i)
-        enddo
-
-        do j = 1, size(rneb_cs)
-
-        rneb_max = 100.
-
-        do i = 1, size(rneb_cs)
-        if (rneb(i) .lt. rneb_max) then
-        rneb_max = rneb(i)
-        ind_min = i
-        endif
-        enddo
-
-        rneb_ord(j) = rneb_max
-        rneb(ind_min) = 100.
-
-        enddo
-        
-        end subroutine ordonne
-
- 
-        subroutine sim_mesh(rneb_1D, temp_1D, emis_1D, &
-     & iwcon_1D, rad_1D, &
-     & pres, dz, &
-     & rhodz_1D, cc_tot_mesh, cc_hc_mesh, cc_hist_mesh, pcld_hc_mesh,&
-     & tcld_hc_mesh, &
-     & em_hc_mesh, iwp_hc_mesh, deltaz_hc_mesh, &
-     & cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh, &
-     & pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh, &
-     & pcld_ThCi_mesh, tcld_ThCi_mesh, em_ThCi_mesh, &
-     & pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh, &
-     & em_hist_mesh, iwp_hist_mesh, deltaz_hist_mesh, rad_hist_mesh)
-
-       USE dimphy
-
-       REAL, DIMENSION(klev), intent(in) :: rneb_1D, temp_1D, emis_1D, &
-     & iwcon_1D, rad_1D
-        REAL, DIMENSION(klev), intent(in) :: pres, dz, rhodz_1D
-        REAL, intent(out) :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
-        REAL, intent(out) :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
-        REAL, intent(out) :: em_hc_mesh, pcld_hc_mesh, tcld_hc_mesh, &
-     & iwp_hc_mesh
-
-        REAL, intent(out) :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
-        REAL, intent(out) :: pcld_ThCi_mesh, tcld_ThCi_mesh, &
-     & em_ThCi_mesh
-        REAL, intent(out) :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
-
-        REAL, intent(out) :: em_hist_mesh, iwp_hist_mesh, rad_hist_mesh
-        REAL, intent(out) :: deltaz_hc_mesh, deltaz_hist_mesh
-
-        REAL, DIMENSION(:), allocatable :: rneb_cs, temp_cs, emis_cs, &
-     & iwco_cs
-        REAL, DIMENSION(:), allocatable :: pres_cs, dz_cs, rad_cs, &
-     & rhodz_cs
-
-        INTEGER :: i,j,l
-        INTEGER :: ltop, itop, ibot, num_cs, N_cs, len_cs, ics
-
-        REAL :: som_emi_hc,som_pcl_hc,som_tcl_hc,som_iwp_hc,som_hc,&
-     & som_hist
-        REAL :: som_emi_hist, som_iwp_hist, som_deltaz_hc, &
-     & som_deltaz_hist
-        REAL :: som_rad_hist
-        REAL :: som_Cb, som_ThCi, som_Anv
-        REAL :: som_emi_Cb, som_tcld_Cb, som_pcld_Cb
-        REAL :: som_emi_Anv, som_tcld_Anv, som_pcld_Anv
-        REAL :: som_emi_ThCi, som_tcld_ThCi, som_pcld_ThCi
-        REAL :: tsom_tot, tsom_hc, tsom_hist
-        REAL :: prod, prod_hh
-
-        REAL :: cc_tot_cs, cc_hc_cs, cc_hist_cs
-        REAL :: cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs
-        REAL :: pcld_hc_cs, tcld_hc_cs
-        REAL :: em_hc_cs, iwp_hc_cs, deltaz_hc_cs
-        REAL :: pcld_Cb_cs, tcld_Cb_cs, em_Cb_cs
-        REAL :: pcld_ThCi_cs, tcld_ThCi_cs, em_ThCi_cs
-        REAL :: pcld_Anv_cs, tcld_Anv_cs, em_Anv_cs
-        REAL :: em_hist_cs, iwp_hist_cs, deltaz_hist_cs, rad_hist_cs
-
-        REAL, DIMENSION(klev) :: test_tot, test_hc, test_hist
-        REAL, DIMENSION(klev) :: test_pcld, test_tcld, test_em, test_iwp
-
-        CHARACTER (len = 50)      :: modname = 'simu_airs.sim_mesh'
-        CHARACTER (len = 160)     :: abort_message
-        
-
-        do j = 1, klev
-          WRITE(lunout,*) 'simu_airs, j, rneb_1D =', rneb_1D(j)
-        enddo
-
-! Definition des structures nuageuses, de la plus haute a la plus basse
-
-        num_cs = 0
-        ltop = klev-1
-
-        prod = 1.
-
-        som_emi_hc = 0.
-        som_emi_hist = 0.
-        som_pcl_hc = 0.
-        som_tcl_hc = 0.
-        som_iwp_hc = 0.
-        som_iwp_hist = 0.
-        som_deltaz_hc = 0.
-        som_deltaz_hist = 0.
-        som_rad_hist = 0.
-        som_hc = 0.
-        som_hist = 0.
-
-        som_Cb = 0.
-        som_ThCi = 0.
-        som_Anv = 0.
-
-        som_emi_Cb = 0.
-        som_pcld_Cb = 0.
-        som_tcld_Cb = 0.
-
-        som_emi_ThCi = 0.
-        som_pcld_ThCi = 0.
-        som_tcld_ThCi = 0.
-
-        som_emi_Anv = 0.
-        som_pcld_Anv = 0.
-        som_tcld_Anv = 0.
-
-        tsom_tot = 0.
-        tsom_hc = 0.
-        tsom_hist = 0.
-
-        do while (ltop .ge. 1)   ! Boucle sur toute la colonne
-
-        itop = 0
-
-        do l = ltop,1,-1
-
-        if (itop .eq. 0 .and. rneb_1D(l) .gt. 0.001 ) then
-        itop = l
-        endif
-
-        enddo
-
-        ibot = itop
-
-        do while (rneb_1D(ibot) .gt. 0.001 .and. ibot .ge. 1)
-        ibot = ibot -1
-        enddo
-
-
-        ibot = ibot+1
-
-        if (itop .gt. 0) then    ! itop > 0
-
-        num_cs = num_cs +1
-        len_cs = itop-ibot+1
-
-! Allocation et definition des variables de la structure nuageuse
-! le premier indice denote ce qui est le plus haut
-
-        allocate (rneb_cs(len_cs))
-        allocate (temp_cs(len_cs))
-        allocate (emis_cs(len_cs))
-        allocate (iwco_cs(len_cs))
-        allocate (pres_cs(len_cs))
-        allocate (dz_cs(len_cs))
-        allocate (rad_cs(len_cs))
-        allocate (rhodz_cs(len_cs))
-
-        ics = 0
-
-        do i = itop, ibot, -1
-        ics = ics + 1
-        rneb_cs(ics) = rneb_1D(i)
-        temp_cs(ics) = temp_1D(i)
-        emis_cs(ics) = emis_1D(i)
-        iwco_cs(ics) = iwcon_1D(i)
-        rad_cs(ics) = rad_1D(i)
-        pres_cs(ics) = pres(i)
-        dz_cs(ics) = dz(i)
-        rhodz_cs(ics) = rhodz_1D(i)
-        enddo
-
-! Appel du sous_programme cloud_structure
-
-        call cloud_structure(len_cs,rneb_cs,temp_cs,emis_cs,iwco_cs,&
-     & pres_cs, dz_cs, rhodz_cs, rad_cs, &
-     & cc_tot_cs, cc_hc_cs, cc_hist_cs, &
-     & cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs, &
-     & pcld_hc_cs, tcld_hc_cs, &
-     & em_hc_cs, iwp_hc_cs, deltaz_hc_cs, &
-     & pcld_Cb_cs, tcld_Cb_cs, em_Cb_cs, &
-     & pcld_ThCi_cs, tcld_ThCi_cs, em_ThCi_cs, &
-     & pcld_Anv_cs, tcld_Anv_cs, em_Anv_cs, &
-     & em_hist_cs, iwp_hist_cs, deltaz_hist_cs, rad_hist_cs)
-
-
-        deallocate (rneb_cs)
-        deallocate (temp_cs)
-        deallocate (emis_cs)
-        deallocate (iwco_cs)
-        deallocate (pres_cs)
-        deallocate (dz_cs)
-        deallocate (rad_cs)
-        deallocate (rhodz_cs)
-
-
-! Pour la couverture nuageuse sur la maille
-
-        prod_hh = prod
-
-        prod = prod*(1.-cc_tot_cs)
-
-! Pour les autres variables definies sur la maille
-
-        som_emi_hc = som_emi_hc + em_hc_cs*cc_hc_cs*prod_hh
-        som_iwp_hc = som_iwp_hc + iwp_hc_cs*cc_hc_cs*prod_hh
-        som_deltaz_hc = som_deltaz_hc + deltaz_hc_cs*cc_hc_cs*prod_hh
-
-        som_emi_Cb = som_emi_Cb + em_Cb_cs*cc_Cb_cs*prod_hh
-        som_tcld_Cb = som_tcld_Cb + tcld_Cb_cs*cc_Cb_cs*prod_hh
-        som_pcld_Cb = som_pcld_Cb + pcld_Cb_cs*cc_Cb_cs*prod_hh
-
-        som_emi_ThCi = som_emi_ThCi + em_ThCi_cs*cc_ThCi_cs*prod_hh
-        som_tcld_ThCi = som_tcld_ThCi + tcld_ThCi_cs*cc_ThCi_cs*prod_hh
-        som_pcld_ThCi = som_pcld_ThCi + pcld_ThCi_cs*cc_ThCi_cs*prod_hh
-
-        som_emi_Anv = som_emi_Anv + em_Anv_cs*cc_Anv_cs*prod_hh
-        som_tcld_Anv = som_tcld_Anv + tcld_Anv_cs*cc_Anv_cs*prod_hh
-        som_pcld_Anv = som_pcld_Anv + pcld_Anv_cs*cc_Anv_cs*prod_hh
-
-        som_emi_hist = som_emi_hist + em_hist_cs*cc_hist_cs*prod_hh
-        som_iwp_hist = som_iwp_hist + iwp_hist_cs*cc_hist_cs*prod_hh
-        som_deltaz_hist = som_deltaz_hist + &
-     & deltaz_hist_cs*cc_hist_cs*prod_hh
-        som_rad_hist = som_rad_hist + rad_hist_cs*cc_hist_cs*prod_hh
-
-        som_pcl_hc = som_pcl_hc + pcld_hc_cs*cc_hc_cs*prod_hh
-        som_tcl_hc = som_tcl_hc + tcld_hc_cs*cc_hc_cs*prod_hh
-
-        som_hc = som_hc + cc_hc_cs*prod_hh
-        som_hist = som_hist + cc_hist_cs*prod_hh
-
-        som_Cb = som_Cb + cc_Cb_cs*prod_hh
-        som_ThCi = som_ThCi + cc_ThCi_cs*prod_hh
-        som_Anv = som_Anv + cc_Anv_cs*prod_hh
-
-
-! Pour test
-        
-        call test_bornes('cc_tot_cs     ',cc_tot_cs,1.,0.)
-        call test_bornes('cc_hc_cs      ',cc_hc_cs,1.,0.)
-        call test_bornes('cc_hist_cs    ',cc_hist_cs,1.,0.)
-        call test_bornes('pcld_hc_cs    ',pcld_hc_cs,1200.,0.)
-        call test_bornes('tcld_hc_cs    ',tcld_hc_cs,1000.,100.)
-        call test_bornes('em_hc_cs      ',em_hc_cs,1000.,0.048)
-
-        test_tot(num_cs) = cc_tot_cs
-        test_hc(num_cs) = cc_hc_cs
-        test_hist(num_cs) = cc_hist_cs
-        test_pcld(num_cs) = pcld_hc_cs
-        test_tcld(num_cs) = tcld_hc_cs
-        test_em(num_cs) = em_hc_cs
-        test_iwp(num_cs) = iwp_hc_cs
-
-        tsom_tot = tsom_tot + cc_tot_cs
-        tsom_hc = tsom_hc + cc_hc_cs
-        tsom_hist = tsom_hist + cc_hist_cs
-
-
-        endif                   ! itop > 0
-
-        ltop = ibot -1
-
-        enddo                   ! fin de la boucle sur la colonne
-
-        N_CS = num_cs
-
-
-! Determination des variables de sortie
-
-        if (N_CS .gt. 0) then   ! if N_CS>0
-
-        cc_tot_mesh = 1. - prod
-
-        cc_hc_mesh = som_hc
-        cc_hist_mesh = som_hist
-
-        cc_Cb_mesh = som_Cb
-        cc_ThCi_mesh = som_ThCi
-        cc_Anv_mesh = som_Anv
-
-        call normal2_undef(pcld_hc_mesh,som_pcl_hc, &
-     & cc_hc_mesh)
-        call normal2_undef(tcld_hc_mesh,som_tcl_hc, &
-     & cc_hc_mesh)
-        call normal2_undef(em_hc_mesh,som_emi_hc, &
-     & cc_hc_mesh)
-        call normal2_undef(iwp_hc_mesh,som_iwp_hc, &
-     & cc_hc_mesh)
-        call normal2_undef(deltaz_hc_mesh,som_deltaz_hc, &
-     & cc_hc_mesh)
-
-        call normal2_undef(em_Cb_mesh,som_emi_Cb, &
-     & cc_Cb_mesh)
-        call normal2_undef(tcld_Cb_mesh,som_tcld_Cb, &
-     & cc_Cb_mesh)
-        call normal2_undef(pcld_Cb_mesh,som_pcld_Cb, &
-     & cc_Cb_mesh)
-
-        call normal2_undef(em_ThCi_mesh,som_emi_ThCi, &
-     & cc_ThCi_mesh)
-        call normal2_undef(tcld_ThCi_mesh,som_tcld_ThCi, &
-     & cc_ThCi_mesh)
-        call normal2_undef(pcld_ThCi_mesh,som_pcld_ThCi, &
-     & cc_ThCi_mesh)
-
-       call normal2_undef(em_Anv_mesh,som_emi_Anv, &
-     & cc_Anv_mesh)
-        call normal2_undef(tcld_Anv_mesh,som_tcld_Anv, &
-     & cc_Anv_mesh)
-        call normal2_undef(pcld_Anv_mesh,som_pcld_Anv, &
-     & cc_Anv_mesh)
-
-
-        call normal2_undef(em_hist_mesh,som_emi_hist, &
-     & cc_hist_mesh)
-        call normal2_undef(iwp_hist_mesh,som_iwp_hist, &
-     & cc_hist_mesh)
-        call normal2_undef(deltaz_hist_mesh,som_deltaz_hist, &
-     & cc_hist_mesh)
-        call normal2_undef(rad_hist_mesh,som_rad_hist, &
-     & cc_hist_mesh)
-
-
-! Tests 
-
-        ! Tests
-
-       if (cc_tot_mesh .gt. tsom_tot .and. &
-     & abs(cc_tot_mesh-tsom_tot) .gt. 1.e-4) then
-           WRITE(abort_message,*)'cc_tot_mesh > tsom_tot', cc_tot_mesh, tsom_tot
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (cc_tot_mesh .lt. maxval(test_tot(1:N_CS)) .and. &
-     & abs(cc_tot_mesh-maxval(test_tot(1:N_CS))) .gt. 1.e-4) then
-           WRITE(abort_message,*) 'cc_tot_mesh < max', cc_tot_mesh, maxval(test_tot(1:N_CS))
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (cc_hc_mesh .gt. tsom_hc .and. &
-     & abs(cc_hc_mesh-tsom_hc) .gt. 1.e-4) then
-           WRITE(abort_message,*) 'cc_hc_mesh > tsom_hc', cc_hc_mesh, tsom_hc
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (cc_hc_mesh .lt. maxval(test_hc(1:N_CS)) .and. &
-     & abs(cc_hc_mesh-maxval(test_hc(1:N_CS))) .gt. 1.e-4) then
-           WRITE(abort_message,*) 'cc_hc_mesh < max', cc_hc_mesh, maxval(test_hc(1:N_CS))
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (cc_hist_mesh .gt. tsom_hist .and. &
-     & abs(cc_hist_mesh-tsom_hist) .gt. 1.e-4) then
-           WRITE(abort_message,*) 'cc_hist_mesh > tsom_hist', cc_hist_mesh, tsom_hist
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if (cc_hist_mesh .lt. 0.) then
-           WRITE(abort_message,*) 'cc_hist_mesh < 0', cc_hist_mesh
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if ((pcld_hc_mesh .gt. maxval(test_pcld(1:N_CS)) .or. &
-     & pcld_hc_mesh .lt. minval(test_pcld(1:N_CS))) .and. &
-     & abs(pcld_hc_mesh-maxval(test_pcld(1:N_CS))) .gt. 1. .and. &
-     & maxval(test_pcld(1:N_CS)) .ne. 999. &
-     & .and. minval(test_pcld(1:N_CS)) .ne. 999.) then
-           WRITE(abort_message,*) 'pcld_hc_mesh est faux', pcld_hc_mesh, maxval(test_pcld(1:N_CS)), &
-     & minval(test_pcld(1:N_CS))
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-       if ((tcld_hc_mesh .gt. maxval(test_tcld(1:N_CS)) .or. &
-     & tcld_hc_mesh .lt. minval(test_tcld(1:N_CS))) .and. &
-     & abs(tcld_hc_mesh-maxval(test_tcld(1:N_CS))) .gt. 0.1 .and. &
-     & maxval(test_tcld(1:N_CS)) .ne. 999. &
-     & .and. minval(test_tcld(1:N_CS)) .ne. 999.) then
-           WRITE(abort_message,*) 'tcld_hc_mesh est faux', tcld_hc_mesh, maxval(test_tcld(1:N_CS)), &
-                & minval(test_tcld(1:N_CS))
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        if ((em_hc_mesh .gt. maxval(test_em(1:N_CS)) .or. &
-     & em_hc_mesh .lt. minval(test_em(1:N_CS))) .and. &
-     & abs(em_hc_mesh-maxval(test_em(1:N_CS))) .gt. 1.e-4 .and. &
-     & minval(test_em(1:N_CS)) .ne. 999. .and. &
-     & maxval(test_em(1:N_CS)) .ne. 999. ) then
-           WRITE(abort_message,*) 'em_hc_mesh est faux', em_hc_mesh, maxval(test_em(1:N_CS)), &
-     & minval(test_em(1:N_CS))
-           CALL abort_physic(modname,abort_message,1)
-        endif
-
-        else               ! if N_CS>0
-
-        cc_tot_mesh = 0.
-        cc_hc_mesh = 0.
-        cc_hist_mesh = 0.
-
-        cc_Cb_mesh = 0.
-        cc_ThCi_mesh = 0.
-        cc_Anv_mesh = 0.
-
-        iwp_hc_mesh = undef 
-        deltaz_hc_mesh = undef 
-        em_hc_mesh = undef 
-        iwp_hist_mesh = undef 
-        deltaz_hist_mesh = undef 
-        rad_hist_mesh = undef 
-        em_hist_mesh = undef 
-        pcld_hc_mesh = undef 
-        tcld_hc_mesh = undef 
-
-        pcld_Cb_mesh = undef 
-        tcld_Cb_mesh = undef 
-        em_Cb_mesh = undef 
-
-        pcld_ThCi_mesh = undef 
-        tcld_ThCi_mesh = undef 
-        em_ThCi_mesh = undef 
-
-        pcld_Anv_mesh = undef 
-        tcld_Anv_mesh = undef 
-        em_Anv_mesh = undef 
-
-
-        endif                  ! if N_CS>0
-
-        end subroutine sim_mesh
-
-        subroutine test_bornes(sx,x,bsup,binf)
-
-        REAL, intent(in) :: x, bsup, binf
-        character*14, intent(in) :: sx
-        CHARACTER (len = 50)      :: modname = 'simu_airs.test_bornes'
-        CHARACTER (len = 160)     :: abort_message
-
-        if (x .gt. bsup .or. x .lt. binf) then
-          WRITE(abort_message,*) sx, 'est faux', sx, x
-          CALL abort_physic(modname,abort_message,1)
-        endif
- 
-        end subroutine test_bornes
-
-        end module m_simu_airs
-
-
-        subroutine simu_airs &
-     & (itap, rneb_airs, temp_airs, cldemi_airs, iwcon0_airs, rad_airs, &
-     & geop_airs, pplay_airs, paprs_airs, &
-     & map_prop_hc,map_prop_hist,&
-     & map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
-     & map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
-     & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
-     & map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
-     & map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
-     & map_ntot,map_hc,map_hist,&
-     & map_Cb,map_ThCi,map_Anv,alt_tropo )
-
-        USE dimphy
-        USE m_simu_airs
-
-        IMPLICIT NONE
-
-        include "YOMCST.h"
-
-        INTEGER,intent(in) :: itap
-
-        REAL, DIMENSION(klon,klev), intent(in) :: &
-     & rneb_airs, temp_airs, cldemi_airs, iwcon0_airs, &
-     & rad_airs, geop_airs, pplay_airs, paprs_airs
-
-       REAL, DIMENSION(klon,klev) :: &
-     & rhodz_airs, rho_airs, iwcon_airs
-
-        REAL, DIMENSION(klon),intent(out) :: alt_tropo
-
-        REAL, DIMENSION(klev) :: rneb_1D, temp_1D, &
-     & emis_1D, rad_1D, pres_1D, alt_1D, &
-     & rhodz_1D, dz_1D, iwcon_1D
-
-        INTEGER :: i, j
-
-        REAL :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
-        REAL :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
-        REAL :: pcld_hc_mesh, tcld_hc_mesh, em_hc_mesh, iwp_hc_mesh
-        REAL :: em_hist_mesh, iwp_hist_mesh
-        REAL :: deltaz_hc_mesh, deltaz_hist_mesh, rad_hist_mesh
-        REAL :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
-        REAL :: pcld_ThCi_mesh, tcld_ThCi_mesh, em_ThCi_mesh
-        REAL :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
-
-        REAL, DIMENSION(klon),intent(out) :: map_prop_hc, map_prop_hist
-        REAL, DIMENSION(klon),intent(out) :: map_emis_hc, map_iwp_hc
-        REAL, DIMENSION(klon),intent(out) :: map_deltaz_hc, map_pcld_hc
-        REAL, DIMENSION(klon),intent(out) :: map_tcld_hc
-        REAL, DIMENSION(klon),intent(out) :: map_emis_Cb,map_pcld_Cb,map_tcld_Cb 
-        REAL, DIMENSION(klon),intent(out) :: &
-     & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi
-        REAL, DIMENSION(klon),intent(out) :: &
-     & map_emis_Anv,map_pcld_Anv,map_tcld_Anv
-        REAL, DIMENSION(klon),intent(out) :: &
-     & map_emis_hist,map_iwp_hist,map_deltaz_hist,&
-     & map_rad_hist
-        REAL, DIMENSION(klon),intent(out) :: map_ntot,map_hc,map_hist
-        REAL, DIMENSION(klon),intent(out) :: map_Cb,map_ThCi,map_Anv
- 
- 
-        write(*,*) 'simu_airs'
-        write(*,*) 'itap, klon, klev', itap, klon, klev
-        write(*,*) 'RG, RD =', RG, RD
-
-
-! Definition des variables 1D
-
-        do i = 1, klon
-        do j = 1, klev-1
-        rhodz_airs(i,j) = &
-     & (paprs_airs(i,j)-paprs_airs(i,j+1))/RG
-        enddo
-        rhodz_airs(i,klev) = 0.
-        enddo
-
-        do i = 1, klon
-        do j = 1,klev
-        rho_airs(i,j) = &
-     & pplay_airs(i,j)/(temp_airs(i,j)*RD)
-
-        if (rneb_airs(i,j) .gt. 0.001) then
-        iwcon_airs(i,j) = iwcon0_airs(i,j)/rneb_airs(i,j)
-        else
-        iwcon_airs(i,j) = 0.
-        endif
- 
-        enddo
-        enddo
-
-!=============================================================================
-
-        do i = 1, klon  ! boucle sur les points de grille
-
-!=============================================================================
-        
-        do j = 1,klev
-
-        rneb_1D(j) = rneb_airs(i,j)
-        temp_1D(j) = temp_airs(i,j)
-        emis_1D(j) = cldemi_airs(i,j)
-        iwcon_1D(j) = iwcon_airs(i,j)
-        rad_1D(j) = rad_airs(i,j)
-        pres_1D(j) = pplay_airs(i,j)
-        alt_1D(j) = geop_airs(i,j)/RG
-        rhodz_1D(j) = rhodz_airs(i,j)
-        dz_1D(j) = rhodz_airs(i,j)/rho_airs(i,j)
-
-        enddo
-
-        alt_tropo(i) = &
-     & search_tropopause(pres_1D/100.,temp_1D,alt_1D,klev)
-
-
-! Appel du ss-programme sim_mesh
-
-!        if (itap .eq. 1 ) then
-
-        call sim_mesh(rneb_1D, temp_1D, emis_1D, iwcon_1D, rad_1D, &
-     & pres_1D, dz_1D, rhodz_1D, &
-     & cc_tot_mesh, cc_hc_mesh, cc_hist_mesh, &
-     & pcld_hc_mesh, tcld_hc_mesh, em_hc_mesh, iwp_hc_mesh, &
-     & deltaz_hc_mesh,&
-     & cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh, &
-     & pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh, &
-     & pcld_ThCi_mesh, tcld_ThCi_mesh, em_ThCi_mesh, &
-     & pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh, &
-     & em_hist_mesh, iwp_hist_mesh, deltaz_hist_mesh, rad_hist_mesh)
-
-         write(*,*) '===================================='
-         write(*,*) 'itap, i:', itap, i 
-         write(*,*) 'cc_tot, cc_hc, cc_hist, pcld_hc, tcld_hc, em_hc, &
-     & iwp_hc, em_hist, iwp_hist ='
-         write(*,*) cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
-         write(*,*) pcld_hc_mesh, tcld_hc_mesh, em_hc_mesh, iwp_hc_mesh
-         write(*,*)  em_hist_mesh, iwp_hist_mesh
-
-!        endif
-
-! Definition des variables a ecrire dans le fichier de sortie
-
-        call normal2_undef(map_prop_hc(i),cc_hc_mesh, &
-     & cc_tot_mesh)
-        call normal2_undef(map_prop_hist(i),cc_hist_mesh, &
-     & cc_tot_mesh)
-
-       map_emis_hc(i) = em_hc_mesh
-       map_iwp_hc(i) = iwp_hc_mesh
-       map_deltaz_hc(i) = deltaz_hc_mesh
-       map_pcld_hc(i) = pcld_hc_mesh
-       map_tcld_hc(i) = tcld_hc_mesh
-
-       map_emis_Cb(i) = em_Cb_mesh
-       map_pcld_Cb(i) = pcld_Cb_mesh
-       map_tcld_Cb(i) = tcld_Cb_mesh
-
-       map_emis_ThCi(i) = em_ThCi_mesh
-       map_pcld_ThCi(i) = pcld_ThCi_mesh
-       map_tcld_ThCi(i) = tcld_ThCi_mesh
-
-       map_emis_Anv(i) = em_Anv_mesh
-       map_pcld_Anv(i) = pcld_Anv_mesh
-       map_tcld_Anv(i) = tcld_Anv_mesh
-
-       map_emis_hist(i) = em_hist_mesh
-       map_iwp_hist(i) = iwp_hist_mesh
-       map_deltaz_hist(i) = deltaz_hist_mesh
-       map_rad_hist(i) = rad_hist_mesh
-
-       map_ntot(i) = cc_tot_mesh
-       map_hc(i) = cc_hc_mesh
-       map_hist(i) = cc_hist_mesh
-
-       map_Cb(i) = cc_Cb_mesh
-       map_ThCi(i) = cc_ThCi_mesh
-       map_Anv(i) = cc_Anv_mesh
-
-
-        enddo         ! fin boucle sur les points de grille
-
-        
-
-        end subroutine simu_airs
-
+link ../phylmd/simu_airs.F90
Index: LMDZ6/trunk/libf/phylmdiso/slab_heat_transp_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/slab_heat_transp_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/slab_heat_transp_mod.F90	(revision 3940)
@@ -1,1131 +1,1 @@
-!
-MODULE slab_heat_transp_mod
-!
-! Slab ocean : temperature tendencies due to horizontal diffusion 
-! and / or Ekman transport
-
-USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
-IMPLICIT NONE
-
-  ! Variables copied over from dyn3d dynamics:
-  REAL,SAVE,ALLOCATABLE :: fext(:) ! Coriolis f times cell area
-  !$OMP THREADPRIVATE(fext)
-  REAL,SAVE,ALLOCATABLE :: beta(:) ! df/dy
-  !$OMP THREADPRIVATE(beta)
-  REAL,SAVE,ALLOCATABLE :: unsairez(:) ! 1/cell area
-  !$OMP THREADPRIVATE(unsairez)
-  REAL,SAVE,ALLOCATABLE :: unsaire(:)
-  !$OMP THREADPRIVATE(unsaire)
-  REAL,SAVE,ALLOCATABLE :: cu(:) ! cell longitude dim (m)
-  !$OMP THREADPRIVATE(cu)
-  REAL,SAVE,ALLOCATABLE :: cv(:) ! cell latitude dim (m)
-  !$OMP THREADPRIVATE(cv)
-  REAL,SAVE,ALLOCATABLE :: cuvsurcv(:) ! cu/cv (v points)
-  !$OMP THREADPRIVATE(cuvsurcv)
-  REAL,SAVE,ALLOCATABLE :: cvusurcu(:) ! cv/cu (u points)
-  !$OMP THREADPRIVATE(cvusurcu)
-  REAL,SAVE,ALLOCATABLE :: aire(:) ! cell area
-  !$OMP THREADPRIVATE(aire)
-  REAL,SAVE :: apoln ! area of north pole points
-  !$OMP THREADPRIVATE(apoln)
-  REAL,SAVE :: apols ! area of south pole points
-  !$OMP THREADPRIVATE(apols)
-  REAL,SAVE,ALLOCATABLE :: aireu(:) ! area of u cells 
-  !$OMP THREADPRIVATE(aireu)
-  REAL,SAVE,ALLOCATABLE :: airev(:) ! area of v cells
-  !$OMP THREADPRIVATE(airev)
-
-  ! Local parameters for slab transport
-  LOGICAL,SAVE :: alpha_var ! variable coef for deep temp (1 layer)
-  !$OMP THREADPRIVATE(alpha_var)
-  LOGICAL,SAVE :: slab_upstream ! upstream scheme ? (1 layer)
-  !$OMP THREADPRIVATE(slab_upstream)
-  LOGICAL,SAVE :: slab_sverdrup ! use wind stress curl at equator
-  !$OMP THREADPRIVATE(slab_sverdrup)
-  LOGICAL,SAVE :: slab_tyeq ! use merid wind stress at equator
-  !$OMP THREADPRIVATE(slab_tyeq)
-  LOGICAL,SAVE :: ekman_zonadv ! use zonal advection by Ekman currents
-  !$OMP THREADPRIVATE(ekman_zonadv)
-  LOGICAL,SAVE :: ekman_zonavg ! zonally average wind stress
-  !$OMP THREADPRIVATE(ekman_zonavg)
-
-  REAL,SAVE :: alpham
-  !$OMP THREADPRIVATE(alpham)
-  REAL,SAVE :: gmkappa
-  !$OMP THREADPRIVATE(gmkappa)
-  REAL,SAVE :: gm_smax
-  !$OMP THREADPRIVATE(gm_smax)
-
-! geometry variables : f, beta, mask...
-  REAL,SAVE,ALLOCATABLE :: zmasqu(:) ! continent mask for zonal mass flux
-  !$OMP THREADPRIVATE(zmasqu)
-  REAL,SAVE,ALLOCATABLE :: zmasqv(:) ! continent mask for merid mass flux
-  !$OMP THREADPRIVATE(zmasqv)
-  REAL,SAVE,ALLOCATABLE :: unsfv(:) ! 1/f, v points
-  !$OMP THREADPRIVATE(unsfv)
-  REAL,SAVE,ALLOCATABLE :: unsbv(:) ! 1/beta
-  !$OMP THREADPRIVATE(unsbv)
-  REAL,SAVE,ALLOCATABLE :: unsev(:) ! 1/epsilon (drag)
-  !$OMP THREADPRIVATE(unsev)
-  REAL,SAVE,ALLOCATABLE :: unsfu(:) ! 1/F, u points
-  !$OMP THREADPRIVATE(unsfu)
-  REAL,SAVE,ALLOCATABLE :: unseu(:)
-  !$OMP THREADPRIVATE(unseu)
-
-  ! Routines from dyn3d, valid on global dynamics grid only:
-  PRIVATE :: gr_fi_dyn, gr_dyn_fi ! to go between 1D nd 2D horiz grid
-  PRIVATE :: gr_scal_v,gr_v_scal,gr_scal_u ! change on 2D grid U,V, T points
-  PRIVATE :: grad,diverg
-
-CONTAINS
- 
-  SUBROUTINE ini_slab_transp_geom(ip1jm,ip1jmp1,unsairez_,fext_,unsaire_,&
-                                  cu_,cuvsurcv_,cv_,cvusurcu_, &
-                                  aire_,apoln_,apols_, &
-                                  aireu_,airev_,rlatv, rad, omeg)
-    ! number of points in lon, lat
-    IMPLICIT NONE
-    ! Routine copies some geometry variables from the dynamical core
-    ! see global vars for meaning
-    INTEGER,INTENT(IN) :: ip1jm
-    INTEGER,INTENT(IN) :: ip1jmp1
-    REAL,INTENT(IN) :: unsairez_(ip1jm)
-    REAL,INTENT(IN) :: fext_(ip1jm)
-    REAL,INTENT(IN) :: unsaire_(ip1jmp1)
-    REAL,INTENT(IN) :: cu_(ip1jmp1)
-    REAL,INTENT(IN) :: cuvsurcv_(ip1jm)
-    REAL,INTENT(IN) :: cv_(ip1jm)
-    REAL,INTENT(IN) :: cvusurcu_(ip1jmp1)
-    REAL,INTENT(IN) :: aire_(ip1jmp1)
-    REAL,INTENT(IN) :: apoln_
-    REAL,INTENT(IN) :: apols_
-    REAL,INTENT(IN) :: aireu_(ip1jmp1)
-    REAL,INTENT(IN) :: airev_(ip1jm)
-    REAL,INTENT(IN) :: rlatv(nbp_lat-1)
-    REAL,INTENT(IN) :: rad
-    REAL,INTENT(IN) :: omeg
-
-    CHARACTER (len = 20) :: modname = 'slab_heat_transp'
-    CHARACTER (len = 80) :: abort_message
-    
-    ! Sanity check on dimensions
-    if ((ip1jm.ne.((nbp_lon+1)*(nbp_lat-1))).or. &
-        (ip1jmp1.ne.((nbp_lon+1)*nbp_lat))) then
-      abort_message="ini_slab_transp_geom Error: wrong array sizes"
-      CALL abort_physic(modname,abort_message,1)
-    endif
-! Allocations could be done only on master process/thread...
-    allocate(unsairez(ip1jm))
-    unsairez(:)=unsairez_(:)
-    allocate(fext(ip1jm))
-    fext(:)=fext_(:)
-    allocate(unsaire(ip1jmp1))
-    unsaire(:)=unsaire_(:)
-    allocate(cu(ip1jmp1))
-    cu(:)=cu_(:)
-    allocate(cuvsurcv(ip1jm))
-    cuvsurcv(:)=cuvsurcv_(:)
-    allocate(cv(ip1jm))
-    cv(:)=cv_(:)
-    allocate(cvusurcu(ip1jmp1))
-    cvusurcu(:)=cvusurcu_(:)
-    allocate(aire(ip1jmp1))
-    aire(:)=aire_(:)
-    apoln=apoln_
-    apols=apols_
-    allocate(aireu(ip1jmp1))
-    aireu(:)=aireu_(:)
-    allocate(airev(ip1jm))
-    airev(:)=airev_(:) 
-    allocate(beta(nbp_lat-1))
-    beta(:)=2*omeg*cos(rlatv(:))/rad
-
-  END SUBROUTINE ini_slab_transp_geom
-
-  SUBROUTINE ini_slab_transp(zmasq)
-
-!    USE ioipsl_getin_p_mod, only: getin_p
-    USE IOIPSL, ONLY : getin 
-    IMPLICIT NONE
-
-    REAL zmasq(klon_glo) ! ocean / continent mask, 1=continent
-    REAL zmasq_2d((nbp_lon+1)*nbp_lat)
-    REAL ff((nbp_lon+1)*(nbp_lat-1)) ! Coriolis parameter
-    REAL eps ! epsilon friction timescale (s-1)
-    INTEGER :: slab_ekman 
-    INTEGER i
-    INTEGER :: iim,iip1,jjp1,ip1jm,ip1jmp1
-
-! Some definition for grid size
-    ip1jm=(nbp_lon+1)*(nbp_lat-1)
-    ip1jmp1=(nbp_lon+1)*nbp_lat
-    iim=nbp_lon
-    iip1=nbp_lon+1
-    jjp1=nbp_lat
-    ip1jm=(nbp_lon+1)*(nbp_lat-1)
-    ip1jmp1=(nbp_lon+1)*nbp_lat
-
-! Options for Heat transport
-    ! Alpha variable?
-      alpha_var=.FALSE.
-      CALL getin('slab_alphav',alpha_var)
-      print *,'alpha variable',alpha_var
-!  centered ou upstream scheme for meridional transport
-      slab_upstream=.FALSE.
-      CALL getin('slab_upstream',slab_upstream)
-      print *,'upstream slab scheme',slab_upstream
-! Sverdrup balance at equator ?
-      slab_sverdrup=.TRUE.
-      CALL getin('slab_sverdrup',slab_sverdrup)
-      print *,'Sverdrup balance',slab_sverdrup
-! Use tauy for meridional flux at equator ?
-      slab_tyeq=.TRUE.
-      CALL getin('slab_tyeq',slab_tyeq)
-      print *,'Tauy forcing at equator',slab_tyeq
-! Use tauy for meridional flux at equator ?
-      ekman_zonadv=.TRUE.
-      CALL getin('slab_ekman_zonadv',ekman_zonadv)
-      print *,'Use Ekman flow in zonal direction',ekman_zonadv
-! Use tauy for meridional flux at equator ?
-      ekman_zonavg=.FALSE.
-      CALL getin('slab_ekman_zonavg',ekman_zonavg)
-      print *,'Use zonally-averaged wind stress ?',ekman_zonavg
-! Value of alpha
-      alpham=2./3.
-      CALL getin('slab_alpha',alpham)
-      print *,'slab_alpha',alpham
-! GM k coefficient (m2/s) for 2-layers
-      gmkappa=1000.
-      CALL getin('slab_gmkappa',gmkappa)
-      print *,'slab_gmkappa',gmkappa
-! GM k coefficient (m2/s) for 2-layers
-      gm_smax=2e-3
-      CALL getin('slab_gm_smax',gm_smax)
-      print *,'slab_gm_smax',gm_smax
-! -----------------------------------------------------------
-! Define ocean / continent mask (no flux into continent cell)
-    allocate(zmasqu(ip1jmp1))
-    allocate(zmasqv(ip1jm))
-    zmasqu=1.
-    zmasqv=1.
-
-    ! convert mask to 2D grid
-    CALL gr_fi_dyn(1,iip1,jjp1,zmasq,zmasq_2d)
-    ! put flux mask to 0 at boundaries of continent cells
-    DO i=1,ip1jmp1-1
-      IF (zmasq_2d(i).GT.1e-5 .OR. zmasq_2d(i+1).GT.1e-5) THEN
-              zmasqu(i)=0.
-      ENDIF
-    END DO
-    DO i=iip1,ip1jmp1,iip1
-      zmasqu(i)=zmasqu(i-iim)
-    END DO
-    DO i=1,ip1jm
-      IF (zmasq_2d(i).GT.1e-5 .OR. zmasq_2d(i+iip1).GT.1e-5) THEN
-              zmasqv(i)=0.
-      END IF
-    END DO
-
-! -----------------------------------------------------------
-! Coriolis and friction for Ekman transport
-    slab_ekman=2
-    CALL getin("slab_ekman",slab_ekman)
-    IF (slab_ekman.GT.0) THEN
-      allocate(unsfv(ip1jm))
-      allocate(unsev(ip1jm))
-      allocate(unsfu(ip1jmp1))
-      allocate(unseu(ip1jmp1))
-      allocate(unsbv(ip1jm))
-
-      eps=1e-5 ! Drag
-      CALL getin('slab_eps',eps)
-      print *,'epsilon=',eps
-      ff=fext*unsairez ! Coriolis
-      ! coefs to convert tau_x, tau_y to Ekman mass fluxes
-      ! on 2D grid v points
-      ! Compute correction factor [0 1] near the equator (f<<eps)
-      IF (slab_sverdrup) THEN
-         ! New formulation, sharper near equator, when eps gives Rossby Radius
-         DO i=1,ip1jm
-           unsev(i)=exp(-ff(i)*ff(i)/eps**2)
-         ENDDO
-      ELSE
-         DO i=1,ip1jm
-           unsev(i)=eps**2/(ff(i)*ff(i)+eps**2)
-         ENDDO
-      END IF ! slab_sverdrup
-      ! 1/beta
-      DO i=1,jjp1-1
-        unsbv((i-1)*iip1+1:i*iip1)=unsev((i-1)*iip1+1:i*iip1)/beta(i)
-      END DO
-      ! 1/f
-      ff=SIGN(MAX(ABS(ff),eps/100.),ff) ! avoid value 0 at equator...
-      DO i=1,ip1jm
-        unsfv(i)=(1.-unsev(i))/ff(i)
-      END DO
-      ! compute values on 2D u grid
-      ! 1/eps
-      unsev(:)=unsev(:)/eps
-      CALL gr_v_scal(1,unsfv,unsfu)
-      CALL gr_v_scal(1,unsev,unseu)
-    END IF
-  
-  END SUBROUTINE ini_slab_transp
-
-  SUBROUTINE divgrad_phy(nlevs,temp,delta)
-! Computes temperature tendency due to horizontal diffusion :
-! T Laplacian, later multiplied by diffusion coef and time-step
-
-    IMPLICIT NONE
- 
-    INTEGER, INTENT(IN) :: nlevs ! nlevs : slab layers
-    REAL, INTENT(IN)   :: temp(klon_glo,nlevs) ! slab temperature
-    REAL , INTENT(OUT) :: delta(klon_glo,nlevs) ! temp laplacian (heat flux div.)
-    REAL :: delta_2d((nbp_lon+1)*nbp_lat,nlevs)
-    REAL ghx((nbp_lon+1)*nbp_lat,nlevs), ghy((nbp_lon+1)*(nbp_lat-1),nlevs)
-    INTEGER :: ll,iip1,jjp1
- 
-    iip1=nbp_lon+1
-    jjp1=nbp_lat
-    
-    ! transpose temp to 2D horiz. grid
-    CALL gr_fi_dyn(nlevs,iip1,jjp1,temp,delta_2d)
-    ! computes gradient (proportional to heat flx)
-    CALL grad(nlevs,delta_2d,ghx,ghy)
-    ! put flux to 0 at ocean / continent boundary
-    DO ll=1,nlevs
-        ghx(:,ll)=ghx(:,ll)*zmasqu
-        ghy(:,ll)=ghy(:,ll)*zmasqv
-    END DO
-    ! flux divergence
-    CALL diverg(nlevs,ghx,ghy,delta_2d)
-    ! laplacian back to 1D grid
-    CALL gr_dyn_fi(nlevs,iip1,jjp1,delta_2d,delta)
- 
-    RETURN
-  END SUBROUTINE divgrad_phy
-
-  SUBROUTINE slab_ekman1(tx_phy,ty_phy,ts_phy,dt_phy)
-! 1.5 Layer Ekman transport temperature tendency
-! note : tendency dt later multiplied by (delta t)/(rho.H)
-! to convert from divergence of heat fluxes to T
-
-      IMPLICIT NONE
-      
-      ! tx, ty : wind stress (different grids)
-      ! fluxm, fluz : mass *or heat* fluxes
-      ! dt : temperature tendency
-      INTEGER ij
-
-      ! ts surface temp, td deep temp (diagnosed)
-      REAL ts_phy(klon_glo)
-      REAL ts((nbp_lon+1)*nbp_lat),td((nbp_lon+1)*nbp_lat)
-      ! zonal and meridional wind stress 
-      REAL tx_phy(klon_glo),ty_phy(klon_glo)
-      REAL tyu((nbp_lon+1)*nbp_lat),txu((nbp_lon+1)*nbp_lat)
-      REAL txv((nbp_lon+1)*(nbp_lat-1)),tyv((nbp_lon+1)*(nbp_lat-1))
-      REAL tcurl((nbp_lon+1)*(nbp_lat-1))
-      ! zonal and meridional Ekman mass fluxes at u, v points (2D grid)
-      REAL fluxz((nbp_lon+1)*nbp_lat),fluxm((nbp_lon+1)*(nbp_lat-1))
-      ! vertical  and absolute mass fluxes (to estimate alpha)
-      REAL fluxv((nbp_lon+1)*nbp_lat),fluxt((nbp_lon+1)*(nbp_lat-1))
-      ! temperature tendency
-      REAL dt((nbp_lon+1)*nbp_lat),dt_phy(klon_glo)
-      REAL alpha((nbp_lon+1)*nbp_lat) ! deep temperature coef
-
-      INTEGER iim,iip1,iip2,jjp1,ip1jm,ip1jmi1,ip1jmp1
-
-! Grid definitions
-      iim=nbp_lon
-      iip1=nbp_lon+1
-      iip2=nbp_lon+2
-      jjp1=nbp_lat
-      ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm
-      ip1jmi1=(nbp_lon+1)*(nbp_lat-1)-(nbp_lon+1) ! = ip1jm - iip1
-      ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1
-
-! Convert taux,y to 2D  scalar grid
-! Note: 2D grid size = iim*jjm. iip1=iim+1
-! First and last points in zonal direction are the same 
-! we use 1 index ij from 1 to (iim+1)*(jjm+1)
-      ! north and south poles
-      tx_phy(1)=0.
-      tx_phy(klon_glo)=0.
-      ty_phy(1)=0.
-      ty_phy(klon_glo)=0.
-      CALL gr_fi_dyn(1,iip1,jjp1,tx_phy,txu)
-      CALL gr_fi_dyn(1,iip1,jjp1,ty_phy,tyu)
-! convert to u,v grid (Arakawa C)
-! Multiply by f or eps to get mass flux
-      ! Meridional mass flux
-      CALL gr_scal_v(1,txu,txv) ! wind stress at v points
-      IF (slab_sverdrup) THEN ! Sverdrup bal. near equator
-        tcurl=(txu(1:ip1jm)-txu(iip2:ip1jmp1))/cv(:)
-        fluxm=-tcurl*unsbv-txv*unsfv ! in kg.s-1.m-1 (zonal distance)
-      ELSE 
-        CALL gr_scal_v(1,tyu,tyv)
-        fluxm=tyv*unsev-txv*unsfv ! in kg.s-1.m-1 (zonal distance)
-      ENDIF
-      ! Zonal mass flux
-      CALL gr_scal_u(1,txu,txu) ! wind stress at u points
-      CALL gr_scal_u(1,tyu,tyu)
-      fluxz=tyu*unsfu+txu*unseu
-            
-! Correct flux: continent mask and horiz grid size
-      ! multiply m-flux by mask and dx: flux in kg.s-1
-      fluxm=fluxm*cv*cuvsurcv*zmasqv 
-      ! multiply z-flux by mask and dy: flux in kg.s-1
-      fluxz=fluxz*cu*cvusurcu*zmasqu
-
-! Compute vertical  and absolute mass flux (for variable alpha)
-      IF (alpha_var) THEN
-        DO ij=iip2,ip1jm
-        fluxv(ij)=fluxz(ij)-fluxz(ij-1)-fluxm(ij)+fluxm(ij-iip1)
-        fluxt(ij)=ABS(fluxz(ij))+ABS(fluxz(ij-1)) &
-               +ABS(fluxm(ij))+ABS(fluxm(ij-iip1))
-        ENDDO
-        DO ij=iip1,ip1jmi1,iip1
-            fluxt(ij+1)=fluxt(ij+iip1)
-            fluxv(ij+1)=fluxv(ij+iip1)
-        END DO
-        fluxt(1)=SUM(ABS(fluxm(1:iim)))
-        fluxt(ip1jmp1)=SUM(ABS(fluxm(ip1jm-iim:ip1jm-1)))
-        fluxv(1)=-SUM(fluxm(1:iim))
-        fluxv(ip1jmp1)=SUM(fluxm(ip1jm-iim:ip1jm-1))
-        fluxt=MAX(fluxt,1.e-10)
-      ENDIF
-
-! Compute alpha coefficient. 
-! Tdeep = Tsurf * alpha + 271.35 * (1-alpha)
-      IF (alpha_var) THEN
-          ! increase alpha (and Tdeep) in downwelling regions
-          ! and decrease in upwelling regions
-          ! to avoid "hot spots" where there is surface convergence
-          DO ij=iip2,ip1jm
-              alpha(ij)=alpham-fluxv(ij)/fluxt(ij)*(1.-alpham)
-          ENDDO
-          alpha(1:iip1)=alpham-fluxv(1)/fluxt(1)*(1.-alpham)
-          alpha(ip1jm+1:ip1jmp1)=alpham-fluxv(ip1jmp1)/fluxt(ip1jmp1)*(1.-alpham)
-      ELSE
-          alpha(:)=alpham
-          ! Tsurf-Tdeep ~ 10° in the Tropics
-      ENDIF
-
-! Estimate deep temperature
-      CALL gr_fi_dyn(1,iip1,jjp1,ts_phy,ts)
-      DO ij=1,ip1jmp1
-         td(ij)=271.35+(ts(ij)-271.35)*alpha(ij)
-         td(ij)=MIN(td(ij),ts(ij))
-      END DO
-       
-! Meridional heat flux: multiply mass flux by (ts-td)
-! flux in K.kg.s-1
-      IF (slab_upstream) THEN
-        ! upstream scheme to avoid hot spots
-        DO ij=1,ip1jm
-        IF (fluxm(ij).GE.0.) THEN
-           fluxm(ij)=fluxm(ij)*(ts(ij+iip1)-td(ij))
-        ELSE
-           fluxm(ij)=fluxm(ij)*(ts(ij)-td(ij+iip1))
-        END IF
-        END DO
-      ELSE
-        ! centered scheme better in mid-latitudes
-        DO ij=1,ip1jm
-          fluxm(ij)=fluxm(ij)*(ts(ij+iip1)+ts(ij)-td(ij)-td(ij+iip1))/2.
-        END DO
-      ENDIF
-
-! Zonal heat flux
-! upstream scheme
-      DO ij=iip2,ip1jm
-          fluxz(ij)=fluxz(ij)*(ts(ij)+ts(ij+1)-td(ij+1)-td(ij))/2.
-      END DO
-      DO ij=iip1*2,ip1jmp1,iip1
-           fluxz(ij)=fluxz(ij-iim)
-      END DO
-
-! temperature tendency = divergence of heat fluxes
-! dt in K.s-1.kg.m-2 (T trend times mass/horiz surface)
-      DO ij=iip2,ip1jm
-         dt(ij)=(fluxz(ij-1)-fluxz(ij)+fluxm(ij)-fluxm(ij-iip1)) &
-               /aire(ij) ! aire : grid area 
-      END DO
-      DO ij=iip1,ip1jmi1,iip1
-         dt(ij+1)=dt(ij+iip1) 
-      END DO
-! special treatment at the Poles
-      dt(1)=SUM(fluxm(1:iim))/apoln
-      dt(ip1jmp1)=-SUM(fluxm(ip1jm-iim:ip1jm-1))/apols
-      dt(2:iip1)=dt(1)
-      dt(ip1jm+1:ip1jmp1)=dt(ip1jmp1)
-
-! tendencies back to 1D grid
-      CALL gr_dyn_fi(1,iip1,jjp1,dt,dt_phy)
-
-      RETURN
-  END SUBROUTINE slab_ekman1
-
-  SUBROUTINE slab_ekman2(tx_phy,ty_phy,ts_phy,dt_phy_ek,dt_phy_gm,slab_gm)
-! Temperature tendency for 2-layers slab ocean
-! note : tendency dt later multiplied by (delta time)/(rho.H)
-! to convert from divergence of heat fluxes to T
-
-! 11/16 : Inclusion of GM-like eddy advection
-
-      IMPLICIT NONE
-      
-      LOGICAL,INTENT(in) :: slab_gm
-      ! Here, temperature and flux variables are on 2 layers
-      INTEGER ij
-
-      ! wind stress variables
-      REAL tx_phy(klon_glo),ty_phy(klon_glo)
-      REAL txv((nbp_lon+1)*(nbp_lat-1)), tyv((nbp_lon+1)*(nbp_lat-1))
-      REAL tyu((nbp_lon+1)*nbp_lat),txu((nbp_lon+1)*nbp_lat)
-      REAL tcurl((nbp_lon+1)*(nbp_lat-1))
-      ! slab temperature on  1D, 2D grid
-      REAL ts_phy(klon_glo,2), ts((nbp_lon+1)*nbp_lat,2)
-      ! Temperature gradient, v-points
-      REAL dty((nbp_lon+1)*(nbp_lat-1)),dtx((nbp_lon+1)*nbp_lat)
-      ! Vertical temperature difference, V-points
-      REAL dtz((nbp_lon+1)*(nbp_lat-1))
-      ! zonal and meridional mass fluxes at u, v points (2D grid)
-      REAL fluxz((nbp_lon+1)*nbp_lat), fluxm((nbp_lon+1)*(nbp_lat-1))
-      ! vertical mass flux between the 2 layers
-      REAL fluxv_ek((nbp_lon+1)*nbp_lat)
-      REAL fluxv_gm((nbp_lon+1)*nbp_lat)
-      ! zonal and meridional heat fluxes
-      REAL fluxtz((nbp_lon+1)*nbp_lat,2)
-      REAL fluxtm((nbp_lon+1)*(nbp_lat-1),2)
-      ! temperature tendency (in K.s-1.kg.m-2)
-      REAL dt_ek((nbp_lon+1)*nbp_lat,2), dt_phy_ek(klon_glo,2)
-      REAL dt_gm((nbp_lon+1)*nbp_lat,2), dt_phy_gm(klon_glo,2)
-      ! helper vars
-      REAL zonavg, fluxv
-      REAL, PARAMETER :: sea_den=1025. ! sea water density
-
-      INTEGER iim,iip1,iip2,jjp1,ip1jm,ip1jmi1,ip1jmp1
-
-! Grid definitions
-      iim=nbp_lon
-      iip1=nbp_lon+1
-      iip2=nbp_lon+2
-      jjp1=nbp_lat
-      ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm
-      ip1jmi1=(nbp_lon+1)*(nbp_lat-1)-(nbp_lon+1) ! = ip1jm - iip1
-      ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1
-! Convert temperature to 2D grid 
-      CALL gr_fi_dyn(2,iip1,jjp1,ts_phy,ts)
-
-! ------------------------------------
-! Ekman mass fluxes and Temp tendency
-! ------------------------------------
-! Convert taux,y to 2D  scalar grid
-      ! north and south poles tx,ty no meaning
-      tx_phy(1)=0.
-      tx_phy(klon_glo)=0.
-      ty_phy(1)=0.
-      ty_phy(klon_glo)=0.
-      CALL gr_fi_dyn(1,iip1,jjp1,tx_phy,txu)
-      CALL gr_fi_dyn(1,iip1,jjp1,ty_phy,tyu)
-      IF (ekman_zonavg) THEN ! use zonal average of wind stress
-        DO ij=1,jjp1-2
-          zonavg=SUM(txu(ij*iip1+1:ij*iip1+iim))/iim
-          txu(ij*iip1+1:(ij+1)*iip1)=zonavg
-          zonavg=SUM(tyu(ij*iip1+1:ij*iip1+iim))/iim
-          tyu(ij*iip1+1:(ij+1)*iip1)=zonavg
-        END DO
-      END IF
-          
-! Divide taux,y by f or eps, and convert to 2D u,v grids
-! (Arakawa C grid)
-      ! Meridional flux
-      CALL gr_scal_v(1,txu,txv) ! wind stress at v points
-      fluxm=-txv*unsfv ! in kg.s-1.m-1 (zonal distance)
-      IF (slab_sverdrup) THEN ! Sverdrup bal. near equator
-        tcurl=(txu(1:ip1jm)-txu(iip2:ip1jmp1))/cv(:) ! dtx/dy
-        !poles curl = 0
-        tcurl(1:iip1)=0.
-        tcurl(ip1jmi1+1:ip1jm)=0.
-        fluxm=fluxm-tcurl*unsbv
-      ENDIF
-      IF (slab_tyeq) THEN ! meridional wind forcing at equator
-        CALL gr_scal_v(1,tyu,tyv)
-        fluxm=fluxm+tyv*unsev ! in kg.s-1.m-1 (zonal distance)
-      ENDIF
-!  apply continent mask, multiply by horiz grid dimension
-      fluxm=fluxm*cv*cuvsurcv*zmasqv
-
-      ! Zonal flux
-      IF (ekman_zonadv) THEN
-        CALL gr_scal_u(1,txu,txu) ! wind stress at u points
-        CALL gr_scal_u(1,tyu,tyu)
-        fluxz=tyu*unsfu+txu*unseu
-        !  apply continent mask, multiply by horiz grid dimension
-        fluxz=fluxz*cu*cvusurcu*zmasqu
-      END IF
-            
-!  Vertical mass flux from mass budget (divergence of horiz fluxes)
-      IF (ekman_zonadv) THEN
-         DO ij=iip2,ip1jm
-           fluxv_ek(ij)=fluxz(ij)-fluxz(ij-1)-fluxm(ij)+fluxm(ij-iip1)
-         ENDDO
-      ELSE 
-         DO ij=iip2,ip1jm
-           fluxv_ek(ij)=-fluxm(ij)+fluxm(ij-iip1)
-         ENDDO
-      END IF
-      DO ij=iip1,ip1jmi1,iip1
-         fluxv_ek(ij+1)=fluxv_ek(ij+iip1)
-      END DO
-!  vertical mass flux at Poles
-      fluxv_ek(1)=-SUM(fluxm(1:iim))     
-      fluxv_ek(ip1jmp1)=SUM(fluxm(ip1jm-iim:ip1jm-1))
-
-! Meridional heat fluxes 
-      DO ij=1,ip1jm
-          ! centered scheme
-          fluxtm(ij,1)=fluxm(ij)*(ts(ij+iip1,1)+ts(ij,1))/2.
-          fluxtm(ij,2)=-fluxm(ij)*(ts(ij+iip1,2)+ts(ij,2))/2.
-      END DO
-
-! Zonal heat fluxes
-! Schema upstream      
-      IF (ekman_zonadv) THEN
-        DO ij=iip2,ip1jm
-          IF (fluxz(ij).GE.0.) THEN
-                 fluxtz(ij,1)=fluxz(ij)*ts(ij,1)
-                 fluxtz(ij,2)=-fluxz(ij)*ts(ij+1,2)
-          ELSE
-                 fluxtz(ij,1)=fluxz(ij)*ts(ij+1,1)
-                 fluxtz(ij,2)=-fluxz(ij)*ts(ij,2)
-          ENDIF
-        ENDDO
-        DO ij=iip1*2,ip1jmp1,iip1
-               fluxtz(ij,:)=fluxtz(ij-iim,:)
-        END DO
-      ELSE
-        fluxtz(:,:)=0.
-      ENDIF        
-                   
-! Temperature tendency, horizontal advection:
-      DO ij=iip2,ip1jm
-         dt_ek(ij,:)=fluxtz(ij-1,:)-fluxtz(ij,:) &
-                 +fluxtm(ij,:)-fluxtm(ij-iip1,:)
-      END DO
-! Poles
-      dt_ek(1,:)=SUM(fluxtm(1:iim,:),dim=1)
-      dt_ek(ip1jmp1,:)=-SUM(fluxtm(ip1jm-iim:ip1jm-1,:),dim=1)
-
-! ------------------------------------
-! GM mass fluxes and Temp tendency
-! ------------------------------------
-     IF (slab_gm) THEN
-! Vertical Temperature difference T1-T2 on v-grid points
-      CALL gr_scal_v(1,ts(:,1)-ts(:,2),dtz)
-      dtz(:)=MAX(dtz(:),0.25) 
-! Horizontal Temperature differences 
-      CALL grad(1,(ts(:,1)+ts(:,2))/2.,dtx,dty)
-! Meridional flux = -k.s (s=dyT/dzT)
-! Continent mask, multiply by dz/dy 
-      fluxm=dty/dtz*500.*cuvsurcv*zmasqv
-! slope limitation, multiply by kappa
-      fluxm=-gmkappa*SIGN(MIN(ABS(fluxm),gm_smax*cv*cuvsurcv),dty)
-! convert to kg/s
-      fluxm(:)=fluxm(:)*sea_den
-! Zonal flux = 0. (temporary)
-      fluxz(:)=0.
-!  Vertical mass flux from mass budget (divergence of horiz fluxes)
-      DO ij=iip2,ip1jm
-        fluxv_gm(ij)=fluxz(ij)-fluxz(ij-1)-fluxm(ij)+fluxm(ij-iip1)
-      ENDDO
-      DO ij=iip1,ip1jmi1,iip1
-         fluxv_gm(ij+1)=fluxv_gm(ij+iip1)
-      END DO
-!  vertical mass flux at Poles
-      fluxv_gm(1)=-SUM(fluxm(1:iim))     
-      fluxv_gm(ip1jmp1)=SUM(fluxm(ip1jm-iim:ip1jm-1))
-
-! Meridional heat fluxes 
-      DO ij=1,ip1jm
-          ! centered scheme
-          fluxtm(ij,1)=fluxm(ij)*(ts(ij+iip1,1)+ts(ij,1))/2.
-          fluxtm(ij,2)=-fluxm(ij)*(ts(ij+iip1,2)+ts(ij,2))/2.
-      END DO
-
-! Zonal heat fluxes
-! Schema upstream      
-      DO ij=iip2,ip1jm
-      IF (fluxz(ij).GE.0.) THEN
-             fluxtz(ij,1)=fluxz(ij)*ts(ij,1)
-             fluxtz(ij,2)=-fluxz(ij)*ts(ij+1,2)
-      ELSE
-             fluxtz(ij,1)=fluxz(ij)*ts(ij+1,1)
-             fluxtz(ij,2)=-fluxz(ij)*ts(ij,2)
-      ENDIF
-      ENDDO
-      DO ij=iip1*2,ip1jmp1,iip1
-             fluxtz(ij,:)=fluxtz(ij-iim,:)
-      END DO
-                   
-! Temperature tendency :
-! divergence of horizontal heat fluxes
-      DO ij=iip2,ip1jm
-         dt_gm(ij,:)=fluxtz(ij-1,:)-fluxtz(ij,:) &
-                 +fluxtm(ij,:)-fluxtm(ij-iip1,:)
-      END DO
-! Poles
-      dt_gm(1,:)=SUM(fluxtm(1:iim,:),dim=1)
-      dt_gm(ip1jmp1,:)=-SUM(fluxtm(ip1jm-iim:ip1jm-1,:),dim=1)
-     ELSE
-       dt_gm(:,:)=0.
-       fluxv_gm(:)=0.
-     ENDIF ! slab_gm
-
-! ------------------------------------
-! Temp tendency from vertical advection
-! Divide by cell area
-! ------------------------------------
-! vertical heat flux = mass flux * T, upstream scheme
-      DO ij=iip2,ip1jm
-         fluxv=fluxv_ek(ij)+fluxv_gm(ij) ! net flux, needed for upstream scheme
-         IF (fluxv.GT.0.) THEN
-           dt_ek(ij,1)=dt_ek(ij,1)+fluxv_ek(ij)*ts(ij,2)
-           dt_ek(ij,2)=dt_ek(ij,2)-fluxv_ek(ij)*ts(ij,2)
-           dt_gm(ij,1)=dt_gm(ij,1)+fluxv_gm(ij)*ts(ij,2)
-           dt_gm(ij,2)=dt_gm(ij,2)-fluxv_gm(ij)*ts(ij,2)
-         ELSE
-           dt_ek(ij,1)=dt_ek(ij,1)+fluxv_ek(ij)*ts(ij,1)
-           dt_ek(ij,2)=dt_ek(ij,2)-fluxv_ek(ij)*ts(ij,1)
-           dt_gm(ij,1)=dt_gm(ij,1)+fluxv_gm(ij)*ts(ij,1)
-           dt_gm(ij,2)=dt_gm(ij,2)-fluxv_gm(ij)*ts(ij,1)
-         ENDIF
-         ! divide by cell area
-         dt_ek(ij,:)=dt_ek(ij,:)/aire(ij)
-         dt_gm(ij,:)=dt_gm(ij,:)/aire(ij)
-      END DO
-      ! North Pole
-      fluxv=fluxv_ek(1)+fluxv_gm(1)
-        IF (fluxv.GT.0.) THEN
-          dt_ek(1,1)=dt_ek(1,1)+fluxv_ek(1)*ts(1,2)
-          dt_ek(1,2)=dt_ek(1,2)-fluxv_ek(1)*ts(1,2)
-          dt_gm(1,1)=dt_gm(1,1)+fluxv_gm(1)*ts(1,2)
-          dt_gm(1,2)=dt_gm(1,2)-fluxv_gm(1)*ts(1,2)
-        ELSE
-          dt_ek(1,1)=dt_ek(1,1)+fluxv_ek(1)*ts(1,1)
-          dt_ek(1,2)=dt_ek(1,2)-fluxv_ek(1)*ts(1,1)
-          dt_gm(1,1)=dt_gm(1,1)+fluxv_gm(1)*ts(1,1)
-          dt_gm(1,2)=dt_gm(1,2)-fluxv_gm(1)*ts(1,1)
-        ENDIF
-      dt_ek(1,:)=dt_ek(1,:)/apoln
-      dt_gm(1,:)=dt_gm(1,:)/apoln
-      ! South pole
-      fluxv=fluxv_ek(ip1jmp1)+fluxv_gm(ip1jmp1)
-        IF (fluxv.GT.0.) THEN
-          dt_ek(ip1jmp1,1)=dt_ek(ip1jmp1,1)+fluxv_ek(ip1jmp1)*ts(ip1jmp1,2)
-          dt_ek(ip1jmp1,2)=dt_ek(ip1jmp1,2)-fluxv_ek(ip1jmp1)*ts(ip1jmp1,2)
-          dt_gm(ip1jmp1,1)=dt_gm(ip1jmp1,1)+fluxv_gm(ip1jmp1)*ts(ip1jmp1,2)
-          dt_gm(ip1jmp1,2)=dt_gm(ip1jmp1,2)-fluxv_gm(ip1jmp1)*ts(ip1jmp1,2)
-        ELSE
-          dt_ek(ip1jmp1,1)=dt_ek(ip1jmp1,1)+fluxv_ek(ip1jmp1)*ts(ip1jmp1,1)
-          dt_ek(ip1jmp1,2)=dt_ek(ip1jmp1,2)-fluxv_ek(ip1jmp1)*ts(ip1jmp1,1)
-          dt_gm(ip1jmp1,1)=dt_gm(ip1jmp1,1)+fluxv_gm(ip1jmp1)*ts(ip1jmp1,1)
-          dt_gm(ip1jmp1,2)=dt_gm(ip1jmp1,2)-fluxv_gm(ip1jmp1)*ts(ip1jmp1,1)
-        ENDIF
-      dt_ek(ip1jmp1,:)=dt_ek(ip1jmp1,:)/apols
-      dt_gm(ip1jmp1,:)=dt_gm(ip1jmp1,:)/apols
-      
-      dt_ek(2:iip1,1)=dt_ek(1,1)
-      dt_ek(2:iip1,2)=dt_ek(1,2)
-      dt_gm(2:iip1,1)=dt_gm(1,1)
-      dt_gm(2:iip1,2)=dt_gm(1,2)
-      dt_ek(ip1jm+1:ip1jmp1,1)=dt_ek(ip1jmp1,1)
-      dt_ek(ip1jm+1:ip1jmp1,2)=dt_ek(ip1jmp1,2)
-      dt_gm(ip1jm+1:ip1jmp1,1)=dt_gm(ip1jmp1,1)
-      dt_gm(ip1jm+1:ip1jmp1,2)=dt_gm(ip1jmp1,2)
-
-      DO ij=iip1,ip1jmi1,iip1
-         dt_gm(ij+1,:)=dt_gm(ij+iip1,:) 
-         dt_ek(ij+1,:)=dt_ek(ij+iip1,:) 
-      END DO
-
-! T tendency back to 1D grid...
-      CALL gr_dyn_fi(2,iip1,jjp1,dt_ek,dt_phy_ek)
-      CALL gr_dyn_fi(2,iip1,jjp1,dt_gm,dt_phy_gm)
-
-      RETURN
-  END SUBROUTINE slab_ekman2
-
-  SUBROUTINE slab_gmdiff(ts_phy,dt_phy)
-! Temperature tendency for 2-layers slab ocean
-! Due to Gent-McWilliams type eddy-induced advection
-      
-      IMPLICIT NONE
-      
-      ! Here, temperature and flux variables are on 2 layers
-      INTEGER ij
-      ! Temperature gradient, v-points
-      REAL dty((nbp_lon+1)*(nbp_lat-1)),dtx((nbp_lon+1)*nbp_lat)
-      ! Vertical temperature difference, V-points
-      REAL dtz((nbp_lon+1)*(nbp_lat-1))
-      ! slab temperature on  1D, 2D grid
-      REAL ts_phy(klon_glo,2),ts((nbp_lon+1)*nbp_lat,2)
-      ! zonal and meridional mass fluxes at u, v points (2D grid)
-      REAL fluxz((nbp_lon+1)*nbp_lat), fluxm((nbp_lon+1)*(nbp_lat-1))
-      ! vertical mass flux between the 2 layers
-      REAL fluxv((nbp_lon+1)*nbp_lat)
-      ! zonal and meridional heat fluxes
-      REAL fluxtz((nbp_lon+1)*nbp_lat,2)
-      REAL fluxtm((nbp_lon+1)*(nbp_lat-1),2)
-      ! temperature tendency (in K.s-1.kg.m-2)
-      REAL dt((nbp_lon+1)*nbp_lat,2), dt_phy(klon_glo,2)
-
-      INTEGER iim,iip1,iip2,jjp1,ip1jm,ip1jmi1,ip1jmp1
-
-! Grid definitions
-      iim=nbp_lon
-      iip1=nbp_lon+1
-      iip2=nbp_lon+2
-      jjp1=nbp_lat
-      ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm
-      ip1jmi1=(nbp_lon+1)*(nbp_lat-1)-(nbp_lon+1) ! = ip1jm - iip1
-      ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1
-
-! Convert temperature to 2D grid 
-      CALL gr_fi_dyn(2,iip1,jjp1,ts_phy,ts)
-! Vertical Temperature difference T1-T2 on v-grid points
-      CALL gr_scal_v(1,ts(:,1)-ts(:,2),dtz)
-      dtz(:)=MAX(dtz(:),0.25) 
-! Horizontal Temperature differences 
-      CALL grad(1,(ts(:,1)+ts(:,2))/2.,dtx,dty)
-! Meridional flux = -k.s (s=dyT/dzT)
-! Continent mask, multiply by dz/dy 
-      fluxm=dty/dtz*500.*cuvsurcv*zmasqv
-! slope limitation, multiply by kappa
-      fluxm=-gmkappa*SIGN(MIN(ABS(fluxm),gm_smax*cv*cuvsurcv),dty)
-! Zonal flux = 0. (temporary)
-      fluxz(:)=0.
-!  Vertical mass flux from mass budget (divergence of horiz fluxes)
-      DO ij=iip2,ip1jm
-        fluxv(ij)=fluxz(ij)-fluxz(ij-1)-fluxm(ij)+fluxm(ij-iip1)
-      ENDDO
-      DO ij=iip1,ip1jmi1,iip1
-         fluxv(ij+1)=fluxv(ij+iip1)
-      END DO
-!  vertical mass flux at Poles
-      fluxv(1)=-SUM(fluxm(1:iim))     
-      fluxv(ip1jmp1)=SUM(fluxm(ip1jm-iim:ip1jm-1))
-      fluxv=fluxv
-
-! Meridional heat fluxes 
-      DO ij=1,ip1jm
-          ! centered scheme
-          fluxtm(ij,1)=fluxm(ij)*(ts(ij+iip1,1)+ts(ij,1))/2.
-          fluxtm(ij,2)=-fluxm(ij)*(ts(ij+iip1,2)+ts(ij,2))/2.
-      END DO
-
-! Zonal heat fluxes
-! Schema upstream      
-      DO ij=iip2,ip1jm
-      IF (fluxz(ij).GE.0.) THEN
-             fluxtz(ij,1)=fluxz(ij)*ts(ij,1)
-             fluxtz(ij,2)=-fluxz(ij)*ts(ij+1,2)
-      ELSE
-             fluxtz(ij,1)=fluxz(ij)*ts(ij+1,1)
-             fluxtz(ij,2)=-fluxz(ij)*ts(ij,2)
-      ENDIF
-      ENDDO
-      DO ij=iip1*2,ip1jmp1,iip1
-             fluxtz(ij,:)=fluxtz(ij-iim,:)
-      END DO
-                   
-! Temperature tendency :
-      DO ij=iip2,ip1jm
-! divergence of horizontal heat fluxes
-         dt(ij,:)=fluxtz(ij-1,:)-fluxtz(ij,:) &
-                 +fluxtm(ij,:)-fluxtm(ij-iip1,:)
-! + vertical heat flux (mass flux * T, upstream scheme)
-         IF (fluxv(ij).GT.0.) THEN
-           dt(ij,1)=dt(ij,1)+fluxv(ij)*ts(ij,2)
-           dt(ij,2)=dt(ij,2)-fluxv(ij)*ts(ij,2)
-         ELSE
-           dt(ij,1)=dt(ij,1)+fluxv(ij)*ts(ij,1)
-           dt(ij,2)=dt(ij,2)-fluxv(ij)*ts(ij,1)
-         ENDIF
-         ! divide by cell area
-         dt(ij,:)=dt(ij,:)/aire(ij)
-      END DO
-      DO ij=iip1,ip1jmi1,iip1
-         dt(ij+1,:)=dt(ij+iip1,:) 
-      END DO
-! Poles
-      dt(1,:)=SUM(fluxtm(1:iim,:),dim=1)
-        IF (fluxv(1).GT.0.) THEN
-          dt(1,1)=dt(1,1)+fluxv(1)*ts(1,2)
-          dt(1,2)=dt(1,2)-fluxv(1)*ts(1,2)
-        ELSE
-          dt(1,1)=dt(1,1)+fluxv(1)*ts(1,1)
-          dt(1,2)=dt(1,2)-fluxv(1)*ts(1,1)
-        ENDIF
-      dt(1,:)=dt(1,:)/apoln
-      dt(ip1jmp1,:)=-SUM(fluxtm(ip1jm-iim:ip1jm-1,:),dim=1)
-       IF (fluxv(ip1jmp1).GT.0.) THEN
-         dt(ip1jmp1,1)=dt(ip1jmp1,1)+fluxv(ip1jmp1)*ts(ip1jmp1,2)
-         dt(ip1jmp1,2)=dt(ip1jmp1,2)-fluxv(ip1jmp1)*ts(ip1jmp1,2)
-       ELSE
-         dt(ip1jmp1,1)=dt(ip1jmp1,1)+fluxv(ip1jmp1)*ts(ip1jmp1,1)
-         dt(ip1jmp1,2)=dt(ip1jmp1,2)-fluxv(ip1jmp1)*ts(ip1jmp1,1)
-       ENDIF
-      dt(ip1jmp1,:)=dt(ip1jmp1,:)/apols
-      dt(2:iip1,1)=dt(1,1)
-      dt(2:iip1,2)=dt(1,2)
-      dt(ip1jm+1:ip1jmp1,1)=dt(ip1jmp1,1)
-      dt(ip1jm+1:ip1jmp1,2)=dt(ip1jmp1,2)
-
-! T tendency back to 1D grid...
-      CALL gr_dyn_fi(2,iip1,jjp1,dt,dt_phy)
-
-      RETURN
-  END SUBROUTINE slab_gmdiff
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE gr_fi_dyn(nfield,im,jm,pfi,pdyn)
-  ! Transfer a variable from 1D "physics" grid to 2D "dynamics" grid
-  IMPLICIT NONE
-
-  INTEGER,INTENT(IN) :: im,jm,nfield
-  REAL,INTENT(IN) :: pfi(klon_glo,nfield) ! on 1D grid
-  REAL,INTENT(OUT) :: pdyn(im,jm,nfield) ! on 2D grid
-
-  INTEGER :: i,j,ifield,ig
-
-  DO ifield=1,nfield
-    ! Handle poles
-    DO i=1,im
-      pdyn(i,1,ifield)=pfi(1,ifield)
-      pdyn(i,jm,ifield)=pfi(klon_glo,ifield)
-    ENDDO
-    ! Other points
-    DO j=2,jm-1
-      ig=2+(j-2)*(im-1)
-      CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
-      pdyn(im,j,ifield)=pdyn(1,j,ifield)
-    ENDDO
-  ENDDO ! of DO ifield=1,nfield
-
-  END SUBROUTINE gr_fi_dyn
-
-  SUBROUTINE gr_dyn_fi(nfield,im,jm,pdyn,pfi)
-  ! Transfer a variable from 2D "dynamics" grid to 1D "physics" grid
-  IMPLICIT NONE
-
-  INTEGER,INTENT(IN) :: im,jm,nfield
-  REAL,INTENT(IN) :: pdyn(im,jm,nfield) ! on 2D grid
-  REAL,INTENT(OUT) :: pfi(klon_glo,nfield) ! on 1D grid
-
-  INTEGER j,ifield,ig
-
-  CHARACTER (len = 20)                      :: modname = 'slab_heat_transp'
-  CHARACTER (len = 80)                      :: abort_message
-
-  ! Sanity check:
-  IF(klon_glo.NE.2+(jm-2)*(im-1)) THEN
-    abort_message="gr_dyn_fi error, wrong sizes"
-    CALL abort_physic(modname,abort_message,1)
-  ENDIF
-
-  ! Handle poles
-  CALL SCOPY(nfield,pdyn,im*jm,pfi,klon_glo)
-  CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(klon_glo,1),klon_glo)
-  ! Other points
-  DO ifield=1,nfield
-    DO j=2,jm-1
-      ig=2+(j-2)*(im-1)
-      CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
-    ENDDO
-  ENDDO
-
-  END SUBROUTINE gr_dyn_fi
-
-  SUBROUTINE  grad(klevel,pg,pgx,pgy)
-  ! compute the covariant components pgx,pgy of the gradient of pg
-  ! pgx = d(pg)/dx * delta(x) = delta(pg)
-  IMPLICIT NONE
-
-  INTEGER,INTENT(IN) :: klevel
-  REAL,INTENT(IN) :: pg((nbp_lon+1)*nbp_lat,klevel)
-  REAL,INTENT(OUT) :: pgx((nbp_lon+1)*nbp_lat,klevel)
-  REAL,INTENT(OUT) :: pgy((nbp_lon+1)*(nbp_lat-1),klevel)
-
-  INTEGER :: l,ij
-  INTEGER :: iim,iip1,ip1jm,ip1jmp1
-
-  iim=nbp_lon
-  iip1=nbp_lon+1
-  ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm
-  ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1
-
-  DO l=1,klevel
-    DO ij=1,ip1jmp1-1
-      pgx(ij,l)=pg(ij+1,l)-pg(ij,l)
-    ENDDO
-    ! correction for pgx(ip1,j,l) ...
-    ! ... pgx(iip1,j,l)=pgx(1,j,l) ...
-    DO ij=iip1,ip1jmp1,iip1
-      pgx(ij,l)=pgx(ij-iim,l)
-    ENDDO
-    DO ij=1,ip1jm
-      pgy(ij,l)=pg(ij,l)-pg(ij+iip1,l)
-    ENDDO
-  ENDDO
-
-  END SUBROUTINE grad
-
-  SUBROUTINE diverg(klevel,x,y,div)
-  ! computes the divergence of a vector field of components
-  ! x,y. x and y being covariant components
-  IMPLICIT NONE
-
-  INTEGER,INTENT(IN) :: klevel
-  REAL,INTENT(IN) :: x((nbp_lon+1)*nbp_lat,klevel)
-  REAL,INTENT(IN) :: y((nbp_lon+1)*(nbp_lat-1),klevel)
-  REAL,INTENT(OUT) :: div((nbp_lon+1)*nbp_lat,klevel)
-
-  INTEGER :: l,ij
-  INTEGER :: iim,iip1,iip2,ip1jm,ip1jmp1,ip1jmi1
-
-  REAL :: aiy1(nbp_lon+1),aiy2(nbp_lon+1)
-  REAL :: sumypn,sumyps
-  REAL,EXTERNAL :: SSUM
-
-  iim=nbp_lon
-  iip1=nbp_lon+1
-  iip2=nbp_lon+2
-  ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm
-  ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1
-  ip1jmi1=(nbp_lon+1)*(nbp_lat-1)-(nbp_lon+1) ! = ip1jm - iip1
-
-  DO l=1,klevel
-    DO ij=iip2,ip1jm-1
-      div(ij+1,l)= &
-        cvusurcu(ij+1)*x(ij+1,l)-cvusurcu(ij)*x(ij,l)+ &
-        cuvsurcv(ij-iim)*y(ij-iim,l)-cuvsurcv(ij+1)*y(ij+1,l)
-    ENDDO
-    ! correction for div(1,j,l) ...
-    ! ... div(1,j,l)= div(iip1,j,l) ...
-    DO ij=iip2,ip1jm,iip1
-      div(ij,l)=div(ij+iim,l)
-    ENDDO
-    ! at the poles
-    DO ij=1,iim
-      aiy1(ij)=cuvsurcv(ij)*y(ij,l)
-      aiy2(ij)=cuvsurcv(ij+ip1jmi1)*y(ij+ip1jmi1,l)
-    ENDDO
-    sumypn=SSUM(iim,aiy1,1)/apoln
-    sumyps=SSUM(iim,aiy2,1)/apols
-    DO ij=1,iip1
-      div(ij,l)=-sumypn
-      div(ij+ip1jm,l)=sumyps
-    ENDDO
-    ! End (poles)
-  ENDDO ! of DO l=1,klevel
-
-  !!! CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
-  DO l=1,klevel
-    DO ij=iip2,ip1jm
-      div(ij,l)=div(ij,l)*unsaire(ij)
-    ENDDO
-  ENDDO
-
-  END SUBROUTINE diverg
-
-  SUBROUTINE gr_v_scal(nx,x_v,x_scal)
-  ! convert values from v points to scalar points on C-grid
-  ! used to  compute unsfu, unseu (u points, but depends only on latitude)
-  IMPLICIT NONE
-
-  INTEGER,INTENT(IN) :: nx ! number of levels or fields
-  REAL,INTENT(IN) :: x_v((nbp_lon+1)*(nbp_lat-1),nx)
-  REAL,INTENT(OUT) :: x_scal((nbp_lon+1)*nbp_lat,nx)
-
-  INTEGER :: l,ij
-  INTEGER :: iip1,iip2,ip1jm,ip1jmp1
-
-  iip1=nbp_lon+1
-  iip2=nbp_lon+2
-  ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm
-  ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1
-
-  DO l=1,nx
-    DO ij=iip2,ip1jm
-      x_scal(ij,l)= &
-                   (airev(ij-iip1)*x_v(ij-iip1,l)+airev(ij)*x_v(ij,l)) &
-                  /(airev(ij-iip1)+airev(ij))
-    ENDDO
-    DO ij=1,iip1
-      x_scal(ij,l)=0.
-    ENDDO
-    DO ij=ip1jm+1,ip1jmp1
-      x_scal(ij,l)=0.
-    ENDDO
-  ENDDO
-
-  END SUBROUTINE gr_v_scal
- 
-  SUBROUTINE gr_scal_v(nx,x_scal,x_v)
-  ! convert values from scalar points to v points on C-grid
-  ! used to compute wind stress at V points
-  IMPLICIT NONE
-
-  INTEGER,INTENT(IN) :: nx ! number of levels or fields
-  REAL,INTENT(OUT) :: x_v((nbp_lon+1)*(nbp_lat-1),nx)
-  REAL,INTENT(IN) :: x_scal((nbp_lon+1)*nbp_lat,nx)
-
-  INTEGER :: l,ij
-  INTEGER :: iip1,ip1jm
-
-  iip1=nbp_lon+1
-  ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm
-
-      DO l=1,nx
-        DO ij=1,ip1jm
-          x_v(ij,l)= &
-            (cu(ij)*cvusurcu(ij)*x_scal(ij,l)+ &
-            cu(ij+iip1)*cvusurcu(ij+iip1)*x_scal(ij+iip1,l)) &
-            /(cu(ij)*cvusurcu(ij)+cu(ij+iip1)*cvusurcu(ij+iip1))
-        ENDDO
-      ENDDO
-
-  END SUBROUTINE gr_scal_v
-
-  SUBROUTINE gr_scal_u(nx,x_scal,x_u)
-  ! convert values from scalar points to U points on C-grid
-  ! used to compute wind stress at U points
-  IMPLICIT NONE
-
-  INTEGER,INTENT(IN) :: nx
-  REAL,INTENT(OUT) :: x_u((nbp_lon+1)*nbp_lat,nx)
-  REAL,INTENT(IN) :: x_scal((nbp_lon+1)*nbp_lat,nx)
-
-  INTEGER :: l,ij
-  INTEGER :: iip1,jjp1,ip1jmp1
-
-  iip1=nbp_lon+1
-  jjp1=nbp_lat
-  ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1
-
-  DO l=1,nx
-     DO ij=1,ip1jmp1-1
-        x_u(ij,l)= &
-         (aire(ij)*x_scal(ij,l)+aire(ij+1)*x_scal(ij+1,l)) &
-         /(aire(ij)+aire(ij+1))
-     ENDDO
-  ENDDO
-
-  CALL SCOPY(nx*jjp1,x_u(1,1),iip1,x_u(iip1,1),iip1)
-
-  END SUBROUTINE gr_scal_u
-
-END MODULE slab_heat_transp_mod
+link ../phylmd/slab_heat_transp_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/soil.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/soil.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/soil.F90	(revision 3940)
@@ -1,299 +1,1 @@
-!
-! $Header$
-!
-SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, &
-     ptsoil, pcapcal, pfluxgrd)
-  
-  USE dimphy
-  USE mod_phys_lmdz_para
-  USE indice_sol_mod
-  USE print_control_mod, ONLY: lunout
-
-  IMPLICIT NONE
-
-!=======================================================================
-!
-!   Auteur:  Frederic Hourdin     30/01/92
-!   -------
-!
-!   Object:  Computation of : the soil temperature evolution
-!   -------                   the surfacic heat capacity "Capcal"
-!                            the surface conduction flux pcapcal
-!
-!
-!   Method: Implicit time integration
-!   -------
-!   Consecutive ground temperatures are related by:
-!           T(k+1) = C(k) + D(k)*T(k)  (*)
-!   The coefficients C and D are computed at the t-dt time-step.
-!   Routine structure:
-!   1) C and D coefficients are computed from the old temperature
-!   2) new temperatures are computed using (*)
-!   3) C and D coefficients are computed from the new temperature
-!      profile for the t+dt time-step
-!   4) the coefficients A and B are computed where the diffusive
-!      fluxes at the t+dt time-step is given by
-!             Fdiff = A + B Ts(t+dt)
-!      or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
-!             with F0 = A + B (Ts(t))
-!                 Capcal = B*dt
-!           
-!   Interface:
-!   ----------
-!
-!   Arguments:
-!   ----------
-!   ptimestep            physical timestep (s)
-!   indice               sub-surface index
-!   snow(klon)           snow
-!   ptsrf(klon)          surface temperature at time-step t (K)
-!   ptsoil(klon,nsoilmx) temperature inside the ground (K)
-!   pcapcal(klon)        surfacic specific heat (W*m-2*s*K-1)
-!   pfluxgrd(klon)       surface diffusive flux from ground (Wm-2)
-!   
-!=======================================================================
-  INCLUDE "YOMCST.h"
-  INCLUDE "dimsoil.h"
-  INCLUDE "comsoil.h"
-!-----------------------------------------------------------------------
-! Arguments
-! ---------
-  REAL, INTENT(IN)                     :: ptimestep
-  INTEGER, INTENT(IN)                  :: indice, knon
-  REAL, DIMENSION(klon), INTENT(IN)    :: snow
-  REAL, DIMENSION(klon), INTENT(IN)    :: ptsrf
-  
-  REAL, DIMENSION(klon,nsoilmx), INTENT(INOUT) :: ptsoil
-  REAL, DIMENSION(klon), INTENT(OUT)           :: pcapcal
-  REAL, DIMENSION(klon), INTENT(OUT)           :: pfluxgrd
-
-!-----------------------------------------------------------------------
-! Local variables
-! ---------------
-  INTEGER                             :: ig, jk, ierr
-  REAL                                :: min_period,dalph_soil
-  REAL, DIMENSION(nsoilmx)            :: zdz2
-  REAL                                :: z1s
-  REAL, DIMENSION(klon)               :: ztherm_i
-  REAL, DIMENSION(klon,nsoilmx,nbsrf) :: C_coef, D_coef
-
-! Local saved variables
-! ---------------------
-  REAL, SAVE                     :: lambda
-!$OMP THREADPRIVATE(lambda)
-  REAL, DIMENSION(nsoilmx), SAVE :: dz1, dz2
-!$OMP THREADPRIVATE(dz1,dz2)
-  LOGICAL, SAVE                  :: firstcall=.TRUE.
-!$OMP THREADPRIVATE(firstcall)
-    
-!-----------------------------------------------------------------------
-!   Depthts:
-!   --------
-  REAL fz,rk,fz1,rk1,rk2
-  fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
-
-
-!-----------------------------------------------------------------------
-! Calculation of some constants
-! NB! These constants do not depend on the sub-surfaces
-!-----------------------------------------------------------------------
-
-  IF (firstcall) THEN
-!-----------------------------------------------------------------------
-!   ground levels 
-!   grnd=z/l where l is the skin depth of the diurnal cycle:
-!-----------------------------------------------------------------------
-
-     min_period=1800. ! en secondes
-     dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
-!$OMP MASTER
-     IF (is_mpi_root) THEN
-        OPEN(99,file='soil.def',status='old',form='formatted',iostat=ierr)
-        IF (ierr == 0) THEN ! Read file only if it exists
-           READ(99,*) min_period
-           READ(99,*) dalph_soil
-           WRITE(lunout,*)'Discretization for the soil model'
-           WRITE(lunout,*)'First level e-folding depth',min_period, &
-                '   dalph',dalph_soil
-           CLOSE(99)
-        END IF
-     ENDIF
-!$OMP END MASTER
-     CALL bcast(min_period)
-     CALL bcast(dalph_soil)
-
-!   la premiere couche represente un dixieme de cycle diurne
-     fz1=SQRT(min_period/3.14)
-     
-     DO jk=1,nsoilmx
-        rk1=jk
-        rk2=jk-1
-        dz2(jk)=fz(rk1)-fz(rk2)
-     ENDDO
-     DO jk=1,nsoilmx-1
-        rk1=jk+.5
-        rk2=jk-.5
-        dz1(jk)=1./(fz(rk1)-fz(rk2))
-     ENDDO
-     lambda=fz(.5)*dz1(1)
-     WRITE(lunout,*)'full layers, intermediate layers (seconds)'
-     DO jk=1,nsoilmx
-        rk=jk
-        rk1=jk+.5
-        rk2=jk-.5
-        WRITE(lunout,*)'fz=', &
-             fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
-     ENDDO
-
-     firstcall =.FALSE.
-  END IF
-
-
-!-----------------------------------------------------------------------
-!   Calcul de l'inertie thermique a partir de la variable rnat.
-!   on initialise a inertie_sic meme au-dessus d'un point de mer au cas 
-!   ou le point de mer devienne point de glace au pas suivant
-!   on corrige si on a un point de terre avec ou sans glace
-!
-!   iophys can be used to write the ztherm_i variable in a phys.nc file
-!   and check the results; to do so, add "CALL iophys_ini" in physiq_mod
-!   and add knindex to the list of inputs in all the calls to soil.F90
-!   (and to soil.F90 itself !)
-!-----------------------------------------------------------------------
-
-  IF (indice == is_sic) THEN
-     DO ig = 1, knon
-        ztherm_i(ig)   = inertie_sic
-     ENDDO
-     IF (iflag_sic == 0) THEN
-       DO ig = 1, knon
-         IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
-       ENDDO
-!      Otherwise sea-ice keeps the same inertia, even when covered by snow
-     ENDIF
-!    CALL iophys_ecrit_index('ztherm_sic', 1, 'ztherm_sic', 'USI', &
-!      knon, knindex, ztherm_i)
-  ELSE IF (indice == is_lic) THEN
-     DO ig = 1, knon
-        ztherm_i(ig)   = inertie_lic
-        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
-     ENDDO
-!    CALL iophys_ecrit_index('ztherm_lic', 1, 'ztherm_lic', 'USI', &
-!      knon, knindex, ztherm_i)
-  ELSE IF (indice == is_ter) THEN
-     DO ig = 1, knon
-        ztherm_i(ig)   = inertie_sol
-        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
-     ENDDO
-!    CALL iophys_ecrit_index('ztherm_ter', 1, 'ztherm_ter', 'USI', &
-!      knon, knindex, ztherm_i)
-  ELSE IF (indice == is_oce) THEN
-     DO ig = 1, knon
-!       This is just in case, but SST should be used by the model anyway
-        ztherm_i(ig)   = inertie_sic
-     ENDDO
-!    CALL iophys_ecrit_index('ztherm_oce', 1, 'ztherm_oce', 'USI', &
-!      knon, knindex, ztherm_i)
-  ELSE
-     WRITE(lunout,*) "valeur d indice non prevue", indice
-     call abort_physic("soil", "", 1)
-  ENDIF
-
-
-!-----------------------------------------------------------------------
-! 1)
-! Calculation of Cgrf and Dgrd coefficients using soil temperature from 
-! previous time step.
-!
-! These variables are recalculated on the local compressed grid instead 
-! of saved in restart file.
-!-----------------------------------------------------------------------
-  DO jk=1,nsoilmx
-     zdz2(jk)=dz2(jk)/ptimestep
-  ENDDO
-  
-  DO ig=1,knon
-     z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
-     C_coef(ig,nsoilmx-1,indice)= &
-          zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
-     D_coef(ig,nsoilmx-1,indice)=dz1(nsoilmx-1)/z1s
-  ENDDO
-  
-  DO jk=nsoilmx-1,2,-1
-     DO ig=1,knon
-        z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
-             *(1.-D_coef(ig,jk,indice)))
-        C_coef(ig,jk-1,indice)= &
-             (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*C_coef(ig,jk,indice)) * z1s
-        D_coef(ig,jk-1,indice)=dz1(jk-1)*z1s
-     ENDDO
-  ENDDO
-
-!-----------------------------------------------------------------------
-! 2)
-! Computation of the soil temperatures using the Cgrd and Dgrd
-! coefficient computed above
-!
-!-----------------------------------------------------------------------
-
-!    Surface temperature
-  DO ig=1,knon
-     ptsoil(ig,1)=(lambda*C_coef(ig,1,indice)+ptsrf(ig))/  &
-          (lambda*(1.-D_coef(ig,1,indice))+1.)
-  ENDDO
-  
-!   Other temperatures
-  DO jk=1,nsoilmx-1
-     DO ig=1,knon
-        ptsoil(ig,jk+1)=C_coef(ig,jk,indice)+D_coef(ig,jk,indice) &
-             *ptsoil(ig,jk)
-     ENDDO
-  ENDDO
-
-  IF (indice == is_sic) THEN
-     DO ig = 1 , knon
-        ptsoil(ig,nsoilmx) = RTT - 1.8
-     END DO
-  ENDIF
-
-!-----------------------------------------------------------------------
-! 3)
-! Calculate the Cgrd and Dgrd coefficient corresponding to actual soil 
-! temperature
-!-----------------------------------------------------------------------
-  DO ig=1,knon
-     z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
-     C_coef(ig,nsoilmx-1,indice) = zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
-     D_coef(ig,nsoilmx-1,indice) = dz1(nsoilmx-1)/z1s
-  ENDDO
-  
-  DO jk=nsoilmx-1,2,-1
-     DO ig=1,knon
-        z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
-             *(1.-D_coef(ig,jk,indice)))
-        C_coef(ig,jk-1,indice) = &
-             (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*C_coef(ig,jk,indice)) * z1s
-        D_coef(ig,jk-1,indice) = dz1(jk-1)*z1s
-     ENDDO
-  ENDDO
-
-!-----------------------------------------------------------------------
-! 4)
-! Computation of the surface diffusive flux from ground and
-! calorific capacity of the ground
-!-----------------------------------------------------------------------
-  DO ig=1,knon
-     pfluxgrd(ig) = ztherm_i(ig)*dz1(1)* &
-          (C_coef(ig,1,indice)+(D_coef(ig,1,indice)-1.)*ptsoil(ig,1))
-     pcapcal(ig)  = ztherm_i(ig)* &
-          (dz2(1)+ptimestep*(1.-D_coef(ig,1,indice))*dz1(1))
-     z1s = lambda*(1.-D_coef(ig,1,indice))+1.
-     pcapcal(ig)  = pcapcal(ig)/z1s
-     pfluxgrd(ig) = pfluxgrd(ig) &
-          + pcapcal(ig) * (ptsoil(ig,1) * z1s &
-          - lambda * C_coef(ig,1,indice) &
-          - ptsrf(ig)) &
-          /ptimestep
-  ENDDO
-    
-END SUBROUTINE soil
+link ../phylmd/soil.F90
Index: LMDZ6/trunk/libf/phylmdiso/solarlong.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/solarlong.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/solarlong.F90	(revision 3940)
@@ -1,134 +1,1 @@
-SUBROUTINE solarlong(pday, psollong, pdist_sol)
-
-  USE ioipsl
-  USE print_control_mod, ONLY: lunout
-
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Objet:
-  ! ------
-
-  ! Calcul de la distance soleil-planete et de la declinaison
-  ! en fonction du jour de l'annee.
-
-
-  ! Methode:
-  ! --------
-
-  ! Calcul complet de l'elipse
-
-  ! Interface:
-  ! ----------
-
-  ! Uncommon comprenant les parametres orbitaux.
-
-  ! Arguments:
-  ! ----------
-
-  ! Input:
-  ! ------
-  ! pday          jour de l'annee (le jour 0 correspondant a l'equinoxe)
-  ! lwrite        clef logique pour sorties de controle
-
-  ! Output:
-  ! -------
-  ! pdist_sol     distance entre le soleil et la planete
-  ! ( en unite astronomique pour utiliser la constante
-  ! solaire terrestre 1370 Wm-2 )
-  ! pdecli        declinaison ( en radians )
-
-  ! =======================================================================
-  ! -----------------------------------------------------------------------
-  ! Declarations:
-  ! -------------
-
-  include "planete.h"
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  REAL pday, pdist_sol, pdecli, psollong
-  LOGICAL lwrite
-
-  ! Local:
-  ! ------
-
-  REAL zanom, xref, zx0, zdx, zteta, zz, pi
-  INTEGER iter
-  REAL :: pyear_day, pperi_day
-  REAL :: jd_eq, jd_peri
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-
-  ! -----------------------------------------------------------------------
-  ! calcul de l'angle polaire et de la distance au soleil :
-  ! -------------------------------------------------------
-
-  ! Initialisation eventuelle:
-  IF (first) THEN
-    CALL ioget_calendar(pyear_day)
-    CALL ymds2ju(2000, 3, 21, 0., jd_eq)
-    CALL ymds2ju(2001, 1, 4, 0., jd_peri)
-    pperi_day = jd_peri - jd_eq
-    pperi_day = r_peri + 180.
-    WRITE (lunout, *) ' Number of days in a year = ', pyear_day
-    ! call iniorbit(249.22,206.66,669.,485.,25.2)
-    CALL iniorbit(152.59, 146.61, pyear_day, pperi_day, r_incl)
-    first = .FALSE.
-  END IF
-
-  ! calcul de l'zanomalie moyenne
-
-  zz = (pday-peri_day)/year_day
-  pi = 2.*asin(1.)
-  zanom = 2.*pi*(zz-nint(zz))
-  xref = abs(zanom)
-
-  ! resolution de l'equation horaire  zx0 - e * sin (zx0) = xref
-  ! methode de Newton
-
-  ! zx0=xref+e_elips*sin(xref)
-  zx0 = xref + r_ecc*sin(xref)
-  DO iter = 1, 10
-    ! zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0))
-    zdx = -(zx0-r_ecc*sin(zx0)-xref)/(1.-r_ecc*cos(zx0))
-    IF (abs(zdx)<=(1.E-7)) GO TO 120
-    zx0 = zx0 + zdx
-  END DO
-120 CONTINUE
-  zx0 = zx0 + zdx
-  IF (zanom<0.) zx0 = -zx0
-
-  ! zteta est la longitude solaire
-
-  ! zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
-  zteta = 2.*atan(sqrt((1.+r_ecc)/(1.-r_ecc))*tan(zx0/2.))
-
-  psollong = zteta - timeperi
-
-  IF (psollong<0.) psollong = psollong + 2.*pi
-  IF (psollong>2.*pi) psollong = psollong - 2.*pi
-
-  psollong = psollong*180./pi
-
-  ! distance soleil
-
-  pdist_sol = (1-r_ecc*r_ecc)/(1+r_ecc*cos(pi/180.*(psollong- &
-    (r_peri+180.0))))
-  ! pdist_sol = (1-e_elips*e_elips)
-  ! &      /(1+e_elips*COS(pi/180.*(psollong-(R_peri+180.0))))
-  ! -----------------------------------------------------------------------
-  ! sorties eventuelles:
-  ! ---------------------
-
-  ! IF (lwrite) THEN
-  ! PRINT*,'jour de l"annee   :',pday
-  ! PRINT*,'distance au soleil (en unite astronomique) :',pdist_sol
-  ! PRINT*,'declinaison (en degres) :',pdecli*180./pi
-  ! ENDIF
-
-  RETURN
-END SUBROUTINE solarlong
+link ../phylmd/solarlong.F90
Index: LMDZ6/trunk/libf/phylmdiso/stdlevvarr_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/stdlevvarr_mod.F90	(revision 3940)
+++ LMDZ6/trunk/libf/phylmdiso/stdlevvarr_mod.F90	(revision 3940)
@@ -0,0 +1,1 @@
+link ../phylmd/stdlevvarr_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/stratocu_if.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/stratocu_if.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/stratocu_if.F90	(revision 3940)
@@ -1,80 +1,1 @@
-  SUBROUTINE stratocu_if(klon,klev,pctsrf,paprs, pplay,t &
-,seuil_inversion,weak_inversion,dthmin)
-
-  USE indice_sol_mod
-
-IMPLICIT NONE
-
-!======================================================================
-! 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:
-! klon-----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)
-!
-! weak_inversion-----logical
-!======================================================================
-!
-! Arguments:
-!
-    INTEGER, INTENT(IN)                       :: klon,klev
-    REAL, DIMENSION(klon, klev+1), INTENT(IN) ::  paprs
-    REAL, DIMENSION(klon, klev), INTENT(IN)   ::  pplay
-    REAL, DIMENSION(klon, 4), INTENT(IN)   ::  pctsrf
-    REAL, DIMENSION(klon, klev), INTENT(IN)   :: t
-    
-    REAL, DIMENSION(klon), INTENT(OUT)  :: weak_inversion
-!
-! Quelques constantes et options:
-!
-    REAL seuil_inversion ! au-dela l'inversion est consideree trop faible
-!    PARAMETER (seuil=-0.1)
-
-!
-! Variables locales:
-!
-    INTEGER i, k, invb(klon)
-    REAL zl2(klon)
-    REAL dthmin(klon), zdthdp
-
-    INCLUDE "YOMCST.h"
-
-!
-! Chercher la zone d'inversion forte
-!
-
-    DO i = 1, klon
-       invb(i) = klev
-       dthmin(i)=0.0
-    ENDDO
-    DO k = 2, klev/2-1
-       DO i = 1, klon
-          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).GT.0.8*paprs(i,1) .AND. &
-               zdthdp.LT.dthmin(i) ) THEN
-             dthmin(i) = zdthdp
-             invb(i) = k
-          ENDIF
-       ENDDO
-    ENDDO
-
-
-!
-! Introduire une diffusion:
-!
-    DO i = 1, klon
-       IF ( (pctsrf(i,is_oce) < 0.5) .OR. &
-          (invb(i) == klev) .OR. (dthmin(i) > seuil_inversion) ) THEN 
-          weak_inversion(i)=1.
-       ELSE
-          weak_inversion(i)=0.
-       ENDIF
-    ENDDO
-
-  END SUBROUTINE stratocu_if
+link ../phylmd/stratocu_if.F90
Index: LMDZ6/trunk/libf/phylmdiso/stratosphere_mask.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/stratosphere_mask.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/stratosphere_mask.F90	(revision 3940)
@@ -1,252 +1,1 @@
-!
-! $Id: stratosphere_mask.F90 3123 2017-12-13 13:16:38Z oboucher $
-!
-SUBROUTINE stratosphere_mask(missing_val, pphis, t_seri, pplay, xlat)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-! determination of tropopause height and temperature from gridded temperature data
-!
-! reference: Reichler, T., M. Dameris, and R. Sausen (GRL, 10.1029/2003GL018240, 2003)
-! modified: 6/28/06 tjr
-! adapted to LMDZ by C. Kleinschmitt (2016-02-15)
-! committed to LMDz by O. Boucher (2016) with a mistake 
-! mistake corrected by O. Boucher (2017-12-11)
-!
-! input:  temp(nlon,nlat,nlev)  3D-temperature field 
-!         ps(nlon,nlat)         2D-surface pressure field
-!         zs(nlon,nlat)         2D-surface height
-!         nlon                  grid points in x
-!         nlat                  grid points in y
-!         pfull(nlon,nlat,nlev) full pressure levels in Pa
-!         plimu                 upper limit for tropopause pressure
-!         pliml                 lower limit for tropopause pressure 
-!         gamma                 tropopause criterion, e.g. -0.002 K/m
-!
-! output: p_tropopause(klon)    tropopause pressure in Pa with missing values
-!         t_tropopause(klon)    tropopause temperature in K with missing values
-!         z_tropopause(klon)    tropopause height in m with missing values
-!         stratomask            stratospheric mask withtout missing values
-!         ifil                  # of undetermined values
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USE dimphy
-USE phys_local_var_mod, ONLY: stratomask
-USE phys_local_var_mod, ONLY: p_tropopause, z_tropopause, t_tropopause
-USE print_control_mod, ONLY: lunout, prt_level
-
-IMPLICIT NONE
-
-INCLUDE "YOMCST.h"
-
-REAL, INTENT(IN)                       :: missing_val ! missing value, also XIOS
-REAL,DIMENSION(klon),INTENT(IN)        :: pphis   ! Geopotentiel de surface
-REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-REAL,DIMENSION(klon),INTENT(IN)        :: xlat    ! latitudes pour chaque point 
-
-REAL, PARAMETER                        :: plimu=45000.
-REAL, PARAMETER                        :: pliml=7500.
-REAL, PARAMETER                        :: gamma=-0.002
-LOGICAL, PARAMETER                     :: dofill=.true.
-REAL,DIMENSION(klon)                   :: tp
-REAL,DIMENSION(klev)                   :: t, p
-INTEGER                                :: i, k, ifil
-REAL                                   :: ptrp, ttrp, ztrp, psrf, zsrf, pi
-
-pi     = 4.*ATAN(1.)
-
-!--computing tropopause
-DO i=1,klon
-  DO k=1,klev 
-    t(k)=t_seri(i,klev+1-k) 
-    p(k)=pplay(i,klev+1-k)
-  ENDDO
-  psrf=pplay(i,1)
-  zsrf=pphis(i)/RG           !--altitude de la surface
-  call twmo(missing_val, klev, t, p, psrf, zsrf, plimu, pliml, gamma, ptrp, ttrp, ztrp)
-  tp(i)=ptrp
-  p_tropopause(i)=ptrp
-  z_tropopause(i)=ztrp
-  t_tropopause(i)=ttrp
-ENDDO
-
-!--filling holes in tp but not in p_tropopause
-IF (dofill) THEN
-  ifil=0
-  DO i=1,klon
-  IF (ABS(tp(i)/missing_val-1.0).LT.0.01) THEN
-    !set missing values to very simple profile (neighbour averaging too expensive in LMDZ)
-    tp(i)=50000.-20000.*cos(xlat(i)/360.*2.*pi)
-    ifil=ifil+1
-  ENDIF
-  ENDDO
-!
-ENDIF
-!
-DO i=1, klon
-DO k=1, klev
-  IF (pplay(i,k).LT.tp(i)) THEN
-    stratomask(i,k)=1.0
-  ELSE
-    stratomask(i,k)=0.0
-  ENDIF
-ENDDO
-ENDDO
-
-IF (ifil.GT.0 .AND. prt_level >5) THEN
-  write(lunout,*)'Tropopause: number of undetermined values =', ifil
-ENDIF
-
-RETURN
-END SUBROUTINE stratosphere_mask
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! twmo
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-subroutine twmo(missing_val, level, t, p, ps, zs, plimu, pliml, gamma, ptrp, ttrp, ztrp)
-
-! reference: Reichler, T., M. Dameris, and R. Sausen (GRL, 10.1029/2003GL018240, 2003)
-
-implicit none
-
-include "YOMCST.h"
-
-integer,intent(in)              :: level
-real,intent(in)                 :: missing_val
-real,intent(in),dimension(level):: t, p
-real,intent(in)                 :: plimu, pliml, gamma, ps, zs
-real,intent(out)                :: ptrp, ttrp, ztrp
-
-real,parameter                  :: deltaz = 2000.0
-
-real     :: faktor
-real     :: pmk, pm, a, b, tm, dtdp, dtdz, dlnp, tdlnp
-real     :: ag, bg, ptph, ttph, a0, b0
-real     :: pm0, tm0, pmk0, dtdz0
-real     :: p2km, asum, aquer
-real     :: pmk2, pm2, a2, b2, tm2, dtdp2, dtdz2
-integer  :: icount, jj, j
-
-ptrp=missing_val
-ttrp=missing_val
-ztrp=missing_val
-
-faktor = -RG/RD
-
-do j=level,2,-1
-
-   ! dt/dz
-   pmk= 0.5 * (p(j-1)**rkappa+p(j)**rkappa)        ! p**k at half level
-   pm = pmk**(1./rkappa)                    ! p at half level
-   a = (t(j-1)-t(j))/(p(j-1)**rkappa-p(j)**rkappa)    ! dT/dp^k
-   b = t(j)-(a*p(j)**rkappa)
-   tm = a * pmk + b                    ! T at half level         
-   dtdp = a * rkappa * pm**(rkappa-1.) ! dT/dp at half level
-   dtdz = faktor*dtdp*pm/tm            ! dT/dz at half level
-
-   ! dt/dz valid?
-   if (j.eq.level)     go to 999                 ! no, start level, initialize first
-   if (dtdz.le.gamma)  go to 999                 ! no, dt/dz < -2 K/km
-   if (dtdz0.gt.gamma) go to 999                 ! no, dt/dz below > -2 K/km
-   if (pm.gt.plimu)    go to 999                 ! no, pm too low
-
-   ! dtdz is valid, calculate tropopause pressure ptph
-   ag = (dtdz-dtdz0) / (pmk-pmk0)     
-   bg = dtdz0 - (ag * pmk0)          
-   ptph = exp(log((gamma-bg)/ag)/rkappa)
-
-   ! calculate temperature at this ptph assuming linear gamma
-   ! interpolation
-   ttph = tm0
-   ttph = ttph - (bg * log(pm0)  + ag * (pm0**rkappa) /rkappa) / faktor*t(j)
-   ttph = ttph + (bg * log(ptph) + ag * (ptph**rkappa)/rkappa) / faktor*t(j)
-
-   if (ptph.lt.pliml) go to 999 
-   if (ptph.gt.plimu) go to 999     
-
-   ! 2nd test: dtdz above 2 km must not exceed gamma
-   p2km = ptph + deltaz*(pm/tm)*faktor      ! p at ptph + 2km
-   asum = 0.0                               ! dtdz above
-   icount = 0                               ! number of levels above
-
-   ! test until apm < p2km
-   do jj=j,2,-1
-
-       pmk2 = .5 * (p(jj-1)**rkappa+p(jj)**rkappa)    ! p mean ^kappa
-       pm2 = pmk2**(1/rkappa)                      ! p mean
-       if(pm2.gt.ptph) go to 110                ! doesn't happen
-       if(pm2.lt.p2km) go to 888                ! ptropo is valid
-
-       a2 = (t(jj-1)-t(jj))                     ! a
-       a2 = a2/(p(jj-1)**rkappa-p(jj)**rkappa)
-       b2 = t(jj)-(a2*p(jj)**rkappa)               ! b
-       tm2 = a2 * pmk2 + b2                     ! T mean
-       dtdp2 = a2 * rkappa * (pm2**(rkappa-1))        ! dt/dp
-       dtdz2 = faktor*dtdp2*pm2/tm2
-       asum = asum+dtdz2
-       icount = icount+1
-       aquer = asum/float(icount)               ! dt/dz mean
-   
-       ! discard ptropo ?
-        if (aquer.le.gamma) go to 999           ! dt/dz above < gamma
-
-110 continue 
-    enddo                   ! test next level
-
-888 continue                    ! ptph is valid
-    ptrp = ptph
-    ttrp = ttph
-
-! now calculate height of tropopause by integrating hypsometric equation
-! from ps to ptrp
-! linearly interpolate in p (results are identical to p^kappa)
-
-jj = LEVEL                                       ! bottom
-do while ((P(jj).gt.PS) .or. (T(jj).lt.100))     ! T must be valid too
-  jj=jj-1
-enddo
-
-DLNP = log(PS/P(jj))                             ! from surface pressure
-TM = T(jj)                                       ! take TM of lowest level (better: extrapolate)
-TDLNP = TM*DLNP
-
-do while ( (JJ.ge.2) .and. (PTRP.lt.P(jj-1)) ) 
-  DLNP = log(P(jj)/P(jj-1))
-  TM = 0.5 * (T(jj) + T(jj-1))
-  TDLNP = TDLNP + TM*DLNP
-  JJ=JJ-1
-enddo
-
-DLNP = log(P(jj)/PTRP)                           ! up to tropopause pressure
-TM = 0.5 * (T(jj) + TTRP)                        ! use TTRP to get TM of this level
-TDLNP = TDLNP + TM*DLNP
-
-ZTRP = ZS + TDLNP*RD/RG
-
-!!if (ZTRP .lt. 0) then
-!!  print*,'ZTRP=',ZTRP
-!!  print*,'PS=',PS
-!!  print*,'P=',P
-!!  print*,'T=',T
-!!  print*,'ZS=',ZS
-!!  stop
-!!endif
-
-return
-
-999 continue                    ! continue search at next higher level 
-    tm0 = tm
-    pm0 = pm
-    pmk0 = pmk
-    dtdz0  = dtdz
-    a0 = a
-    b0 = b
-
-enddo 
-
-! no tropopouse found
-return
-end subroutine twmo
+link ../phylmd/stratosphere_mask.F90
Index: LMDZ6/trunk/libf/phylmdiso/sumethox.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/sumethox.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/sumethox.F90	(revision 3940)
@@ -1,69 +1,1 @@
-SUBROUTINE SUMETHOX
-
-!**** *SUCLDP*   - INITIALIZE MODULE YOEMETH CONTROLLING *METHOX*
-
-!     PURPOSE.
-!     --------
-!           INITIALIZE YOEMETH
-
-!**   INTERFACE.
-!     ----------
-!        CALL *SUMETHOX* FROM *SUPHEC*
-!              --------        ------
-
-!        EXPLICIT ARGUMENTS :
-!        --------------------
-!        NONE
-
-!        IMPLICIT ARGUMENTS :
-!        --------------------
-!        MODULE YOEMETH
-
-!     METHOD.
-!     -------
-!        SEE DOCUMENTATION
-
-!     EXTERNALS.
-!     ----------
-!        NONE
-
-!     REFERENCE.
-!     ----------
-!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE
-!     "INTEGRATED FORECASTING SYSTEM"
-
-!     AUTHOR.
-!     -------
-!        C.JAKOB   *ECMWF*
-
-!     MODIFICATIONS.
-!     --------------
-!        ORIGINAL : 98-04-07
-!        Modified : 02-01-29  A.Simmons: increase RQLIM from 3.75e-6
-!        M.Hamrud      01-Oct-2003 CY28 Cleaning
-!        D. Cugnet     24-Feb-2012 Adapted for LMDZ
-!     ------------------------------------------------------------------
-
-USE YOEMETH   , ONLY : RALPHA1 ,RALPHA2  ,RQLIM   ,&
- & RPBOTOX,  RPBOTPH ,RPTOPOX  ,RPTOPPH ,&
- & RALPHA3,  RLOGPPH  
-
-!*       1.    SET VALUES
-!              ----------
-
-IMPLICIT NONE
-RALPHA1=(19.*LOG(10.))/(LOG(20.)**4)
-RALPHA2=LOG(1.0/3.+0.01)
-RQLIM=4.25E-6
-RPBOTOX=10000.
-RPBOTPH=20.
-RPTOPOX=50.
-RPTOPPH=0.1
-RALPHA3=0.5*(LOG(100.)+RALPHA2)
-RLOGPPH=LOG(RPTOPPH/RPBOTPH)
-
-!     -----------------------------------------------------------------
-
-END SUBROUTINE SUMETHOX
-
-
+link ../phylmd/sumethox.F90
Index: LMDZ6/trunk/libf/phylmdiso/suphel.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/suphel.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/suphel.F90	(revision 3940)
@@ -1,229 +1,1 @@
-
-! $Header$
-
-SUBROUTINE suphel
-
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-  ! IM cf. JLD
-  LOGICAL firstcall
-  SAVE firstcall
-  !$OMP THREADPRIVATE(firstcall)
-  DATA firstcall/.TRUE./
-
-  IF (firstcall) THEN
-    PRINT *, 'suphel initialise les constantes du GCM'
-    firstcall = .FALSE.
-  ELSE
-    PRINT *, 'suphel DEJA APPELE '
-    RETURN
-  END IF
-  ! -----------------------------------------------------------------
-
-  ! *       1.    DEFINE FUNDAMENTAL CONSTANTS.
-  ! -----------------------------
-
-  WRITE (UNIT=6, FMT='(''0*** Constants of the ICM   ***'')')
-  rpi = 2.*asin(1.)
-  rclum = 299792458.
-  rhpla = 6.6260755E-34
-  rkbol = 1.380658E-23
-  rnavo = 6.0221367E+23
-  WRITE (UNIT=6, FMT='('' *** Fundamental constants ***'')')
-  WRITE (UNIT=6, FMT='(''           PI = '',E13.7,'' -'')') rpi
-  WRITE (UNIT=6, FMT='(''            c = '',E13.7,''m s-1'')') rclum
-  WRITE (UNIT=6, FMT='(''            h = '',E13.7,''J s'')') rhpla
-  WRITE (UNIT=6, FMT='(''            K = '',E13.7,''J K-1'')') rkbol
-  WRITE (UNIT=6, FMT='(''            N = '',E13.7,''mol-1'')') rnavo
-
-  ! ----------------------------------------------------------------
-
-  ! *       2.    DEFINE ASTRONOMICAL CONSTANTS.
-  ! ------------------------------
-
-  rday = 86400.
-  rea = 149597870000.
-  repsm = 0.409093
-
-  rsiyea = 365.25*rday*2.*rpi/6.283076
-  rsiday = rday/(1.+rday/rsiyea)
-  romega = 2.*rpi/rsiday
-
-  ! exp1      R_ecc = 0.05
-  ! exp1      R_peri = 102.04
-  ! exp1      R_incl = 22.5
-  ! exp1      print*, 'Parametres orbitaux modifies'
-  ! ref      R_ecc = 0.016724
-  ! ref      R_peri = 102.04
-  ! ref      R_incl = 23.5
-
-  ! IM 161002 : pour avoir les ctes AMIP II
-  ! IM 161002   R_ecc = 0.016724
-  ! IM 161002   R_peri = 102.04
-  ! IM 161002   R_incl = 23.5
-  ! IM on mets R_ecc, R_peri, R_incl dans conf_phys.F90
-  ! R_ecc = 0.016715
-  ! R_peri = 102.7
-  ! R_incl = 23.441
-
-  WRITE (UNIT=6, FMT='('' *** Astronomical constants ***'')')
-  WRITE (UNIT=6, FMT='(''          day = '',E13.7,'' s'')') rday
-  WRITE (UNIT=6, FMT='('' half g. axis = '',E13.7,'' m'')') rea
-  WRITE (UNIT=6, FMT='('' mean anomaly = '',E13.7,'' -'')') repsm
-  WRITE (UNIT=6, FMT='('' sideral year = '',E13.7,'' s'')') rsiyea
-  WRITE (UNIT=6, FMT='(''  sideral day = '',E13.7,'' s'')') rsiday
-  WRITE (UNIT=6, FMT='(''        omega = '',E13.7,'' s-1'')') romega
-  ! write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
-  ! write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
-  ! write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
-
-  ! ------------------------------------------------------------------
-
-  ! *       3.    DEFINE GEOIDE.
-  ! --------------
-
-  rg = 9.80665
-  ra = 6371229.
-  r1sa = sngl(1.D0/dble(ra))
-  WRITE (UNIT=6, FMT='('' ***         Geoide         ***'')')
-  WRITE (UNIT=6, FMT='(''      Gravity = '',E13.7,'' m s-2'')') rg
-  WRITE (UNIT=6, FMT='('' Earth radius = '',E13.7,'' m'')') ra
-  WRITE (UNIT=6, FMT='('' Inverse E.R. = '',E13.7,'' m'')') r1sa
-
-  ! -----------------------------------------------------------------
-
-  ! *       4.    DEFINE RADIATION CONSTANTS.
-  ! ---------------------------
-
-  ! z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
-  rsigma = 2.*rpi**5*(rkbol/rhpla)**3*rkbol/rclum/rclum/15.
-  ! IM init. dans conf_phys.F90   RI0=1365.
-  WRITE (UNIT=6, FMT='('' ***        Radiation       ***'')')
-  WRITE (UNIT=6, FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'' &
-    &                                                         &
-    &         )') rsigma
-  ! IM init. dans conf_phys.F90   WRITE(UNIT=6,FMT='('' Solar const. =
-  ! '',E13.7,'' W m-2'')')
-  ! IM init. dans conf_phys.F90  S      RI0
-
-  ! -----------------------------------------------------------------
-
-  ! *       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
-  ! ------------------------------------------
-
-  r = rnavo*rkbol
-  rmd = 28.9644
-  rmo3 = 47.9942
-  rmco2 = 44.011
-  rmch4 = 16.043
-  rmn2o = 44.013
-  rmcfc11 = 137.3686
-  rmcfc12 = 120.9140
-  rmc   = 12.0107
-  rmv = 18.0153
-  rd = 1000.*r/rmd
-  rv = 1000.*r/rmv
-  rcpd = 3.5*rd
-  rcvd = rcpd - rd
-  rcpv = 4.*rv
-  rcvv = rcpv - rv
-  rkappa = rd/rcpd
-  retv = rv/rd - 1.
-  WRITE (UNIT=6, FMT='('' *** Thermodynamic, gas     ***'')')
-  WRITE (UNIT=6, FMT='('' Perfect gas  = '',e13.7)') r
-  WRITE (UNIT=6, FMT='('' Dry air mass = '',e13.7)') rmd
-  WRITE (UNIT=6, FMT='('' Ozone   mass = '',e13.7)') rmo3
-  WRITE (UNIT=6, FMT='('' CO2     mass = '',e13.7)') rmco2
-  WRITE (UNIT=6, FMT='('' C       mass = '',e13.7)') rmc
-  WRITE (UNIT=6, FMT='('' CH4     mass = '',e13.7)') rmch4
-  WRITE (UNIT=6, FMT='('' N2O     mass = '',e13.7)') rmn2o
-  WRITE (UNIT=6, FMT='('' CFC11   mass = '',e13.7)') rmcfc11
-  WRITE (UNIT=6, FMT='('' CFC12   mass = '',e13.7)') rmcfc12
-  WRITE (UNIT=6, FMT='('' Vapour  mass = '',e13.7)') rmv
-  WRITE (UNIT=6, FMT='('' Dry air cst. = '',e13.7)') rd
-  WRITE (UNIT=6, FMT='('' Vapour  cst. = '',e13.7)') rv
-  WRITE (UNIT=6, FMT='(''         Cpd  = '',e13.7)') rcpd
-  WRITE (UNIT=6, FMT='(''         Cvd  = '',e13.7)') rcvd
-  WRITE (UNIT=6, FMT='(''         Cpv  = '',e13.7)') rcpv
-  WRITE (UNIT=6, FMT='(''         Cvv  = '',e13.7)') rcvv
-  WRITE (UNIT=6, FMT='(''      Rd/Cpd  = '',e13.7)') rkappa
-  WRITE (UNIT=6, FMT='(''     Rv/Rd-1  = '',e13.7)') retv
-
-  ! ----------------------------------------------------------------
-
-  ! *       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
-  ! ---------------------------------------------
-
-  rcw = rcpv
-  WRITE (UNIT=6, FMT='('' *** Thermodynamic, liquid  ***'')')
-  WRITE (UNIT=6, FMT='(''         Cw   = '',E13.7)') rcw
-
-  ! ----------------------------------------------------------------
-
-  ! *       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
-  ! --------------------------------------------
-
-  rcs = rcpv
-  WRITE (UNIT=6, FMT='('' *** thermodynamic, solid   ***'')')
-  WRITE (UNIT=6, FMT='(''         Cs   = '',E13.7)') rcs
-
-  ! ----------------------------------------------------------------
-
-  ! *       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
-  ! ----------------------------------------------------
-
-  rtt = 273.16
-  rlvtt = 2.5008E+6
-  rlstt = 2.8345E+6
-  rlmlt = rlstt - rlvtt
-  ratm = 100000.
-  WRITE (UNIT=6, FMT='('' *** Thermodynamic, trans.  ***'')')
-  WRITE (UNIT=6, FMT='('' Fusion point  = '',E13.7)') rtt
-  WRITE (UNIT=6, FMT='(''        RLvTt  = '',E13.7)') rlvtt
-  WRITE (UNIT=6, FMT='(''        RLsTt  = '',E13.7)') rlstt
-  WRITE (UNIT=6, FMT='(''        RLMlt  = '',E13.7)') rlmlt
-  WRITE (UNIT=6, FMT='('' Normal press. = '',E13.7)') ratm
-  WRITE (UNIT=6, FMT='('' Latent heat :  '')')
-
-  ! ----------------------------------------------------------------
-
-  ! *       9.    SATURATED VAPOUR PRESSURE.
-  ! --------------------------
-
-  restt = 611.14
-  rgamw = (rcw-rcpv)/rv
-  rbetw = rlvtt/rv + rgamw*rtt
-  ralpw = log(restt) + rbetw/rtt + rgamw*log(rtt)
-  rgams = (rcs-rcpv)/rv
-  rbets = rlstt/rv + rgams*rtt
-  ralps = log(restt) + rbets/rtt + rgams*log(rtt)
-  rgamd = rgams - rgamw
-  rbetd = rbets - rbetw
-  ralpd = ralps - ralpw
-
-  ! ------------------------------------------------------------------
-
-  ! *       10.   CONSTANTS FOR THERMODYNAMICAL FUNCTIONS.
-  ! ----------------------------------------
-
-  rvtmp2 = rcpv/rcpd - 1.
-  rhoh2o = ratm/100.
-  r2es = restt*rd/rv
-  r3les = 17.269
-  r3ies = 21.875
-  r4les = 35.86
-  r4ies = 7.66
-  r5les = r3les*(rtt-r4les)
-  r5ies = r3ies*(rtt-r4ies)
-
-  ! ------------------------------------------------------------------
-
-  ! *       10.   CONSTANTS FOR METHANE OXIDATION AND PHOTOLYSIS.
-  ! -----------------------------------------------
-
-  CALL SUMETHOX()
-
-  RETURN
-END SUBROUTINE suphel
+link ../phylmd/suphel.F90
Index: LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_mod.F90	(revision 3940)
@@ -1,852 +1,1 @@
-!
-MODULE surf_land_orchidee_mod
-#ifndef ORCHIDEE_NOOPENMP
-#ifndef ORCHIDEE_NOZ0H
-#ifndef ORCHIDEE_NOFREIN
-#ifndef ORCHIDEE_NOUNSTRUCT
-!
-! This module controles the interface towards the model ORCHIDEE.
-!
-! Compatibility with ORCHIDIEE :
-! The current version can be used with ORCHIDEE/trunk from revision 4465.
-! This interface is used if none of the cpp keys ORCHIDEE_NOOPENMP, 
-! ORCHIDEE_NOZ0H or ORCHIDEE_NOFREIN is set.
-!
-! Subroutines in this module : surf_land_orchidee
-!                              Init_orchidee_index
-!                              Get_orchidee_communicator
-!                              Init_neighbours
-
-  USE dimphy
-#ifdef CPP_VEGET
-  USE intersurf     ! module d'ORCHIDEE
-#endif
-  USE cpl_mod,      ONLY : cpl_send_land_fields
-  USE surface_data, ONLY : type_ocean
-  USE geometry_mod, ONLY : dx, dy, boundslon, boundslat,longitude, latitude, cell_area,  ind_cell_glo
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
-  USE carbon_cycle_mod, ONLY : nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out
-  USE nrtype, ONLY : PI
-  
-  IMPLICIT NONE
-
-  PRIVATE
-  PUBLIC  :: surf_land_orchidee
-
-CONTAINS
-!
-!****************************************************************************************
-!  
-  SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
-       knindex, rlon, rlat, yrmu0, pctsrf, &
-       debut, lafin, &
-       plev,  u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, & 
-       tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-       precip_rain, precip_snow, lwdown, swnet, swdown, &
-       ps, q2m, t2m, &
-       evap, fluxsens, fluxlat, &              
-       tsol_rad, tsurf_new, alb1_new, alb2_new, &
-       emis_new, z0m_new, z0h_new, qsurf, &
-       veget, lai, height )
-
-    USE mod_surf_para
-    USE mod_synchro_omp
-    USE carbon_cycle_mod
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: lunout
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-#ifdef CPP_VEGET
-    USE time_phylmdz_mod, ONLY: itau_phy 
-#endif
-!    
-! Cette routine sert d'interface entre le modele atmospherique et le 
-! modele de sol continental. Appel a sechiba
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps
-!   dtime        pas de temps de la physique (en s)
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-!   knindex      index des points de la surface a traiter
-!   rlon         longitudes de la grille entiere
-!   rlat         latitudes de la grille entiere
-!   pctsrf       tableau des fractions de surface de chaque maille
-!   debut        logical: 1er appel a la physique (lire les restart)
-!   lafin        logical: dernier appel a la physique (ecrire les restart)
-!                     (si false calcul simplifie des fluxs sur les continents)
-!   plev         hauteur de la premiere couche (Pa)      
-!   u1_lay       vitesse u 1ere couche
-!   v1_lay       vitesse v 1ere couche
-!   temp_air     temperature de l'air 1ere couche
-!   spechum      humidite specifique 1ere couche
-!   epot_air     temp pot de l'air
-!   ccanopy      concentration CO2 canopee, correspond au co2_send de 
-!                carbon_cycle_mod ou valeur constant co2_ppm
-!   tq_cdrag     cdrag
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   precip_rain  precipitation liquide
-!   precip_snow  precipitation solide
-!   lwdown       flux IR descendant a la surface
-!   swnet        flux solaire net
-!   swdown       flux solaire entrant a la surface
-!   ps           pression au sol
-!   radsol       rayonnement net aus sol (LW + SW)
-!
-! output:
-!   evap         evaporation totale
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   tsol_rad     
-!   tsurf_new    temperature au sol
-!   alb1_new     albedo in visible SW interval
-!   alb2_new     albedo in near IR interval
-!   emis_new     emissivite
-!   z0m_new      surface roughness for momentum
-!   z0h_new      surface roughness for heat
-!   qsurf        air moisture at surface
-!
-    INCLUDE "YOMCST.h"
-    INCLUDE "dimpft.h"
-!
-! Parametres d'entree
-!****************************************************************************************
-    INTEGER, INTENT(IN)                       :: itime
-    REAL, INTENT(IN)                          :: dtime
-    REAL, INTENT(IN)                          :: date0
-    INTEGER, INTENT(IN)                       :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-    LOGICAL, INTENT(IN)                       :: debut, lafin
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)   :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)         :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)         :: yrmu0 ! cosine of solar zenith angle
-    REAL, DIMENSION(klon), INTENT(IN)         :: plev
-    REAL, DIMENSION(klon), INTENT(IN)         :: u1_lay, v1_lay, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)         :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)         :: epot_air, ccanopy
-    REAL, DIMENSION(klon), INTENT(IN)         :: tq_cdrag
-    REAL, DIMENSION(klon), INTENT(IN)         :: petAcoef, peqAcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)         :: lwdown, swnet, swdown, ps
-    REAL, DIMENSION(klon), INTENT(IN)         :: q2m, t2m
-
-! Parametres de sortie
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)        :: evap, fluxsens, fluxlat, qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)        :: tsol_rad, tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: alb1_new, alb2_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: emis_new, z0m_new, z0h_new
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: lai
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
-
-! Local
-!****************************************************************************************
-    INTEGER                                   :: ij, jj, igrid, ireal, index, nb
-    INTEGER                                   :: error
-    REAL, DIMENSION(klon)                     :: swdown_vrai
-    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
-    CHARACTER (len = 80)                      :: abort_message
-    LOGICAL,SAVE                              :: check = .FALSE.
-    !$OMP THREADPRIVATE(check)
-
-! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
-! drapeaux controlant les appels dans SECHIBA
-!  type(control_type), save   :: control_in
-! Preserved albedo
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: albedo_keep, zlev
-    !$OMP THREADPRIVATE(albedo_keep,zlev)
-! coordonnees geographiques
-    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: lalo
-    !$OMP THREADPRIVATE(lalo)
-! boundaries of cells
-    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: bounds_lalo
-    !$OMP THREADPRIVATE(bounds_lalo)
-! pts voisins
-    INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
-    !$OMP THREADPRIVATE(neighbours)
-! fractions continents
-    REAL,ALLOCATABLE, DIMENSION(:), SAVE      :: contfrac
-    !$OMP THREADPRIVATE(contfrac)
-! resolution de la grille
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: resolution
-    !$OMP THREADPRIVATE(resolution)
-
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: lon_scat, lat_scat  
-    !$OMP THREADPRIVATE(lon_scat,lat_scat)
-
-! area of cells
-    REAL, ALLOCATABLE, DIMENSION (:), SAVE  :: area  
-    !$OMP THREADPRIVATE(area)
-
-    LOGICAL, SAVE                             :: lrestart_read = .TRUE.
-    !$OMP THREADPRIVATE(lrestart_read)
-    LOGICAL, SAVE                             :: lrestart_write = .FALSE.
-    !$OMP THREADPRIVATE(lrestart_write)
-
-    REAL, DIMENSION(knon,2)                   :: albedo_out
-
-! Pb de nomenclature
-    REAL, DIMENSION(klon)                     :: petA_orc, peqA_orc
-    REAL, DIMENSION(klon)                     :: petB_orc, peqB_orc
-! Pb de correspondances de grilles
-    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE  :: ig, jg
-    !$OMP THREADPRIVATE(ig,jg)
-    INTEGER :: indi, indj
-    INTEGER, SAVE, ALLOCATABLE,DIMENSION(:)   :: ktindex
-    !$OMP THREADPRIVATE(ktindex)
-
-! Essai cdrag
-    REAL, DIMENSION(klon)                     :: cdrag
-    INTEGER,SAVE                              :: offset
-    !$OMP THREADPRIVATE(offset)
-
-    REAL, DIMENSION(klon_glo)                 :: rlon_g,rlat_g
-    INTEGER, SAVE                             :: orch_comm
-    !$OMP THREADPRIVATE(orch_comm)
-
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: coastalflow
-    !$OMP THREADPRIVATE(coastalflow)
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: riverflow
-    !$OMP THREADPRIVATE(riverflow)
-    
-    INTEGER :: orch_mpi_rank
-    INTEGER :: orch_mpi_size
-    INTEGER :: orch_omp_rank
-    INTEGER :: orch_omp_size
-
-    REAL, ALLOCATABLE, DIMENSION(:)         :: longitude_glo
-    REAL, ALLOCATABLE, DIMENSION(:)         :: latitude_glo
-    REAL, ALLOCATABLE, DIMENSION(:,:)       :: boundslon_glo
-    REAL, ALLOCATABLE, DIMENSION(:,:)       :: boundslat_glo
-    INTEGER, ALLOCATABLE, DIMENSION(:)      :: ind_cell_glo_glo
-    INTEGER, ALLOCATABLE, SAVE,DIMENSION(:) :: ind_cell
-    !$OMP THREADPRIVATE(ind_cell)
-    INTEGER :: begin, end
-!
-! Fin definition
-!****************************************************************************************
-
-    IF (check) WRITE(lunout,*)'Entree ', modname
-  
-! Initialisation
-  
-    IF (debut) THEN
-! Test of coherence between variable ok_veget and cpp key CPP_VEGET
-#ifndef CPP_VEGET
-       abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
-       CALL abort_physic(modname,abort_message,1)
-#endif
-
-       CALL Init_surf_para(knon)
-       ALLOCATE(ktindex(knon))
-       IF ( .NOT. ALLOCATED(albedo_keep)) THEN
-!ym          ALLOCATE(albedo_keep(klon))
-!ym bizarre que non alloué en knon precedement
-          ALLOCATE(albedo_keep(knon))
-          ALLOCATE(zlev(knon))
-       ENDIF
-! Pb de correspondances de grilles
-       ALLOCATE(ig(klon))
-       ALLOCATE(jg(klon))
-       ig(1) = 1
-       jg(1) = 1
-       indi = 0
-       indj = 2
-       DO igrid = 2, klon - 1
-          indi = indi + 1
-          IF ( indi > nbp_lon) THEN
-             indi = 1
-             indj = indj + 1
-          ENDIF
-          ig(igrid) = indi
-          jg(igrid) = indj
-       ENDDO
-       ig(klon) = 1
-       jg(klon) = nbp_lat
-
-       IF ((.NOT. ALLOCATED(area))) THEN
-          ALLOCATE(area(knon), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation area'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       DO igrid = 1, knon
-          area(igrid) = cell_area(knindex(igrid))
-       ENDDO
-       
-       IF (grid_type==unstructured) THEN
-
-
-         IF ((.NOT. ALLOCATED(lon_scat))) THEN
-            ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
-            IF (error /= 0) THEN
-               abort_message='Pb allocation lon_scat'
-               CALL abort_physic(modname,abort_message,1)
-            ENDIF
-         ENDIF
- 
-         IF ((.NOT. ALLOCATED(lat_scat))) THEN
-            ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
-            IF (error /= 0) THEN
-               abort_message='Pb allocation lat_scat'
-               CALL abort_physic(modname,abort_message,1)
-            ENDIF
-         ENDIF
-         CALL Gather(rlon,rlon_g)
-         CALL Gather(rlat,rlat_g)
-
-         IF (is_mpi_root) THEN
-            index = 1
-            DO jj = 2, nbp_lat-1
-               DO ij = 1, nbp_lon
-                  index = index + 1
-                  lon_scat(ij,jj) = rlon_g(index)
-                  lat_scat(ij,jj) = rlat_g(index)
-               ENDDO
-            ENDDO
-            lon_scat(:,1) = lon_scat(:,2)
-            lat_scat(:,1) = rlat_g(1)
-            lon_scat(:,nbp_lat) = lon_scat(:,2)
-            lat_scat(:,nbp_lat) = rlat_g(klon_glo)
-         ENDIF
-     
-         CALL bcast(lon_scat)
-         CALL bcast(lat_scat)
-                
-       ELSE IF (grid_type==regular_lonlat) THEN
-
-         IF ((.NOT. ALLOCATED(lalo))) THEN
-            ALLOCATE(lalo(knon,2), stat = error)
-            IF (error /= 0) THEN
-               abort_message='Pb allocation lalo'
-               CALL abort_physic(modname,abort_message,1)
-            ENDIF
-         ENDIF
-       
-         IF ((.NOT. ALLOCATED(bounds_lalo))) THEN
-           ALLOCATE(bounds_lalo(knon,nvertex,2), stat = error)
-           IF (error /= 0) THEN
-             abort_message='Pb allocation lalo'
-             CALL abort_physic(modname,abort_message,1)
-           ENDIF
-         ENDIF
-       
-         IF ((.NOT. ALLOCATED(lon_scat))) THEN
-            ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
-            IF (error /= 0) THEN
-               abort_message='Pb allocation lon_scat'
-               CALL abort_physic(modname,abort_message,1)
-            ENDIF
-         ENDIF
-         IF ((.NOT. ALLOCATED(lat_scat))) THEN
-            ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
-            IF (error /= 0) THEN
-               abort_message='Pb allocation lat_scat'
-               CALL abort_physic(modname,abort_message,1)
-            ENDIF
-         ENDIF
-         lon_scat = 0.
-         lat_scat = 0.
-         DO igrid = 1, knon
-            index = knindex(igrid)
-            lalo(igrid,2) = rlon(index)
-            lalo(igrid,1) = rlat(index)
-            bounds_lalo(igrid,:,2)=boundslon(index,:)*180./PI
-            bounds_lalo(igrid,:,1)=boundslat(index,:)*180./PI
-         ENDDO
-
-       
-       
-         CALL Gather(rlon,rlon_g)
-         CALL Gather(rlat,rlat_g)
-
-         IF (is_mpi_root) THEN
-            index = 1
-            DO jj = 2, nbp_lat-1
-               DO ij = 1, nbp_lon
-                  index = index + 1
-                  lon_scat(ij,jj) = rlon_g(index)
-                  lat_scat(ij,jj) = rlat_g(index)
-               ENDDO
-            ENDDO
-            lon_scat(:,1) = lon_scat(:,2)
-            lat_scat(:,1) = rlat_g(1)
-            lon_scat(:,nbp_lat) = lon_scat(:,2)
-            lat_scat(:,nbp_lat) = rlat_g(klon_glo)
-         ENDIF
-   
-         CALL bcast(lon_scat)
-         CALL bcast(lat_scat)
-       
-       ENDIF
-!
-! Allouer et initialiser le tableau des voisins et des fraction de continents
-!
-       IF (( .NOT. ALLOCATED(contfrac))) THEN
-          ALLOCATE(contfrac(knon), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation contfrac'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-
-       DO igrid = 1, knon
-          ireal = knindex(igrid)
-          contfrac(igrid) = pctsrf(ireal,is_ter)
-       ENDDO
-
-
-       IF (grid_type==regular_lonlat) THEN
- 
-         IF ( (.NOT.ALLOCATED(neighbours))) THEN
-          ALLOCATE(neighbours(knon,8), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation neighbours'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-         ENDIF
-         neighbours = -1.
-         CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
-
-       ELSE IF (grid_type==unstructured) THEN
- 
-         IF ( (.NOT.ALLOCATED(neighbours))) THEN
-          ALLOCATE(neighbours(knon,12), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation neighbours'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-         ENDIF
-         neighbours = -1.
- 
-       ENDIF
-         
-
-!
-!  Allocation et calcul resolutions
-       IF ( (.NOT.ALLOCATED(resolution))) THEN
-          ALLOCATE(resolution(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation resolution'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       
-       IF (grid_type==regular_lonlat) THEN
-         DO igrid = 1, knon
-            ij = knindex(igrid)
-            resolution(igrid,1) = dx(ij)
-           resolution(igrid,2) = dy(ij)
-         ENDDO
-       ENDIF
-        
-       ALLOCATE(coastalflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation coastalflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       
-       ALLOCATE(riverflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation riverflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-!
-! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
-!
-! >> PC
-!       IF (carbon_cycle_cpl) THEN
-!          abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
-!          CALL abort_physic(modname,abort_message,1)
-!       END IF
-! << PC
-       
-    ENDIF                          ! (fin debut) 
- 
-! 
-! Appel a la routine sols continentaux
-!
-    IF (lafin) lrestart_write = .TRUE.
-    IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
-     
-    petA_orc(1:knon) = petBcoef(1:knon) * dtime
-    petB_orc(1:knon) = petAcoef(1:knon)
-    peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
-    peqB_orc(1:knon) = peqAcoef(1:knon)
-
-    cdrag = 0.
-    cdrag(1:knon) = tq_cdrag(1:knon)
-
-! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/287.05*temp_air(1:knon))*9.80665)
-!    zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG)
-     zlev(1:knon) = plev(1:knon)*RD*temp_air(1:knon)/((ps(1:knon)*100.0)*RG)
-
-
-! PF et PASB
-!   where(cdrag > 0.01) 
-!     cdrag = 0.01
-!   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
-
-  
-    IF (debut) THEN
-       CALL Init_orchidee_index(knon,knindex,offset,ktindex)
-       CALL Get_orchidee_communicator(orch_comm,orch_mpi_size,orch_mpi_rank, orch_omp_size,orch_omp_rank)
-
-       IF (grid_type==unstructured) THEN
-         IF (knon==0) THEN
-           begin=1
-           end=0
-         ELSE
-           begin=offset+1
-           end=offset+ktindex(knon)
-         ENDIF
-        
-         IF (orch_mpi_rank==orch_mpi_size-1 .AND. orch_omp_rank==orch_omp_size-1) end=nbp_lon*nbp_lat 
-          
-         ALLOCATE(lalo(end-begin+1,2))
-         ALLOCATE(bounds_lalo(end-begin+1,nvertex,2))
-         ALLOCATE(ind_cell(end-begin+1))
-         
-         ALLOCATE(longitude_glo(klon_glo))
-         CALL gather(longitude,longitude_glo)
-         CALL bcast(longitude_glo)
-         lalo(:,2)=longitude_glo(begin:end)*180./PI
- 
-         ALLOCATE(latitude_glo(klon_glo))
-         CALL gather(latitude,latitude_glo)
-         CALL bcast(latitude_glo)
-         lalo(:,1)=latitude_glo(begin:end)*180./PI
-
-         ALLOCATE(boundslon_glo(klon_glo,nvertex))
-         CALL gather(boundslon,boundslon_glo)
-         CALL bcast(boundslon_glo)
-         bounds_lalo(:,:,2)=boundslon_glo(begin:end,:)*180./PI
- 
-         ALLOCATE(boundslat_glo(klon_glo,nvertex))
-         CALL gather(boundslat,boundslat_glo)
-         CALL bcast(boundslat_glo)
-         bounds_lalo(:,:,1)=boundslat_glo(begin:end,:)*180./PI
-         
-         ALLOCATE(ind_cell_glo_glo(klon_glo))
-         CALL gather(ind_cell_glo,ind_cell_glo_glo)
-         CALL bcast(ind_cell_glo_glo)
-         ind_cell(:)=ind_cell_glo_glo(begin:end)
-         
-       ENDIF
-       CALL Init_synchro_omp
-
-!$OMP BARRIER
-       
-       IF (knon > 0) THEN
-#ifdef CPP_VEGET
-         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm,grid=grid_type)
-#endif
-       ENDIF
-
-       CALL Synchro_omp
-
-       
-       IF (knon > 0) THEN 
-
-#ifdef CPP_VEGET
-
-         CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-               lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, &
-               cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-               precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
-               evap, fluxsens, fluxlat, coastalflow, riverflow, &
-               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, &    
-               lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon), nvm_orch, &
-               grid=grid_type, bounds_latlon=bounds_lalo, cell_area=area, ind_cell_glo=ind_cell, &
-               field_out_names=cfname_out, field_in_names=cfname_in(1:nbcf_in_orc))
-#endif         
-       ENDIF
-
-       CALL Synchro_omp
-
-       albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-    ENDIF
-    
-!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
-    swdown_vrai(1:knon) = swdown(1:knon)
-!$OMP BARRIER
-
-    IF (knon > 0) THEN
-#ifdef CPP_VEGET    
-       IF (nvm_orch .NE. nvm_lmdz ) THEN
-          abort_message='Pb de dimensiosn PFT: nvm_orch et nvm_lmdz differents.'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-
-       CALL intersurf_main_gathered (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime,  &
-            lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-            cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-            precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
-            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0m_new(1:knon), &
-            lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon),&
-            veget(1:knon,:),lai(1:knon,:),height(1:knon,:),&
-            fields_out=yfields_out(1:knon,1:nbcf_out),  &
-            fields_in=yfields_in(1:knon,1:nbcf_in_orc), &
-            coszang=yrmu0(1:knon))
-#endif       
-    ENDIF
-
-    CALL Synchro_omp
-    
-    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-!* Send to coupler
-!
-    IF (type_ocean=='couple') THEN
-       CALL cpl_send_land_fields(itime, knon, knindex, &
-            riverflow, coastalflow)
-    ENDIF
-
-    alb1_new(1:knon) = albedo_out(1:knon,1) 
-    alb2_new(1:knon) = albedo_out(1:knon,2)
-
-! Convention orchidee: positif vers le haut
-    fluxsens(1:knon) = -1. * fluxsens(1:knon)
-    fluxlat(1:knon)  = -1. * fluxlat(1:knon)
-    
-!  evap     = -1. * evap
-
-    IF (debut) lrestart_read = .FALSE.
-    
-    IF (debut) CALL Finalize_surf_para
-
-! >> PC
-! Decompressing variables into LMDz for the module carbon_cycle_mod
-! nbcf_in can be zero, in which case the loop does not operate
-! fields_in can then used elsewhere in the model
-     
-     fields_in(:,:)=0.0
-
-     DO nb=1, nbcf_in_orc
-       DO igrid = 1, knon
-        ireal = knindex(igrid)
-        fields_in(ireal,nb)=yfields_in(igrid,nb)
-       ENDDO
-       WRITE(*,*) 'surf_land_orchidee_mod --- yfields_in :',cfname_in(nb)
-     ENDDO
-! >> PC
-    
-  END SUBROUTINE surf_land_orchidee
-!
-!****************************************************************************************
-!
-  SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
-  USE mod_surf_para
-  USE mod_grid_phy_lmdz
-  
-    INTEGER,INTENT(IN)    :: knon
-    INTEGER,INTENT(IN)    :: knindex(klon)    
-    INTEGER,INTENT(OUT)   :: offset
-    INTEGER,INTENT(OUT)   :: ktindex(klon)
-    
-    INTEGER               :: ktindex_glo(knon_glo)
-    INTEGER               :: offset_para(0:omp_size*mpi_size-1)
-    INTEGER               :: LastPoint
-    INTEGER               :: task
-    
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo) 
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      LastPoint=0
-      DO Task=0,mpi_size*omp_size-1
-        IF (knon_glo_para(Task)>0) THEN
-           offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
-           LastPoint=ktindex_glo(knon_glo_end_para(task))
-        ENDIF
-      ENDDO
-    ENDIF
-    
-    CALL bcast(offset_para)
-    
-    offset=offset_para(omp_size*mpi_rank+omp_rank)
-    
-    ktindex(1:knon)=ktindex(1:knon)-offset
-
-  END SUBROUTINE Init_orchidee_index
-
-!
-!************************* ***************************************************************
-! 
-
-  SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank)
-  USE  mod_surf_para
-      
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-    INTEGER,INTENT(OUT) :: orch_comm
-    INTEGER,INTENT(OUT) :: orch_mpi_size
-    INTEGER,INTENT(OUT) :: orch_mpi_rank
-    INTEGER,INTENT(OUT) :: orch_omp_size
-    INTEGER,INTENT(OUT) :: orch_omp_rank
-    INTEGER             :: color
-    INTEGER             :: i,ierr
-!
-! End definition
-!****************************************************************************************
-    
-    IF (is_omp_root) THEN          
-      
-      IF (knon_mpi==0) THEN 
-         color = 0
-      ELSE 
-         color = 1
-      ENDIF
-    
-#ifdef CPP_MPI    
-      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-      CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr)
-      CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr)
-#endif
-    
-    ENDIF
-    CALL bcast_omp(orch_comm)
-    
-    IF (knon_mpi /= 0) THEN
-      orch_omp_size=0
-      DO i=0,omp_size-1
-        IF (knon_omp_para(i) /=0) THEN
-          orch_omp_size=orch_omp_size+1
-          IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
-        ENDIF
-      ENDDO
-    ENDIF
-    
-  END SUBROUTINE Get_orchidee_communicator
-!
-!****************************************************************************************
-!  
-
-  SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
-    USE mod_grid_phy_lmdz
-    USE mod_surf_para    
-    USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    REAL, DIMENSION(klon), INTENT(IN)       :: pctsrf
-    
-! Output arguments
-!****************************************************************************************
-    INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
-
-! Local variables
-!****************************************************************************************
-    INTEGER                              :: i, igrid, jj, ij, iglob
-    INTEGER                              :: ierr, ireal, index
-    INTEGER, DIMENSION(8,3)              :: off_ini
-    INTEGER, DIMENSION(8)                :: offset  
-    INTEGER, DIMENSION(nbp_lon,nbp_lat)  :: correspond
-    INTEGER, DIMENSION(knon_glo)         :: ktindex_glo
-    INTEGER, DIMENSION(knon_glo,8)       :: neighbours_glo
-    REAL, DIMENSION(klon_glo)            :: pctsrf_glo
-    INTEGER                              :: ktindex(klon)
-!
-! End definition
-!****************************************************************************************
-
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo)
-    CALL gather(pctsrf,pctsrf_glo)
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      neighbours_glo(:,:)=-1
-!  Initialisation des offset    
-!
-! offset bord ouest
-       off_ini(1,1) = - nbp_lon   ; off_ini(2,1) = - nbp_lon + 1     ; off_ini(3,1) = 1
-       off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon           ; off_ini(6,1) = 2 * nbp_lon - 1
-       off_ini(7,1) = nbp_lon -1  ; off_ini(8,1) = - 1 
-! offset point normal
-       off_ini(1,2) = - nbp_lon   ; off_ini(2,2) = - nbp_lon + 1     ; off_ini(3,2) = 1
-       off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon           ; off_ini(6,2) = nbp_lon - 1
-       off_ini(7,2) = -1          ; off_ini(8,2) = - nbp_lon - 1
-! offset bord   est
-       off_ini(1,3) = - nbp_lon   ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
-       off_ini(4,3) =  1          ; off_ini(5,3) = nbp_lon           ; off_ini(6,3) = nbp_lon - 1
-       off_ini(7,3) = -1          ; off_ini(8,3) = - nbp_lon - 1
-!
-! Attention aux poles
-!
-       DO igrid = 1, knon_glo
-          index = ktindex_glo(igrid)
-          jj = INT((index - 1)/nbp_lon) + 1
-          ij = index - (jj - 1) * nbp_lon
-          correspond(ij,jj) = igrid
-       ENDDO
-!sonia : Les mailles des voisines doivent etre toutes egales (pour couplage orchidee)
-       IF (knon_glo == 1) THEN
-         igrid = 1
-         DO i = 1,8
-           neighbours_glo(igrid, i) = igrid
-         ENDDO
-       ELSE
-       
-       DO igrid = 1, knon_glo
-          iglob = ktindex_glo(igrid)
-          
-          IF (MOD(iglob, nbp_lon) == 1) THEN
-             offset = off_ini(:,1)
-          ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
-             offset = off_ini(:,3)
-          ELSE
-             offset = off_ini(:,2)
-          ENDIF
-          
-          DO i = 1, 8
-             index = iglob + offset(i)
-             ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
-             IF (pctsrf_glo(ireal) > EPSFRA) THEN
-                jj = INT((index - 1)/nbp_lon) + 1
-                ij = index - (jj - 1) * nbp_lon
-                neighbours_glo(igrid, i) = correspond(ij, jj)
-             ENDIF
-          ENDDO
-       ENDDO
-       ENDIF !fin knon_glo == 1
-
-    ENDIF
-    
-    DO i = 1, 8
-      CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
-    ENDDO
-  END SUBROUTINE Init_neighbours
-
-!
-!****************************************************************************************
-!
-#endif
-#endif
-#endif
-#endif
-END MODULE surf_land_orchidee_mod
+link ../phylmd/surf_land_orchidee_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_nofrein_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_nofrein_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_nofrein_mod.F90	(revision 3940)
@@ -1,683 +1,1 @@
-!
-! $Id: surf_land_orchidee_nofrein_mod.F90 3102 2017-12-03 20:27:42Z oboucher $
-!
-!
-MODULE surf_land_orchidee_nofrein_mod
-#ifdef ORCHIDEE_NOFREIN
-!
-! This module controles the interface towards the model ORCHIDEE.
-!
-! Compatibility with ORCHIDIEE :
-! This module is compiled only if cpp key ORCHIDEE_NOFREIN is defined. 
-! The current version can be used with ORCHIDEE/trunk from revision 3525-4465 
-! (it can be used for later revisions also but it is not needed.)
-! 
-!
-! Subroutines in this module : surf_land_orchidee
-!                              Init_orchidee_index
-!                              Get_orchidee_communicator
-!                              Init_neighbours
-
-  USE dimphy
-#ifdef CPP_VEGET
-  USE intersurf     ! module d'ORCHIDEE
-#endif
-  USE cpl_mod,      ONLY : cpl_send_land_fields
-  USE surface_data, ONLY : type_ocean
-  USE geometry_mod, ONLY : dx, dy
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
-
-  IMPLICIT NONE
-
-  PRIVATE
-  PUBLIC  :: surf_land_orchidee
-
-CONTAINS
-!
-!****************************************************************************************
-!  
-  SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
-       knindex, rlon, rlat, yrmu0, pctsrf, &
-       debut, lafin, &
-       plev,  u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, & 
-       tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-       precip_rain, precip_snow, lwdown, swnet, swdown, &
-       ps, q2m, t2m, &
-       evap, fluxsens, fluxlat, &              
-       tsol_rad, tsurf_new, alb1_new, alb2_new, &
-       emis_new, z0m_new, z0h_new, qsurf, &
-       veget, lai, height )
-
-
-    USE mod_surf_para
-    USE mod_synchro_omp
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: lunout
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-#ifdef CPP_VEGET
-    USE time_phylmdz_mod, ONLY: itau_phy 
-#endif
-!    
-! Cette routine sert d'interface entre le modele atmospherique et le 
-! modele de sol continental. Appel a sechiba
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps
-!   dtime        pas de temps de la physique (en s)
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-!   knindex      index des points de la surface a traiter
-!   rlon         longitudes de la grille entiere
-!   rlat         latitudes de la grille entiere
-!   pctsrf       tableau des fractions de surface de chaque maille
-!   debut        logical: 1er appel a la physique (lire les restart)
-!   lafin        logical: dernier appel a la physique (ecrire les restart)
-!                     (si false calcul simplifie des fluxs sur les continents)
-!   plev         hauteur de la premiere couche (Pa)      
-!   u1_lay       vitesse u 1ere couche
-!   v1_lay       vitesse v 1ere couche
-!   temp_air     temperature de l'air 1ere couche
-!   spechum      humidite specifique 1ere couche
-!   epot_air     temp pot de l'air
-!   ccanopy      concentration CO2 canopee, correspond au co2_send de 
-!                carbon_cycle_mod ou valeur constant co2_ppm
-!   tq_cdrag     cdrag
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   precip_rain  precipitation liquide
-!   precip_snow  precipitation solide
-!   lwdown       flux IR descendant a la surface
-!   swnet        flux solaire net
-!   swdown       flux solaire entrant a la surface
-!   ps           pression au sol
-!   radsol       rayonnement net aus sol (LW + SW)
-!   
-!
-! output:
-!   evap         evaporation totale
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   tsol_rad     
-!   tsurf_new    temperature au sol
-!   alb1_new     albedo in visible SW interval
-!   alb2_new     albedo in near IR interval
-!   emis_new     emissivite
-!   z0m_new      surface roughness for momentum
-!   z0h_new      surface roughness for heat
-!   qsurf        air moisture at surface
-!
-    INCLUDE "YOMCST.h"
-    INCLUDE "dimpft.h"
-    INCLUDE "compbl.h"
-
-  
-!
-! Parametres d'entree
-!****************************************************************************************
-    INTEGER, INTENT(IN)                       :: itime
-    REAL, INTENT(IN)                          :: dtime
-    REAL, INTENT(IN)                          :: date0
-    INTEGER, INTENT(IN)                       :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-    LOGICAL, INTENT(IN)                       :: debut, lafin
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)   :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)         :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)         :: yrmu0 ! cosine of solar zenith angle
-    REAL, DIMENSION(klon), INTENT(IN)         :: plev
-    REAL, DIMENSION(klon), INTENT(IN)         :: u1_lay, v1_lay, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)         :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)         :: epot_air, ccanopy
-    REAL, DIMENSION(klon), INTENT(IN)         :: tq_cdrag
-    REAL, DIMENSION(klon), INTENT(IN)         :: petAcoef, peqAcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)         :: lwdown, swnet, swdown, ps
-    REAL, DIMENSION(klon), INTENT(IN)         :: q2m, t2m
-
-! Parametres de sortie
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)        :: evap, fluxsens, fluxlat, qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)        :: tsol_rad, tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: alb1_new, alb2_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: emis_new, z0m_new, z0h_new
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget ! dummy variables
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: lai   ! dummy variables
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height! dummy variables
-
-
-! Local
-!****************************************************************************************
-    INTEGER                                   :: ij, jj, igrid, ireal, index
-    INTEGER                                   :: error
-    REAL, DIMENSION(klon)                     :: swdown_vrai
-    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
-    CHARACTER (len = 80)                      :: abort_message
-    LOGICAL,SAVE                              :: check = .FALSE.
-    !$OMP THREADPRIVATE(check)
-
-! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
-! drapeaux controlant les appels dans SECHIBA
-!  type(control_type), save   :: control_in
-! Preserved albedo
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: albedo_keep, zlev
-    !$OMP THREADPRIVATE(albedo_keep,zlev)
-! coordonnees geographiques
-    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: lalo
-    !$OMP THREADPRIVATE(lalo)
-! pts voisins
-    INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
-    !$OMP THREADPRIVATE(neighbours)
-! fractions continents
-    REAL,ALLOCATABLE, DIMENSION(:), SAVE      :: contfrac
-    !$OMP THREADPRIVATE(contfrac)
-! resolution de la grille
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: resolution
-    !$OMP THREADPRIVATE(resolution)
-
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: lon_scat, lat_scat  
-    !$OMP THREADPRIVATE(lon_scat,lat_scat)
-
-    LOGICAL, SAVE                             :: lrestart_read = .TRUE.
-    !$OMP THREADPRIVATE(lrestart_read)
-    LOGICAL, SAVE                             :: lrestart_write = .FALSE.
-    !$OMP THREADPRIVATE(lrestart_write)
-
-    REAL, DIMENSION(knon,2)                   :: albedo_out
-
-! Pb de nomenclature
-    REAL, DIMENSION(klon)                     :: petA_orc, peqA_orc
-    REAL, DIMENSION(klon)                     :: petB_orc, peqB_orc
-! Pb de correspondances de grilles
-    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE  :: ig, jg
-    !$OMP THREADPRIVATE(ig,jg)
-    INTEGER :: indi, indj
-    INTEGER, SAVE, ALLOCATABLE,DIMENSION(:)   :: ktindex
-    !$OMP THREADPRIVATE(ktindex)
-
-! Essai cdrag
-    REAL, DIMENSION(klon)                     :: cdrag
-    INTEGER,SAVE                              :: offset
-    !$OMP THREADPRIVATE(offset)
-
-    REAL, DIMENSION(klon_glo)                 :: rlon_g,rlat_g
-    INTEGER, SAVE                             :: orch_comm
-    !$OMP THREADPRIVATE(orch_comm)
-
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: coastalflow
-    !$OMP THREADPRIVATE(coastalflow)
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: riverflow
-    !$OMP THREADPRIVATE(riverflow)
-    
-    INTEGER :: orch_omp_rank
-    INTEGER :: orch_omp_size
-!
-! Fin definition
-!****************************************************************************************
-
-    IF (check) WRITE(lunout,*)'Entree ', modname
-  
-    IF (ifl_pbltree == 1) THEN
-       abort_message='Pb de coherence: cette interface vers ORCHIDEE ne peut pas etre utilise avec ifl_pbltree'
-       CALL abort_physic(modname,abort_message,1)
-    END IF
-
-! Initialisation
-  
-    IF (debut) THEN
-! Test of coherence between variable ok_veget and cpp key CPP_VEGET
-#ifndef CPP_VEGET
-       abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
-       CALL abort_physic(modname,abort_message,1)
-#endif
-
-       CALL Init_surf_para(knon)
-       ALLOCATE(ktindex(knon))
-       IF ( .NOT. ALLOCATED(albedo_keep)) THEN
-!ym          ALLOCATE(albedo_keep(klon))
-!ym bizarre que non alloué en knon precedement
-          ALLOCATE(albedo_keep(knon))
-          ALLOCATE(zlev(knon))
-       ENDIF
-! Pb de correspondances de grilles
-       ALLOCATE(ig(klon))
-       ALLOCATE(jg(klon))
-       ig(1) = 1
-       jg(1) = 1
-       indi = 0
-       indj = 2
-       DO igrid = 2, klon - 1
-          indi = indi + 1
-          IF ( indi > nbp_lon) THEN
-             indi = 1
-             indj = indj + 1
-          ENDIF
-          ig(igrid) = indi
-          jg(igrid) = indj
-       ENDDO
-       ig(klon) = 1
-       jg(klon) = nbp_lat
-
-       IF ((.NOT. ALLOCATED(lalo))) THEN
-          ALLOCATE(lalo(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lalo'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lon_scat))) THEN
-          ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lon_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lat_scat))) THEN
-          ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lat_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       lon_scat = 0.
-       lat_scat = 0.
-       DO igrid = 1, knon
-          index = knindex(igrid)
-          lalo(igrid,2) = rlon(index)
-          lalo(igrid,1) = rlat(index)
-       ENDDO
-
-       
-       
-       CALL Gather(rlon,rlon_g)
-       CALL Gather(rlat,rlat_g)
-
-       IF (is_mpi_root) THEN
-          index = 1
-          DO jj = 2, nbp_lat-1
-             DO ij = 1, nbp_lon
-                index = index + 1
-                lon_scat(ij,jj) = rlon_g(index)
-                lat_scat(ij,jj) = rlat_g(index)
-             ENDDO
-          ENDDO
-          lon_scat(:,1) = lon_scat(:,2)
-          lat_scat(:,1) = rlat_g(1)
-          lon_scat(:,nbp_lat) = lon_scat(:,2)
-          lat_scat(:,nbp_lat) = rlat_g(klon_glo)
-       ENDIF
-   
-       CALL bcast(lon_scat)
-       CALL bcast(lat_scat)
-!
-! Allouer et initialiser le tableau des voisins et des fraction de continents
-!
-       IF ( (.NOT.ALLOCATED(neighbours))) THEN
-          ALLOCATE(neighbours(knon,8), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation neighbours'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       neighbours = -1.
-       IF (( .NOT. ALLOCATED(contfrac))) THEN
-          ALLOCATE(contfrac(knon), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation contfrac'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-
-       DO igrid = 1, knon
-          ireal = knindex(igrid)
-          contfrac(igrid) = pctsrf(ireal,is_ter)
-       ENDDO
-
-
-       CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
-
-!
-!  Allocation et calcul resolutions
-       IF ( (.NOT.ALLOCATED(resolution))) THEN
-          ALLOCATE(resolution(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation resolution'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       DO igrid = 1, knon
-          ij = knindex(igrid)
-          resolution(igrid,1) = dx(ij)
-          resolution(igrid,2) = dy(ij)
-       ENDDO
-     
-       ALLOCATE(coastalflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation coastalflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       
-       ALLOCATE(riverflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation riverflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-!
-! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
-!
-       IF (carbon_cycle_cpl) THEN
-          abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
-          CALL abort_physic(modname,abort_message,1)
-       END IF
-       
-    ENDIF                          ! (fin debut) 
- 
-
-! 
-! Appel a la routine sols continentaux
-!
-    IF (lafin) lrestart_write = .TRUE.
-    IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
-     
-    petA_orc(1:knon) = petBcoef(1:knon) * dtime
-    petB_orc(1:knon) = petAcoef(1:knon)
-    peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
-    peqB_orc(1:knon) = peqAcoef(1:knon)
-
-    cdrag = 0.
-    cdrag(1:knon) = tq_cdrag(1:knon)
-
-! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/287.05*temp_air(1:knon))*9.80665)
-!    zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG)
-     zlev(1:knon) = plev(1:knon)*RD*temp_air(1:knon)/((ps(1:knon)*100.0)*RG)
-
-
-! PF et PASB
-!   where(cdrag > 0.01) 
-!     cdrag = 0.01
-!   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
-
-  
-    IF (debut) THEN
-       CALL Init_orchidee_index(knon,knindex,offset,ktindex)
-       CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
-       CALL Init_synchro_omp
-       
-       IF (knon > 0) THEN
-#ifdef CPP_VEGET
-         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
-#endif
-       ENDIF
-
-       
-       IF (knon > 0) THEN
-
-#ifdef CPP_VEGET
-         CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-               lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, &
-               cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-               precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
-               evap, fluxsens, fluxlat, coastalflow, riverflow, &
-               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, &
-               lon_scat, lat_scat, q2m, t2m, z0h_new)
-#endif         
-       ENDIF
-
-       CALL Synchro_omp
-
-       albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-    ENDIF
-
-    
-!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
-    swdown_vrai(1:knon) = swdown(1:knon)
-
-    IF (knon > 0) THEN
-#ifdef CPP_VEGET    
-       CALL intersurf_main_gathered (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime,  &
-            lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-            cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-            precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
-            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0m_new(1:knon), &
-            lon_scat, lat_scat, q2m, t2m, z0h_new(1:knon), coszang=yrmu0(1:knon))
-#endif       
-    ENDIF
-
-    CALL Synchro_omp
-    
-    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-!* Send to coupler
-!
-    IF (type_ocean=='couple') THEN
-       CALL cpl_send_land_fields(itime, knon, knindex, &
-            riverflow, coastalflow)
-    ENDIF
-
-    alb1_new(1:knon) = albedo_out(1:knon,1) 
-    alb2_new(1:knon) = albedo_out(1:knon,2)
-
-! Convention orchidee: positif vers le haut
-    fluxsens(1:knon) = -1. * fluxsens(1:knon)
-    fluxlat(1:knon)  = -1. * fluxlat(1:knon)
-    
-!  evap     = -1. * evap
-
-    IF (debut) lrestart_read = .FALSE.
-    
-    IF (debut) CALL Finalize_surf_para
-
-    
-  END SUBROUTINE surf_land_orchidee
-!
-!****************************************************************************************
-!
-  SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
-  USE mod_surf_para
-  USE mod_grid_phy_lmdz
-  
-    INTEGER,INTENT(IN)    :: knon
-    INTEGER,INTENT(IN)    :: knindex(klon)    
-    INTEGER,INTENT(OUT)   :: offset
-    INTEGER,INTENT(OUT)   :: ktindex(klon)
-    
-    INTEGER               :: ktindex_glo(knon_glo)
-    INTEGER               :: offset_para(0:omp_size*mpi_size-1)
-    INTEGER               :: LastPoint
-    INTEGER               :: task
-    
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo) 
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      LastPoint=0
-      DO Task=0,mpi_size*omp_size-1
-        IF (knon_glo_para(Task)>0) THEN
-           offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
-           LastPoint=ktindex_glo(knon_glo_end_para(task))
-        ENDIF
-      ENDDO
-    ENDIF
-    
-    CALL bcast(offset_para)
-    
-    offset=offset_para(omp_size*mpi_rank+omp_rank)
-    
-    ktindex(1:knon)=ktindex(1:knon)-offset
-
-  END SUBROUTINE Init_orchidee_index
-
-!
-!************************* ***************************************************************
-! 
-
-  SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
-  USE  mod_surf_para
-      
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-    INTEGER,INTENT(OUT) :: orch_comm
-    INTEGER,INTENT(OUT) :: orch_omp_size
-    INTEGER,INTENT(OUT) :: orch_omp_rank
-    INTEGER             :: color
-    INTEGER             :: i,ierr
-!
-! End definition
-!****************************************************************************************
-    
-    
-    IF (is_omp_root) THEN          
-      
-      IF (knon_mpi==0) THEN 
-         color = 0
-      ELSE 
-         color = 1
-      ENDIF
-    
-#ifdef CPP_MPI    
-      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
-    
-    ENDIF
-    CALL bcast_omp(orch_comm)
-    
-    IF (knon_mpi /= 0) THEN
-      orch_omp_size=0
-      DO i=0,omp_size-1
-        IF (knon_omp_para(i) /=0) THEN
-          orch_omp_size=orch_omp_size+1
-          IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
-        ENDIF
-      ENDDO
-    ENDIF
-   
-    
-  END SUBROUTINE Get_orchidee_communicator
-!
-!****************************************************************************************
-!  
-
-  SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
-    USE mod_grid_phy_lmdz
-    USE mod_surf_para    
-    USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    REAL, DIMENSION(klon), INTENT(IN)       :: pctsrf
-    
-! Output arguments
-!****************************************************************************************
-    INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
-
-! Local variables
-!****************************************************************************************
-    INTEGER                              :: i, igrid, jj, ij, iglob
-    INTEGER                              :: ierr, ireal, index
-    INTEGER, DIMENSION(8,3)              :: off_ini
-    INTEGER, DIMENSION(8)                :: offset  
-    INTEGER, DIMENSION(nbp_lon,nbp_lat)  :: correspond
-    INTEGER, DIMENSION(knon_glo)         :: ktindex_glo
-    INTEGER, DIMENSION(knon_glo,8)       :: neighbours_glo
-    REAL, DIMENSION(klon_glo)            :: pctsrf_glo
-    INTEGER                              :: ktindex(klon)
-!
-! End definition
-!****************************************************************************************
-
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo)
-    CALL gather(pctsrf,pctsrf_glo)
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      neighbours_glo(:,:)=-1
-!  Initialisation des offset    
-!
-! offset bord ouest
-       off_ini(1,1) = - nbp_lon   ; off_ini(2,1) = - nbp_lon + 1     ; off_ini(3,1) = 1
-       off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon           ; off_ini(6,1) = 2 * nbp_lon - 1
-       off_ini(7,1) = nbp_lon -1  ; off_ini(8,1) = - 1 
-! offset point normal
-       off_ini(1,2) = - nbp_lon   ; off_ini(2,2) = - nbp_lon + 1     ; off_ini(3,2) = 1
-       off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon           ; off_ini(6,2) = nbp_lon - 1
-       off_ini(7,2) = -1          ; off_ini(8,2) = - nbp_lon - 1
-! offset bord   est
-       off_ini(1,3) = - nbp_lon   ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
-       off_ini(4,3) =  1          ; off_ini(5,3) = nbp_lon           ; off_ini(6,3) = nbp_lon - 1
-       off_ini(7,3) = -1          ; off_ini(8,3) = - nbp_lon - 1
-!
-!
-! Attention aux poles
-!
-       DO igrid = 1, knon_glo
-          index = ktindex_glo(igrid)
-          jj = INT((index - 1)/nbp_lon) + 1
-          ij = index - (jj - 1) * nbp_lon
-          correspond(ij,jj) = igrid
-       ENDDO
-!sonia : Les mailles des voisines doivent etre toutes egales (pour couplage orchidee)
-       IF (knon_glo == 1) THEN
-         igrid = 1
-         DO i = 1,8
-           neighbours_glo(igrid, i) = igrid
-         ENDDO
-       ELSE
-       print*,'sonia : knon_glo,ij,jj', knon_glo, ij,jj
-       
-       DO igrid = 1, knon_glo
-          iglob = ktindex_glo(igrid)
-          
-          IF (MOD(iglob, nbp_lon) == 1) THEN
-             offset = off_ini(:,1)
-          ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
-             offset = off_ini(:,3)
-          ELSE
-             offset = off_ini(:,2)
-          ENDIF
-          
-          DO i = 1, 8
-             index = iglob + offset(i)
-             ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
-             IF (pctsrf_glo(ireal) > EPSFRA) THEN
-                jj = INT((index - 1)/nbp_lon) + 1
-                ij = index - (jj - 1) * nbp_lon
-                neighbours_glo(igrid, i) = correspond(ij, jj)
-             ENDIF
-          ENDDO
-       ENDDO
-       ENDIF !fin knon_glo == 1
-
-    ENDIF
-    
-    DO i = 1, 8
-      CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
-    ENDDO
-  END SUBROUTINE Init_neighbours
-
-!
-!****************************************************************************************
-!
-#endif
-END MODULE surf_land_orchidee_nofrein_mod
+link ../phylmd/surf_land_orchidee_nofrein_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_noopenmp_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_noopenmp_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_noopenmp_mod.F90	(revision 3940)
@@ -1,796 +1,1 @@
-!
-! $Header$
-!
-MODULE surf_land_orchidee_noopenmp_mod
-!
-! This module is compiled only if CPP key ORCHIDEE_NOOPENMP is defined.
-! This module should be used with ORCHIDEE sequentiel or parallele MPI version 
-! (not MPI-OpenMP mixte) until revision 1077 in the ORCHIDEE trunk.
-
-#ifdef ORCHIDEE_NOOPENMP
-!
-! This module controles the interface towards the model ORCHIDEE
-!
-! Subroutines in this module : surf_land_orchidee
-!                              Init_orchidee_index
-!                              Get_orchidee_communicator
-!                              Init_neighbours
-  USE dimphy
-#ifdef CPP_VEGET
-  USE intersurf     ! module d'ORCHIDEE
-#endif
-  USE cpl_mod,      ONLY : cpl_send_land_fields
-  USE surface_data, ONLY : type_ocean
-  USE geometry_mod, ONLY : dx, dy
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para
-
-  IMPLICIT NONE
-
-  PRIVATE
-  PUBLIC  :: surf_land_orchidee
-
-CONTAINS
-!
-!****************************************************************************************
-!  
-  SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
-       knindex, rlon, rlat, yrmu0, pctsrf, &
-       debut, lafin, &
-       plev,  u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, & 
-       tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-       precip_rain, precip_snow, lwdown, swnet, swdown, &
-       ps, q2m, t2m, &
-       evap, fluxsens, fluxlat, &              
-       tsol_rad, tsurf_new, alb1_new, alb2_new, &
-       emis_new, z0_new, z0h_new, qsurf, &
-       veget, lai, height)
-!    
-! Cette routine sert d'interface entre le modele atmospherique et le 
-! modele de sol continental. Appel a sechiba
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps
-!   dtime        pas de temps de la physique (en s)
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-!   knindex      index des points de la surface a traiter
-!   rlon         longitudes de la grille entiere
-!   rlat         latitudes de la grille entiere
-!   pctsrf       tableau des fractions de surface de chaque maille
-!   debut        logical: 1er appel a la physique (lire les restart)
-!   lafin        logical: dernier appel a la physique (ecrire les restart)
-!                     (si false calcul simplifie des fluxs sur les continents)
-!   plev         hauteur de la premiere couche (Pa)      
-!   u1_lay       vitesse u 1ere couche
-!   v1_lay       vitesse v 1ere couche
-!   temp_air     temperature de l'air 1ere couche
-!   spechum      humidite specifique 1ere couche
-!   epot_air     temp pot de l'air
-!   ccanopy      concentration CO2 canopee, correspond au co2_send de 
-!                carbon_cycle_mod ou valeur constant co2_ppm
-!   tq_cdrag     cdrag
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   precip_rain  precipitation liquide
-!   precip_snow  precipitation solide
-!   lwdown       flux IR descendant a la surface
-!   swnet        flux solaire net
-!   swdown       flux solaire entrant a la surface
-!   ps           pression au sol
-!   radsol       rayonnement net aus sol (LW + SW)
-!   
-!
-! output:
-!   evap         evaporation totale
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   tsol_rad     
-!   tsurf_new    temperature au sol
-!   alb1_new     albedo in visible SW interval
-!   alb2_new     albedo in near IR interval
-!   emis_new     emissivite
-!   z0_new       surface roughness
-!   z0h_new      surface roughness, it is the same as z0_new
-!   qsurf        air moisture at surface
-!
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_land_inst, fco2_lu_inst
-    USE indice_sol_mod
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-    USE print_control_mod, ONLY: lunout
-#ifdef CPP_VEGET
-    USE time_phylmdz_mod, ONLY: itau_phy 
-#endif
-    IMPLICIT NONE
-
-    INCLUDE "YOMCST.h"
-    INCLUDE "dimpft.h"  
-!
-! Parametres d'entree
-!****************************************************************************************
-    INTEGER, INTENT(IN)                       :: itime
-    REAL, INTENT(IN)                          :: dtime
-    REAL, INTENT(IN)                          :: date0
-    INTEGER, INTENT(IN)                       :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-    LOGICAL, INTENT(IN)                       :: debut, lafin
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)   :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)         :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)         :: yrmu0
-    REAL, DIMENSION(klon), INTENT(IN)         :: plev
-    REAL, DIMENSION(klon), INTENT(IN)         :: u1_lay, v1_lay, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)         :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)         :: epot_air, ccanopy
-    REAL, DIMENSION(klon), INTENT(IN)         :: tq_cdrag
-    REAL, DIMENSION(klon), INTENT(IN)         :: petAcoef, peqAcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)         :: lwdown, swnet, swdown, ps
-    REAL, DIMENSION(klon), INTENT(IN)         :: q2m, t2m
-
-! Parametres de sortie
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)        :: evap, fluxsens, fluxlat, qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)        :: tsol_rad, tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: alb1_new, alb2_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: emis_new, z0_new, z0h_new
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget ! dummy variables
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: lai   ! dummy variables
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height! dummy variables
-
-! Local
-!****************************************************************************************
-    INTEGER                                   :: ij, jj, igrid, ireal, index
-    INTEGER                                   :: error
-    INTEGER, SAVE                             :: nb_fields_cpl ! number of fields for the climate-carbon coupling (between ATM and ORCHIDEE). 
-    !$OMP THREADPRIVATE(nb_fields_cpl)
-    REAL, SAVE, ALLOCATABLE, DIMENSION(:,:)   :: fields_cpl    ! Fluxes for the climate-carbon coupling
-    !$OMP THREADPRIVATE(fields_cpl)
-    REAL, DIMENSION(klon)                     :: swdown_vrai
-    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
-    CHARACTER (len = 80)                      :: abort_message
-    LOGICAL,SAVE                              :: check = .FALSE.
-    !$OMP THREADPRIVATE(check)
-
-! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
-! drapeaux controlant les appels dans SECHIBA
-!  type(control_type), save   :: control_in
-! Preserved albedo
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: albedo_keep, zlev
-    !$OMP THREADPRIVATE(albedo_keep,zlev)
-! coordonnees geographiques
-    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: lalo
-    !$OMP THREADPRIVATE(lalo)
-! pts voisins
-    INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
-    !$OMP THREADPRIVATE(neighbours)
-! fractions continents
-    REAL,ALLOCATABLE, DIMENSION(:), SAVE      :: contfrac
-    !$OMP THREADPRIVATE(contfrac)
-! resolution de la grille
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: resolution
-    !$OMP THREADPRIVATE(resolution)
-
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: lon_scat, lat_scat  
-    !$OMP THREADPRIVATE(lon_scat,lat_scat)
-
-    LOGICAL, SAVE                             :: lrestart_read = .TRUE.
-    !$OMP THREADPRIVATE(lrestart_read)
-    LOGICAL, SAVE                             :: lrestart_write = .FALSE.
-    !$OMP THREADPRIVATE(lrestart_write)
-
-    REAL, DIMENSION(knon,2)                   :: albedo_out
-    !$OMP THREADPRIVATE(albedo_out)
-
-! Pb de nomenclature
-    REAL, DIMENSION(klon)                     :: petA_orc, peqA_orc
-    REAL, DIMENSION(klon)                     :: petB_orc, peqB_orc
-! Pb de correspondances de grilles
-    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE  :: ig, jg
-    !$OMP THREADPRIVATE(ig,jg)
-    INTEGER :: indi, indj
-    INTEGER, SAVE, ALLOCATABLE,DIMENSION(:)   :: ktindex
-    !$OMP THREADPRIVATE(ktindex)
-
-! Essai cdrag
-    REAL, DIMENSION(klon)                     :: cdrag
-    INTEGER,SAVE                              :: offset
-    !$OMP THREADPRIVATE(offset)
-
-    REAL, DIMENSION(klon_glo)                 :: rlon_g,rlat_g
-    INTEGER, SAVE                             :: orch_comm
-    !$OMP THREADPRIVATE(orch_comm)
-
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: coastalflow
-    !$OMP THREADPRIVATE(coastalflow)
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: riverflow
-    !$OMP THREADPRIVATE(riverflow)
-!
-! Fin definition
-!****************************************************************************************
-#ifdef CPP_VEGET
-
-    IF (check) WRITE(lunout,*)'Entree ', modname
-  
-! Initialisation
-  
-    IF (debut) THEN
-! Test de coherence
-#ifndef ORCH_NEW
-       ! Compilation avec orchidee nouvelle version necessaire avec carbon_cycle_cpl=y
-       IF (carbon_cycle_cpl) THEN
-          abort_message='You must define preprossing key ORCH_NEW when running carbon_cycle_cpl=y'
-          CALL abort_physic(modname,abort_message,1)
-       END IF
-#endif
-       ALLOCATE(ktindex(knon))
-       IF ( .NOT. ALLOCATED(albedo_keep)) THEN
-          ALLOCATE(albedo_keep(klon))
-          ALLOCATE(zlev(knon))
-       ENDIF
-! Pb de correspondances de grilles
-       ALLOCATE(ig(klon))
-       ALLOCATE(jg(klon))
-       ig(1) = 1
-       jg(1) = 1
-       indi = 0
-       indj = 2
-       DO igrid = 2, klon - 1
-          indi = indi + 1
-          IF ( indi > nbp_lon) THEN
-             indi = 1
-             indj = indj + 1
-          ENDIF
-          ig(igrid) = indi
-          jg(igrid) = indj
-       ENDDO
-       ig(klon) = 1
-       jg(klon) = nbp_lat
-
-       IF ((.NOT. ALLOCATED(lalo))) THEN
-          ALLOCATE(lalo(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lalo'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lon_scat))) THEN
-          ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lon_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lat_scat))) THEN
-          ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lat_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       lon_scat = 0.
-       lat_scat = 0.
-       DO igrid = 1, knon
-          index = knindex(igrid)
-          lalo(igrid,2) = rlon(index)
-          lalo(igrid,1) = rlat(index)
-       ENDDO
-
-       
-       
-       CALL Gather(rlon,rlon_g)
-       CALL Gather(rlat,rlat_g)
-
-       IF (is_mpi_root) THEN
-          index = 1
-          DO jj = 2, nbp_lat-1
-             DO ij = 1, nbp_lon
-                index = index + 1
-                lon_scat(ij,jj) = rlon_g(index)
-                lat_scat(ij,jj) = rlat_g(index)
-             ENDDO
-          ENDDO
-          lon_scat(:,1) = lon_scat(:,2)
-          lat_scat(:,1) = rlat_g(1)
-          lon_scat(:,nbp_lat) = lon_scat(:,2)
-          lat_scat(:,nbp_lat) = rlat_g(klon_glo)
-       ENDIF
-
-       CALL bcast(lon_scat) 
-       CALL bcast(lat_scat) 
-
-!
-! Allouer et initialiser le tableau des voisins et des fraction de continents
-!
-       IF ( (.NOT.ALLOCATED(neighbours))) THEN
-          ALLOCATE(neighbours(knon,8), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation neighbours'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       neighbours = -1.
-       IF (( .NOT. ALLOCATED(contfrac))) THEN
-          ALLOCATE(contfrac(knon), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation contfrac'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-
-       DO igrid = 1, knon
-          ireal = knindex(igrid)
-          contfrac(igrid) = pctsrf(ireal,is_ter)
-       ENDDO
-
-
-       CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
-
-!
-!  Allocation et calcul resolutions
-       IF ( (.NOT.ALLOCATED(resolution))) THEN
-          ALLOCATE(resolution(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation resolution'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       DO igrid = 1, knon
-          ij = knindex(igrid)
-          resolution(igrid,1) = dx(ij)
-          resolution(igrid,2) = dy(ij)
-       ENDDO
-     
-       ALLOCATE(coastalflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation coastalflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       
-       ALLOCATE(riverflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation riverflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-
-!
-! Allocate variables needed for carbon_cycle_mod
-       IF ( carbon_cycle_cpl ) THEN
-          nb_fields_cpl=2
-       ELSE
-          nb_fields_cpl=1
-       END IF
-
-
-       IF (carbon_cycle_cpl) THEN
-          ALLOCATE(fco2_land_inst(klon),stat=error)
-          IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fco2_land_inst',1)
-          
-          ALLOCATE(fco2_lu_inst(klon),stat=error)
-          IF(error /=0) CALL abort_physic(modname,'Pb in allocation fco2_lu_inst',1)
-       END IF
-
-       ALLOCATE(fields_cpl(klon,nb_fields_cpl), stat = error)
-       IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_cpl',1)
-
-    ENDIF                          ! (fin debut) 
-
-! 
-! Appel a la routine sols continentaux
-!
-    IF (lafin) lrestart_write = .TRUE.
-    IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
-    
-    petA_orc(1:knon) = petBcoef(1:knon) * dtime
-    petB_orc(1:knon) = petAcoef(1:knon)
-    peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
-    peqB_orc(1:knon) = peqAcoef(1:knon)
-
-    cdrag = 0.
-    cdrag(1:knon) = tq_cdrag(1:knon)
-
-! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/287.05*temp_air(1:knon))*9.80665)
-    zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG)
-
-
-! PF et PASB
-!   where(cdrag > 0.01) 
-!     cdrag = 0.01
-!   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
-
-!
-! Init Orchidee
-!
-!  if (pole_nord) then 
-!    offset=0
-!    ktindex(:)=ktindex(:)+nbp_lon-1
-!  else
-!    offset = klon_mpi_begin-1+nbp_lon-1
-!    ktindex(:)=ktindex(:)+MOD(offset,nbp_lon)
-!    offset=offset-MOD(offset,nbp_lon)
-!  endif
-  
-    IF (debut) THEN
-       CALL Get_orchidee_communicator(knon,orch_comm)
-       IF (knon /=0) THEN
-          CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
-
-#ifndef CPP_MPI
-          ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
-          CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-               lrestart_read, lrestart_write, lalo, &
-               contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
-               cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-               precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
-               evap, fluxsens, fluxlat, coastalflow, riverflow, &
-               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
-               lon_scat, lat_scat, q2m, t2m &
-#ifdef ORCH_NEW
-               , nb_fields_cpl, fields_cpl)
-#else
-               )
-#endif
-
-#else          
-          ! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4, 1.9.5) compiled in parallel mode(with preprocessing flag CPP_MPI)
-          CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, offset, knon, ktindex, & 
-               orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
-               contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-               cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-               precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
-               evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-               tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
-               lon_scat, lat_scat, q2m, t2m &
-#ifdef ORCH_NEW
-               , nb_fields_cpl, fields_cpl(1:knon,:))
-#else
-               )
-#endif
-#endif
-          
-       ENDIF
-
-       albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-    ENDIF
-
-!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
-    swdown_vrai(1:knon) = swdown(1:knon)
-
-    IF (knon /=0) THEN
-#ifndef CPP_MPI
-       ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
-       CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-            lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
-            cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-            precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
-            evap, fluxsens, fluxlat, coastalflow, riverflow, &
-            tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
-            lon_scat, lat_scat, q2m, t2m &
-#ifdef ORCH_NEW
-            , nb_fields_cpl, fields_cpl)
-#else
-            )
-#endif
-#else
-       ! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
-       CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat,offset, knon, ktindex, & 
-            orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-            cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-            precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
-            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
-            lon_scat, lat_scat, q2m, t2m &
-#ifdef ORCH_NEW
-            , nb_fields_cpl, fields_cpl(1:knon,:))
-#else
-            )
-#endif
-#endif
-    ENDIF
-
-    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-    
-    ! ORCHIDEE only gives one value for z0_new. Copy it into z0h_new.
-    z0h_new(:)=z0_new(:)
-
-!* Send to coupler
-!
-    IF (type_ocean=='couple') THEN
-       CALL cpl_send_land_fields(itime, knon, knindex, &
-            riverflow, coastalflow)
-    ENDIF
-
-    alb1_new(1:knon) = albedo_out(1:knon,1) 
-    alb2_new(1:knon) = albedo_out(1:knon,2)
-
-! Convention orchidee: positif vers le haut
-    fluxsens(1:knon) = -1. * fluxsens(1:knon)
-    fluxlat(1:knon)  = -1. * fluxlat(1:knon)
-    
-!  evap     = -1. * evap
-
-    IF (debut) lrestart_read = .FALSE.
-
-! Decompress variables for the module carbon_cycle_mod
-    IF (carbon_cycle_cpl) THEN
-       fco2_land_inst(:)=0.
-       fco2_lu_inst(:)=0.
-       
-       DO igrid = 1, knon
-          ireal = knindex(igrid)
-          fco2_land_inst(ireal) = fields_cpl(igrid,1)
-          fco2_lu_inst(ireal)   = fields_cpl(igrid,2)
-       END DO
-    END IF
-
-#endif    
-  END SUBROUTINE surf_land_orchidee
-!
-!****************************************************************************************
-!
-  SUBROUTINE Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
-    
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                   :: knon
-    INTEGER, INTENT(IN)                   :: orch_comm
-    INTEGER, DIMENSION(klon), INTENT(IN)  :: knindex
-
-! Output arguments
-!****************************************************************************************
-    INTEGER, INTENT(OUT)                  :: offset
-    INTEGER, DIMENSION(knon), INTENT(OUT) :: ktindex
-
-! Local varables
-!****************************************************************************************
-#ifdef CPP_MPI
-    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: status
-#endif
-
-    INTEGER                               :: MyLastPoint
-    INTEGER                               :: LastPoint
-    INTEGER                               :: mpi_rank_orch
-    INTEGER                               :: mpi_size_orch
-    INTEGER                               :: ierr 
-!
-! End definition
-!****************************************************************************************
-
-    MyLastPoint=klon_mpi_begin-1+knindex(knon)+nbp_lon-1
-    
-    IF (is_parallel) THEN
-#ifdef CPP_MPI    
-       CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
-       CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
-#endif
-    ELSE
-       mpi_rank_orch=0
-       mpi_size_orch=1
-    ENDIF
-
-    IF (is_parallel) THEN
-       IF (mpi_rank_orch /= 0) THEN
-#ifdef CPP_MPI
-          CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
-#endif
-       ENDIF
-       
-       IF (mpi_rank_orch /= mpi_size_orch-1) THEN
-#ifdef CPP_MPI
-          CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr)  
-#endif
-       ENDIF
-    ENDIF
-    
-    IF (mpi_rank_orch == 0) THEN 
-       offset=0
-    ELSE
-       offset=LastPoint-MOD(LastPoint,nbp_lon)
-    ENDIF
-    
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+nbp_lon-1)-offset-1	
-    
-
-  END SUBROUTINE  Init_orchidee_index
-!
-!****************************************************************************************
-! 
-  SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-
-    INTEGER,INTENT(IN)  :: knon
-    INTEGER,INTENT(OUT) :: orch_comm
-    
-    INTEGER             :: color
-    INTEGER             :: ierr
-!
-! End definition
-!****************************************************************************************
-
-    IF (knon==0) THEN 
-       color = 0
-    ELSE 
-       color = 1
-    ENDIF
-    
-#ifdef CPP_MPI    
-    CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
-    
-  END SUBROUTINE Get_orchidee_communicator
-!
-!****************************************************************************************
-!  
-  SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
-    
-    USE indice_sol_mod
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: ktindex
-    REAL, DIMENSION(klon), INTENT(IN)       :: pctsrf
-    
-! Output arguments
-!****************************************************************************************
-    INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
-
-! Local variables
-!****************************************************************************************
-    INTEGER                              :: knon_g
-    INTEGER                              :: i, igrid, jj, ij, iglob
-    INTEGER                              :: ierr, ireal, index
-    INTEGER                              :: var_tmp
-    INTEGER, DIMENSION(0:mpi_size-1)     :: knon_nb
-    INTEGER, DIMENSION(0:mpi_size-1)     :: displs
-    INTEGER, DIMENSION(8,3)              :: off_ini
-    INTEGER, DIMENSION(8)                :: offset  
-    INTEGER, DIMENSION(knon)             :: ktindex_p
-    INTEGER, DIMENSION(nbp_lon,nbp_lat)        :: correspond
-    INTEGER, ALLOCATABLE, DIMENSION(:)   :: ktindex_g
-    INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
-    REAL, DIMENSION(klon_glo)            :: pctsrf_g
-    
-!
-! End definition
-!****************************************************************************************
-
-    IF (is_sequential) THEN
-       knon_nb(:)=knon
-    ELSE  
-       
-#ifdef CPP_MPI  
-       CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
-#endif
-       
-    ENDIF
-    
-    IF (is_mpi_root) THEN
-       knon_g=SUM(knon_nb(:))
-       ALLOCATE(ktindex_g(knon_g))
-       ALLOCATE(neighbours_g(knon_g,8))
-       neighbours_g(:,:)=-1
-       displs(0)=0
-       DO i=1,mpi_size-1
-          displs(i)=displs(i-1)+knon_nb(i-1)
-       ENDDO
-   ELSE
-       ALLOCATE(ktindex_g(1))
-       ALLOCATE(neighbours_g(1,8))
-   ENDIF
-    
-    ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+nbp_lon-1
-    
-    IF (is_sequential) THEN
-       ktindex_g(:)=ktindex_p(:)
-    ELSE
-       
-#ifdef CPP_MPI  
-       CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
-            displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
-#endif
-       
-    ENDIF
-    
-    CALL Gather(pctsrf,pctsrf_g)
-    
-    IF (is_mpi_root) THEN
-!  Initialisation des offset    
-!
-! offset bord ouest
-       off_ini(1,1) = - nbp_lon  ; off_ini(2,1) = - nbp_lon + 1; off_ini(3,1) = 1
-       off_ini(4,1) = nbp_lon + 1; off_ini(5,1) = nbp_lon      ; off_ini(6,1) = 2 * nbp_lon - 1
-       off_ini(7,1) = nbp_lon -1 ; off_ini(8,1) = - 1
-! offset point normal
-       off_ini(1,2) = - nbp_lon  ; off_ini(2,2) = - nbp_lon + 1; off_ini(3,2) = 1
-       off_ini(4,2) = nbp_lon + 1; off_ini(5,2) = nbp_lon      ; off_ini(6,2) = nbp_lon - 1
-       off_ini(7,2) = -1     ; off_ini(8,2) = - nbp_lon - 1
-! offset bord   est
-       off_ini(1,3) = - nbp_lon; off_ini(2,3) = - 2 * nbp_lon + 1; off_ini(3,3) = - nbp_lon + 1
-       off_ini(4,3) =  1   ; off_ini(5,3) = nbp_lon          ; off_ini(6,3) = nbp_lon - 1
-       off_ini(7,3) = -1   ; off_ini(8,3) = - nbp_lon - 1
-!
-!
-! Attention aux poles
-!
-       DO igrid = 1, knon_g
-          index = ktindex_g(igrid)
-          jj = INT((index - 1)/nbp_lon) + 1
-          ij = index - (jj - 1) * nbp_lon
-          correspond(ij,jj) = igrid
-       ENDDO
-       
-       DO igrid = 1, knon_g
-          iglob = ktindex_g(igrid)
-          IF (MOD(iglob, nbp_lon) == 1) THEN
-             offset = off_ini(:,1)
-          ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
-             offset = off_ini(:,3)
-          ELSE
-             offset = off_ini(:,2)
-          ENDIF
-          DO i = 1, 8
-             index = iglob + offset(i)
-             ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
-             IF (pctsrf_g(ireal) > EPSFRA) THEN
-                jj = INT((index - 1)/nbp_lon) + 1
-                ij = index - (jj - 1) * nbp_lon
-                neighbours_g(igrid, i) = correspond(ij, jj)
-             ENDIF
-          ENDDO
-       ENDDO
-
-    ENDIF
-    
-    DO i=1,8
-       IF (is_sequential) THEN
-          neighbours(:,i)=neighbours_g(:,i)
-       ELSE
-#ifdef CPP_MPI
-          IF (knon > 0) THEN
-             ! knon>0, scattter global field neighbours_g from master process to local process
-             CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr) 
-          ELSE
-             ! knon=0, no need to save the field for this process
-             CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,var_tmp,knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr) 
-          END IF
-#endif
-       ENDIF
-    ENDDO
-    
-  END SUBROUTINE Init_neighbours
-!
-!****************************************************************************************
-!
-
-#endif
-END MODULE surf_land_orchidee_noopenmp_mod
+link ../phylmd/surf_land_orchidee_noopenmp_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_nounstruct_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_nounstruct_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_nounstruct_mod.F90	(revision 3940)
@@ -1,682 +1,1 @@
-!
-MODULE surf_land_orchidee_nounstruct_mod
-#ifndef ORCHIDEE_NOZ0H
-#ifdef ORCHIDEE_NOUNSTRUCT
-!
-! This module controles the interface towards the model ORCHIDEE.
-!
-! Compatibility with ORCHIDIEE :
-! The current version can be used with ORCHIDEE/trunk from revision xxxx.
-! This module is compiled only if cpp key ORCHIDEE_NOUNSTRUCT is defined.
-!
-! Subroutines in this module : surf_land_orchidee
-!                              Init_orchidee_index
-!                              Get_orchidee_communicator
-!                              Init_neighbours
-
-  USE dimphy
-#ifdef CPP_VEGET
-  USE intersurf     ! module d'ORCHIDEE
-#endif
-  USE cpl_mod,      ONLY : cpl_send_land_fields
-  USE surface_data, ONLY : type_ocean
-  USE geometry_mod, ONLY : dx, dy
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
-
-  IMPLICIT NONE
-
-  PRIVATE
-  PUBLIC  :: surf_land_orchidee
-
-CONTAINS
-!
-!****************************************************************************************
-!  
-  SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
-       knindex, rlon, rlat, yrmu0, pctsrf, &
-       debut, lafin, &
-       plev,  u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, & 
-       tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-       precip_rain, precip_snow, lwdown, swnet, swdown, &
-       ps, q2m, t2m, &
-       evap, fluxsens, fluxlat, &              
-       tsol_rad, tsurf_new, alb1_new, alb2_new, &
-       emis_new, z0m_new, z0h_new, qsurf, &
-       veget, lai, height )
-
-
-    USE mod_surf_para
-    USE mod_synchro_omp
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: lunout
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-#ifdef CPP_VEGET
-    USE time_phylmdz_mod, ONLY: itau_phy 
-#endif
-!    
-! Cette routine sert d'interface entre le modele atmospherique et le 
-! modele de sol continental. Appel a sechiba
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps
-!   dtime        pas de temps de la physique (en s)
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-!   knindex      index des points de la surface a traiter
-!   rlon         longitudes de la grille entiere
-!   rlat         latitudes de la grille entiere
-!   pctsrf       tableau des fractions de surface de chaque maille
-!   debut        logical: 1er appel a la physique (lire les restart)
-!   lafin        logical: dernier appel a la physique (ecrire les restart)
-!                     (si false calcul simplifie des fluxs sur les continents)
-!   plev         hauteur de la premiere couche (Pa)      
-!   u1_lay       vitesse u 1ere couche
-!   v1_lay       vitesse v 1ere couche
-!   temp_air     temperature de l'air 1ere couche
-!   spechum      humidite specifique 1ere couche
-!   epot_air     temp pot de l'air
-!   ccanopy      concentration CO2 canopee, correspond au co2_send de 
-!                carbon_cycle_mod ou valeur constant co2_ppm
-!   tq_cdrag     cdrag
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   precip_rain  precipitation liquide
-!   precip_snow  precipitation solide
-!   lwdown       flux IR descendant a la surface
-!   swnet        flux solaire net
-!   swdown       flux solaire entrant a la surface
-!   ps           pression au sol
-!   radsol       rayonnement net aus sol (LW + SW)
-!   
-!
-! output:
-!   evap         evaporation totale
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   tsol_rad     
-!   tsurf_new    temperature au sol
-!   alb1_new     albedo in visible SW interval
-!   alb2_new     albedo in near IR interval
-!   emis_new     emissivite
-!   z0m_new      surface roughness for momentum
-!   z0h_new      surface roughness for heat
-!   qsurf        air moisture at surface
-!
-    INCLUDE "YOMCST.h"
-    INCLUDE "dimpft.h"
-
-
-  
-!
-! Parametres d'entree
-!****************************************************************************************
-    INTEGER, INTENT(IN)                       :: itime
-    REAL, INTENT(IN)                          :: dtime
-    REAL, INTENT(IN)                          :: date0
-    INTEGER, INTENT(IN)                       :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-    LOGICAL, INTENT(IN)                       :: debut, lafin
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)   :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)         :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)         :: yrmu0 ! cosine of solar zenith angle
-    REAL, DIMENSION(klon), INTENT(IN)         :: plev
-    REAL, DIMENSION(klon), INTENT(IN)         :: u1_lay, v1_lay, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)         :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)         :: epot_air, ccanopy
-    REAL, DIMENSION(klon), INTENT(IN)         :: tq_cdrag
-    REAL, DIMENSION(klon), INTENT(IN)         :: petAcoef, peqAcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)         :: lwdown, swnet, swdown, ps
-    REAL, DIMENSION(klon), INTENT(IN)         :: q2m, t2m
-
-! Parametres de sortie
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)        :: evap, fluxsens, fluxlat, qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)        :: tsol_rad, tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: alb1_new, alb2_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: emis_new, z0m_new, z0h_new
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: lai
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
-
-
-! Local
-!****************************************************************************************
-    INTEGER                                   :: ij, jj, igrid, ireal, index
-    INTEGER                                   :: error
-    REAL, DIMENSION(klon)                     :: swdown_vrai
-    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
-    CHARACTER (len = 80)                      :: abort_message
-    LOGICAL,SAVE                              :: check = .FALSE.
-    !$OMP THREADPRIVATE(check)
-
-! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
-! drapeaux controlant les appels dans SECHIBA
-!  type(control_type), save   :: control_in
-! Preserved albedo
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: albedo_keep, zlev
-    !$OMP THREADPRIVATE(albedo_keep,zlev)
-! coordonnees geographiques
-    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: lalo
-    !$OMP THREADPRIVATE(lalo)
-! pts voisins
-    INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
-    !$OMP THREADPRIVATE(neighbours)
-! fractions continents
-    REAL,ALLOCATABLE, DIMENSION(:), SAVE      :: contfrac
-    !$OMP THREADPRIVATE(contfrac)
-! resolution de la grille
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: resolution
-    !$OMP THREADPRIVATE(resolution)
-
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: lon_scat, lat_scat  
-    !$OMP THREADPRIVATE(lon_scat,lat_scat)
-
-    LOGICAL, SAVE                             :: lrestart_read = .TRUE.
-    !$OMP THREADPRIVATE(lrestart_read)
-    LOGICAL, SAVE                             :: lrestart_write = .FALSE.
-    !$OMP THREADPRIVATE(lrestart_write)
-
-    REAL, DIMENSION(knon,2)                   :: albedo_out
-
-! Pb de nomenclature
-    REAL, DIMENSION(klon)                     :: petA_orc, peqA_orc
-    REAL, DIMENSION(klon)                     :: petB_orc, peqB_orc
-! Pb de correspondances de grilles
-    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE  :: ig, jg
-    !$OMP THREADPRIVATE(ig,jg)
-    INTEGER :: indi, indj
-    INTEGER, SAVE, ALLOCATABLE,DIMENSION(:)   :: ktindex
-    !$OMP THREADPRIVATE(ktindex)
-
-! Essai cdrag
-    REAL, DIMENSION(klon)                     :: cdrag
-    INTEGER,SAVE                              :: offset
-    !$OMP THREADPRIVATE(offset)
-
-    REAL, DIMENSION(klon_glo)                 :: rlon_g,rlat_g
-    INTEGER, SAVE                             :: orch_comm
-    !$OMP THREADPRIVATE(orch_comm)
-
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: coastalflow
-    !$OMP THREADPRIVATE(coastalflow)
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: riverflow
-    !$OMP THREADPRIVATE(riverflow)
-    
-    INTEGER :: orch_omp_rank
-    INTEGER :: orch_omp_size
-!
-! Fin definition
-!****************************************************************************************
-
-    IF (check) WRITE(lunout,*)'Entree ', modname
-  
-! Initialisation
-  
-    IF (debut) THEN
-! Test of coherence between variable ok_veget and cpp key CPP_VEGET
-#ifndef CPP_VEGET
-       abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
-       CALL abort_physic(modname,abort_message,1)
-#endif
-
-       CALL Init_surf_para(knon)
-       ALLOCATE(ktindex(knon))
-       IF ( .NOT. ALLOCATED(albedo_keep)) THEN
-!ym          ALLOCATE(albedo_keep(klon))
-!ym bizarre que non alloué en knon precedement
-          ALLOCATE(albedo_keep(knon))
-          ALLOCATE(zlev(knon))
-       ENDIF
-! Pb de correspondances de grilles
-       ALLOCATE(ig(klon))
-       ALLOCATE(jg(klon))
-       ig(1) = 1
-       jg(1) = 1
-       indi = 0
-       indj = 2
-       DO igrid = 2, klon - 1
-          indi = indi + 1
-          IF ( indi > nbp_lon) THEN
-             indi = 1
-             indj = indj + 1
-          ENDIF
-          ig(igrid) = indi
-          jg(igrid) = indj
-       ENDDO
-       ig(klon) = 1
-       jg(klon) = nbp_lat
-
-       IF ((.NOT. ALLOCATED(lalo))) THEN
-          ALLOCATE(lalo(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lalo'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lon_scat))) THEN
-          ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lon_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lat_scat))) THEN
-          ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lat_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       lon_scat = 0.
-       lat_scat = 0.
-       DO igrid = 1, knon
-          index = knindex(igrid)
-          lalo(igrid,2) = rlon(index)
-          lalo(igrid,1) = rlat(index)
-       ENDDO
-
-       
-       
-       CALL Gather(rlon,rlon_g)
-       CALL Gather(rlat,rlat_g)
-
-       IF (is_mpi_root) THEN
-          index = 1
-          DO jj = 2, nbp_lat-1
-             DO ij = 1, nbp_lon
-                index = index + 1
-                lon_scat(ij,jj) = rlon_g(index)
-                lat_scat(ij,jj) = rlat_g(index)
-             ENDDO
-          ENDDO
-          lon_scat(:,1) = lon_scat(:,2)
-          lat_scat(:,1) = rlat_g(1)
-          lon_scat(:,nbp_lat) = lon_scat(:,2)
-          lat_scat(:,nbp_lat) = rlat_g(klon_glo)
-       ENDIF
-   
-       CALL bcast(lon_scat)
-       CALL bcast(lat_scat)
-!
-! Allouer et initialiser le tableau des voisins et des fraction de continents
-!
-       IF ( (.NOT.ALLOCATED(neighbours))) THEN
-          ALLOCATE(neighbours(knon,8), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation neighbours'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       neighbours = -1.
-       IF (( .NOT. ALLOCATED(contfrac))) THEN
-          ALLOCATE(contfrac(knon), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation contfrac'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-
-       DO igrid = 1, knon
-          ireal = knindex(igrid)
-          contfrac(igrid) = pctsrf(ireal,is_ter)
-       ENDDO
-
-
-       CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
-
-!
-!  Allocation et calcul resolutions
-       IF ( (.NOT.ALLOCATED(resolution))) THEN
-          ALLOCATE(resolution(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation resolution'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       DO igrid = 1, knon
-          ij = knindex(igrid)
-          resolution(igrid,1) = dx(ij)
-          resolution(igrid,2) = dy(ij)
-       ENDDO
-     
-       ALLOCATE(coastalflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation coastalflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       
-       ALLOCATE(riverflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation riverflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-!
-! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
-!
-       IF (carbon_cycle_cpl) THEN
-          abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
-          CALL abort_physic(modname,abort_message,1)
-       END IF
-       
-    ENDIF                          ! (fin debut) 
- 
-
-! 
-! Appel a la routine sols continentaux
-!
-    IF (lafin) lrestart_write = .TRUE.
-    IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
-     
-    petA_orc(1:knon) = petBcoef(1:knon) * dtime
-    petB_orc(1:knon) = petAcoef(1:knon)
-    peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
-    peqB_orc(1:knon) = peqAcoef(1:knon)
-
-    cdrag = 0.
-    cdrag(1:knon) = tq_cdrag(1:knon)
-
-! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/287.05*temp_air(1:knon))*9.80665)
-!    zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG)
-     zlev(1:knon) = plev(1:knon)*RD*temp_air(1:knon)/((ps(1:knon)*100.0)*RG)
-
-
-! PF et PASB
-!   where(cdrag > 0.01) 
-!     cdrag = 0.01
-!   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
-
-  
-    IF (debut) THEN
-       CALL Init_orchidee_index(knon,knindex,offset,ktindex)
-       CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
-       CALL Init_synchro_omp
-       
-       IF (knon > 0) THEN
-#ifdef CPP_VEGET
-         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
-#endif
-       ENDIF
-
-       
-       IF (knon > 0) THEN
-
-#ifdef CPP_VEGET
-         CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-               lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, &
-               cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-               precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
-               evap, fluxsens, fluxlat, coastalflow, riverflow, &
-               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, &    
-               lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch)
-#endif         
-       ENDIF
-
-       CALL Synchro_omp
-
-       albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-    ENDIF
-
-    
-!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
-    swdown_vrai(1:knon) = swdown(1:knon)
-
-    IF (knon > 0) THEN
-#ifdef CPP_VEGET    
-       IF (nvm_orch .NE. nvm_lmdz ) THEN
-          abort_message='Pb de dimensiosn PFT: nvm_orch et nvm_lmdz differents.'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-
-       CALL intersurf_main_gathered (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime,  &
-            lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-            cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-            precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
-            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0m_new(1:knon), &
-            lon_scat, lat_scat, q2m, t2m, z0h_new(1:knon),&
-            veget(1:knon,:),lai(1:knon,:),height(1:knon,:),&
-            coszang=yrmu0(1:knon))
-#endif       
-    ENDIF
-
-    CALL Synchro_omp
-    
-    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-!* Send to coupler
-!
-    IF (type_ocean=='couple') THEN
-       CALL cpl_send_land_fields(itime, knon, knindex, &
-            riverflow, coastalflow)
-    ENDIF
-
-    alb1_new(1:knon) = albedo_out(1:knon,1) 
-    alb2_new(1:knon) = albedo_out(1:knon,2)
-
-! Convention orchidee: positif vers le haut
-    fluxsens(1:knon) = -1. * fluxsens(1:knon)
-    fluxlat(1:knon)  = -1. * fluxlat(1:knon)
-    
-!  evap     = -1. * evap
-
-    IF (debut) lrestart_read = .FALSE.
-    
-    IF (debut) CALL Finalize_surf_para
-
-    
-  END SUBROUTINE surf_land_orchidee
-!
-!****************************************************************************************
-!
-  SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
-  USE mod_surf_para
-  USE mod_grid_phy_lmdz
-  
-    INTEGER,INTENT(IN)    :: knon
-    INTEGER,INTENT(IN)    :: knindex(klon)    
-    INTEGER,INTENT(OUT)   :: offset
-    INTEGER,INTENT(OUT)   :: ktindex(klon)
-    
-    INTEGER               :: ktindex_glo(knon_glo)
-    INTEGER               :: offset_para(0:omp_size*mpi_size-1)
-    INTEGER               :: LastPoint
-    INTEGER               :: task
-    
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo) 
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      LastPoint=0
-      DO Task=0,mpi_size*omp_size-1
-        IF (knon_glo_para(Task)>0) THEN
-           offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
-           LastPoint=ktindex_glo(knon_glo_end_para(task))
-        ENDIF
-      ENDDO
-    ENDIF
-    
-    CALL bcast(offset_para)
-    
-    offset=offset_para(omp_size*mpi_rank+omp_rank)
-    
-    ktindex(1:knon)=ktindex(1:knon)-offset
-
-  END SUBROUTINE Init_orchidee_index
-
-!
-!************************* ***************************************************************
-! 
-
-  SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
-  USE  mod_surf_para
-      
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-    INTEGER,INTENT(OUT) :: orch_comm
-    INTEGER,INTENT(OUT) :: orch_omp_size
-    INTEGER,INTENT(OUT) :: orch_omp_rank
-    INTEGER             :: color
-    INTEGER             :: i,ierr
-!
-! End definition
-!****************************************************************************************
-    
-    
-    IF (is_omp_root) THEN          
-      
-      IF (knon_mpi==0) THEN 
-         color = 0
-      ELSE 
-         color = 1
-      ENDIF
-    
-#ifdef CPP_MPI    
-      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
-    
-    ENDIF
-    CALL bcast_omp(orch_comm)
-    
-    IF (knon_mpi /= 0) THEN
-      orch_omp_size=0
-      DO i=0,omp_size-1
-        IF (knon_omp_para(i) /=0) THEN
-          orch_omp_size=orch_omp_size+1
-          IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
-        ENDIF
-      ENDDO
-    ENDIF
-   
-    
-  END SUBROUTINE Get_orchidee_communicator
-!
-!****************************************************************************************
-!  
-
-  SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
-    USE mod_grid_phy_lmdz
-    USE mod_surf_para    
-    USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    REAL, DIMENSION(klon), INTENT(IN)       :: pctsrf
-    
-! Output arguments
-!****************************************************************************************
-    INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
-
-! Local variables
-!****************************************************************************************
-    INTEGER                              :: i, igrid, jj, ij, iglob
-    INTEGER                              :: ierr, ireal, index
-    INTEGER, DIMENSION(8,3)              :: off_ini
-    INTEGER, DIMENSION(8)                :: offset  
-    INTEGER, DIMENSION(nbp_lon,nbp_lat)  :: correspond
-    INTEGER, DIMENSION(knon_glo)         :: ktindex_glo
-    INTEGER, DIMENSION(knon_glo,8)       :: neighbours_glo
-    REAL, DIMENSION(klon_glo)            :: pctsrf_glo
-    INTEGER                              :: ktindex(klon)
-!
-! End definition
-!****************************************************************************************
-
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo)
-    CALL gather(pctsrf,pctsrf_glo)
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      neighbours_glo(:,:)=-1
-!  Initialisation des offset    
-!
-! offset bord ouest
-       off_ini(1,1) = - nbp_lon   ; off_ini(2,1) = - nbp_lon + 1     ; off_ini(3,1) = 1
-       off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon           ; off_ini(6,1) = 2 * nbp_lon - 1
-       off_ini(7,1) = nbp_lon -1  ; off_ini(8,1) = - 1 
-! offset point normal
-       off_ini(1,2) = - nbp_lon   ; off_ini(2,2) = - nbp_lon + 1     ; off_ini(3,2) = 1
-       off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon           ; off_ini(6,2) = nbp_lon - 1
-       off_ini(7,2) = -1          ; off_ini(8,2) = - nbp_lon - 1
-! offset bord   est
-       off_ini(1,3) = - nbp_lon   ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
-       off_ini(4,3) =  1          ; off_ini(5,3) = nbp_lon           ; off_ini(6,3) = nbp_lon - 1
-       off_ini(7,3) = -1          ; off_ini(8,3) = - nbp_lon - 1
-!
-!
-! Attention aux poles
-!
-       DO igrid = 1, knon_glo
-          index = ktindex_glo(igrid)
-          jj = INT((index - 1)/nbp_lon) + 1
-          ij = index - (jj - 1) * nbp_lon
-          correspond(ij,jj) = igrid
-       ENDDO
-!sonia : Les mailles des voisines doivent etre toutes egales (pour couplage orchidee)
-       IF (knon_glo == 1) THEN
-         igrid = 1
-         DO i = 1,8
-           neighbours_glo(igrid, i) = igrid
-         ENDDO
-       ELSE
-       print*,'sonia : knon_glo,ij,jj', knon_glo, ij,jj
-       
-       DO igrid = 1, knon_glo
-          iglob = ktindex_glo(igrid)
-          
-          IF (MOD(iglob, nbp_lon) == 1) THEN
-             offset = off_ini(:,1)
-          ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
-             offset = off_ini(:,3)
-          ELSE
-             offset = off_ini(:,2)
-          ENDIF
-          
-          DO i = 1, 8
-             index = iglob + offset(i)
-             ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
-             IF (pctsrf_glo(ireal) > EPSFRA) THEN
-                jj = INT((index - 1)/nbp_lon) + 1
-                ij = index - (jj - 1) * nbp_lon
-                neighbours_glo(igrid, i) = correspond(ij, jj)
-             ENDIF
-          ENDDO
-       ENDDO
-       ENDIF !fin knon_glo == 1
-
-    ENDIF
-    
-    DO i = 1, 8
-      CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
-    ENDDO
-  END SUBROUTINE Init_neighbours
-
-!
-!****************************************************************************************
-!
-#endif
-#endif
-END MODULE surf_land_orchidee_nounstruct_mod
+link ../phylmd/surf_land_orchidee_nounstruct_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_noz0h_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_noz0h_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_land_orchidee_noz0h_mod.F90	(revision 3940)
@@ -1,681 +1,1 @@
-!
-MODULE surf_land_orchidee_noz0h_mod
-#ifdef ORCHIDEE_NOZ0H
-!
-! This module controles the interface towards the model ORCHIDEE.
-!
-! Compatibility with ORCHIDIEE :
-! This module is compiled only if CPP key ORCHIDEE_NOZ0H is defined.
-! This version can be used with ORCHIDEE/trunk revision 2961-3525.
-! It is possible to use this interface with later versions of ORCHIDEE/trunk than 3525 but 
-! in that case the option ROUGH_DYN=y in ORCHIDEE should not be set. 
-! This interface can also be used with ORCHIDEE/trunk revision 1078-2960 if changing 
-! coszang=yrmu0 into sinang=yrmu0 at 2 places later below in this module. 
-!
-! Subroutines in this module : surf_land_orchidee
-!                              Init_orchidee_index
-!                              Get_orchidee_communicator
-!                              Init_neighbours
-
-  USE dimphy
-#ifdef CPP_VEGET
-  USE intersurf     ! module d'ORCHIDEE
-#endif
-  USE cpl_mod,      ONLY : cpl_send_land_fields
-  USE surface_data, ONLY : type_ocean
-  USE geometry_mod, ONLY : dx, dy
-  USE mod_grid_phy_lmdz
-  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
-
-  IMPLICIT NONE
-
-  PRIVATE
-  PUBLIC  :: surf_land_orchidee
-
-CONTAINS
-!
-!****************************************************************************************
-!  
-  SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
-       knindex, rlon, rlat, yrmu0, pctsrf, &
-       debut, lafin, &
-       plev,  u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, & 
-       tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-       precip_rain, precip_snow, lwdown, swnet, swdown, &
-       ps, q2m, t2m, &
-       evap, fluxsens, fluxlat, &              
-       tsol_rad, tsurf_new, alb1_new, alb2_new, &
-       emis_new, z0_new, z0h_new, qsurf, &
-       veget, lai, height)
-
-    USE mod_surf_para
-    USE mod_synchro_omp
-    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: lunout
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-#ifdef CPP_VEGET
-    USE time_phylmdz_mod, ONLY: itau_phy 
-#endif
-!    
-! Cette routine sert d'interface entre le modele atmospherique et le 
-! modele de sol continental. Appel a sechiba
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps
-!   dtime        pas de temps de la physique (en s)
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-!   knindex      index des points de la surface a traiter
-!   rlon         longitudes de la grille entiere
-!   rlat         latitudes de la grille entiere
-!   pctsrf       tableau des fractions de surface de chaque maille
-!   debut        logical: 1er appel a la physique (lire les restart)
-!   lafin        logical: dernier appel a la physique (ecrire les restart)
-!                     (si false calcul simplifie des fluxs sur les continents)
-!   plev         hauteur de la premiere couche (Pa)      
-!   u1_lay       vitesse u 1ere couche
-!   v1_lay       vitesse v 1ere couche
-!   temp_air     temperature de l'air 1ere couche
-!   spechum      humidite specifique 1ere couche
-!   epot_air     temp pot de l'air
-!   ccanopy      concentration CO2 canopee, correspond au co2_send de 
-!                carbon_cycle_mod ou valeur constant co2_ppm
-!   tq_cdrag     cdrag
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   precip_rain  precipitation liquide
-!   precip_snow  precipitation solide
-!   lwdown       flux IR descendant a la surface
-!   swnet        flux solaire net
-!   swdown       flux solaire entrant a la surface
-!   ps           pression au sol
-!   radsol       rayonnement net aus sol (LW + SW)
-!   
-!
-! output:
-!   evap         evaporation totale
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   tsol_rad     
-!   tsurf_new    temperature au sol
-!   alb1_new     albedo in visible SW interval
-!   alb2_new     albedo in near IR interval
-!   emis_new     emissivite
-!   z0_new       surface roughness
-!   z0h_new      surface roughness, it is a copy from z0_new
-!   qsurf        air moisture at surface
-!
-    INCLUDE "YOMCST.h"
-    INCLUDE "dimpft.h"  
-    INCLUDE "compbl.h"
-!
-! Parametres d'entree
-!****************************************************************************************
-    INTEGER, INTENT(IN)                       :: itime
-    REAL, INTENT(IN)                          :: dtime
-    REAL, INTENT(IN)                          :: date0
-    INTEGER, INTENT(IN)                       :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
-    LOGICAL, INTENT(IN)                       :: debut, lafin
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)   :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)         :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)         :: yrmu0 ! cosine of solar zenith angle
-    REAL, DIMENSION(klon), INTENT(IN)         :: plev
-    REAL, DIMENSION(klon), INTENT(IN)         :: u1_lay, v1_lay, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)         :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)         :: epot_air, ccanopy
-    REAL, DIMENSION(klon), INTENT(IN)         :: tq_cdrag
-    REAL, DIMENSION(klon), INTENT(IN)         :: petAcoef, peqAcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)         :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)         :: lwdown, swnet, swdown, ps
-    REAL, DIMENSION(klon), INTENT(IN)         :: q2m, t2m
-
-! Parametres de sortie
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)        :: evap, fluxsens, fluxlat, qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)        :: tsol_rad, tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: alb1_new, alb2_new
-    REAL, DIMENSION(klon), INTENT(OUT)        :: emis_new, z0_new, z0h_new
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget ! dummy variables
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: lai   ! dummy variables
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height! dummy variables
-
-! Local
-!****************************************************************************************
-    INTEGER                                   :: ij, jj, igrid, ireal, index
-    INTEGER                                   :: error
-    REAL, DIMENSION(klon)                     :: swdown_vrai
-    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
-    CHARACTER (len = 80)                      :: abort_message
-    LOGICAL,SAVE                              :: check = .FALSE.
-    !$OMP THREADPRIVATE(check)
-
-! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
-! drapeaux controlant les appels dans SECHIBA
-!  type(control_type), save   :: control_in
-! Preserved albedo
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: albedo_keep, zlev
-    !$OMP THREADPRIVATE(albedo_keep,zlev)
-! coordonnees geographiques
-    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: lalo
-    !$OMP THREADPRIVATE(lalo)
-! pts voisins
-    INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
-    !$OMP THREADPRIVATE(neighbours)
-! fractions continents
-    REAL,ALLOCATABLE, DIMENSION(:), SAVE      :: contfrac
-    !$OMP THREADPRIVATE(contfrac)
-! resolution de la grille
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: resolution
-    !$OMP THREADPRIVATE(resolution)
-
-    REAL, ALLOCATABLE, DIMENSION (:,:), SAVE  :: lon_scat, lat_scat  
-    !$OMP THREADPRIVATE(lon_scat,lat_scat)
-
-    LOGICAL, SAVE                             :: lrestart_read = .TRUE.
-    !$OMP THREADPRIVATE(lrestart_read)
-    LOGICAL, SAVE                             :: lrestart_write = .FALSE.
-    !$OMP THREADPRIVATE(lrestart_write)
-
-    REAL, DIMENSION(knon,2)                   :: albedo_out
-
-! Pb de nomenclature
-    REAL, DIMENSION(klon)                     :: petA_orc, peqA_orc
-    REAL, DIMENSION(klon)                     :: petB_orc, peqB_orc
-! Pb de correspondances de grilles
-    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE  :: ig, jg
-    !$OMP THREADPRIVATE(ig,jg)
-    INTEGER :: indi, indj
-    INTEGER, SAVE, ALLOCATABLE,DIMENSION(:)   :: ktindex
-    !$OMP THREADPRIVATE(ktindex)
-
-! Essai cdrag
-    REAL, DIMENSION(klon)                     :: cdrag
-    INTEGER,SAVE                              :: offset
-    !$OMP THREADPRIVATE(offset)
-
-    REAL, DIMENSION(klon_glo)                 :: rlon_g,rlat_g
-    INTEGER, SAVE                             :: orch_comm
-    !$OMP THREADPRIVATE(orch_comm)
-
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: coastalflow
-    !$OMP THREADPRIVATE(coastalflow)
-    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: riverflow
-    !$OMP THREADPRIVATE(riverflow)
-    
-    INTEGER :: orch_omp_rank
-    INTEGER :: orch_omp_size
-!
-! Fin definition
-!****************************************************************************************
-
-    IF (check) WRITE(lunout,*)'Entree ', modname
-
-    IF (ifl_pbltree == 1) THEN
-       abort_message='Pb de coherence: cette interface vers ORCHIDEE ne peut pas etre utilise avec ifl_pbltree'
-       CALL abort_physic(modname,abort_message,1)
-    END IF
-  
-! Initialisation
-  
-    IF (debut) THEN
-! Test of coherence between variable ok_veget and cpp key CPP_VEGET
-#ifndef CPP_VEGET
-       abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
-       CALL abort_physic(modname,abort_message,1)
-#endif
-
-       CALL Init_surf_para(knon)
-       ALLOCATE(ktindex(knon))
-       IF ( .NOT. ALLOCATED(albedo_keep)) THEN
-!ym          ALLOCATE(albedo_keep(klon))
-!ym bizarre que non alloué en knon precedement
-          ALLOCATE(albedo_keep(knon))
-          ALLOCATE(zlev(knon))
-       ENDIF
-! Pb de correspondances de grilles
-       ALLOCATE(ig(klon))
-       ALLOCATE(jg(klon))
-       ig(1) = 1
-       jg(1) = 1
-       indi = 0
-       indj = 2
-       DO igrid = 2, klon - 1
-          indi = indi + 1
-          IF ( indi > nbp_lon) THEN
-             indi = 1
-             indj = indj + 1
-          ENDIF
-          ig(igrid) = indi
-          jg(igrid) = indj
-       ENDDO
-       ig(klon) = 1
-       jg(klon) = nbp_lat
-
-       IF ((.NOT. ALLOCATED(lalo))) THEN
-          ALLOCATE(lalo(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lalo'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lon_scat))) THEN
-          ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lon_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       IF ((.NOT. ALLOCATED(lat_scat))) THEN
-          ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation lat_scat'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       lon_scat = 0.
-       lat_scat = 0.
-       DO igrid = 1, knon
-          index = knindex(igrid)
-          lalo(igrid,2) = rlon(index)
-          lalo(igrid,1) = rlat(index)
-       ENDDO
-
-       
-       
-       CALL Gather(rlon,rlon_g)
-       CALL Gather(rlat,rlat_g)
-
-       IF (is_mpi_root) THEN
-          index = 1
-          DO jj = 2, nbp_lat-1
-             DO ij = 1, nbp_lon
-                index = index + 1
-                lon_scat(ij,jj) = rlon_g(index)
-                lat_scat(ij,jj) = rlat_g(index)
-             ENDDO
-          ENDDO
-          lon_scat(:,1) = lon_scat(:,2)
-          lat_scat(:,1) = rlat_g(1)
-          lon_scat(:,nbp_lat) = lon_scat(:,2)
-          lat_scat(:,nbp_lat) = rlat_g(klon_glo)
-       ENDIF
-   
-       CALL bcast(lon_scat)
-       CALL bcast(lat_scat)
-!
-! Allouer et initialiser le tableau des voisins et des fraction de continents
-!
-       IF ( (.NOT.ALLOCATED(neighbours))) THEN
-          ALLOCATE(neighbours(knon,8), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation neighbours'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       neighbours = -1.
-       IF (( .NOT. ALLOCATED(contfrac))) THEN
-          ALLOCATE(contfrac(knon), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation contfrac'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-
-       DO igrid = 1, knon
-          ireal = knindex(igrid)
-          contfrac(igrid) = pctsrf(ireal,is_ter)
-       ENDDO
-
-
-       CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
-
-!
-!  Allocation et calcul resolutions
-       IF ( (.NOT.ALLOCATED(resolution))) THEN
-          ALLOCATE(resolution(knon,2), stat = error)
-          IF (error /= 0) THEN
-             abort_message='Pb allocation resolution'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-       DO igrid = 1, knon
-          ij = knindex(igrid)
-          resolution(igrid,1) = dx(ij)
-          resolution(igrid,2) = dy(ij)
-       ENDDO
-     
-       ALLOCATE(coastalflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation coastalflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-       
-       ALLOCATE(riverflow(klon), stat = error)
-       IF (error /= 0) THEN
-          abort_message='Pb allocation riverflow'
-          CALL abort_physic(modname,abort_message,1)
-       ENDIF
-!
-! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
-!
-       IF (carbon_cycle_cpl) THEN
-          abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
-          CALL abort_physic(modname,abort_message,1)
-       END IF
-       
-    ENDIF                          ! (fin debut) 
- 
-
-! 
-! Appel a la routine sols continentaux
-!
-    IF (lafin) lrestart_write = .TRUE.
-    IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
-     
-    petA_orc(1:knon) = petBcoef(1:knon) * dtime
-    petB_orc(1:knon) = petAcoef(1:knon)
-    peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
-    peqB_orc(1:knon) = peqAcoef(1:knon)
-
-    cdrag = 0.
-    cdrag(1:knon) = tq_cdrag(1:knon)
-
-! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/287.05*temp_air(1:knon))*9.80665)
-!    zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG)
-     zlev(1:knon) = plev(1:knon)*RD*temp_air(1:knon)/((ps(1:knon)*100.0)*RG)
-
-
-! PF et PASB
-!   where(cdrag > 0.01) 
-!     cdrag = 0.01
-!   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
-
-  
-    IF (debut) THEN
-       CALL Init_orchidee_index(knon,knindex,offset,ktindex)
-       CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
-       CALL Init_synchro_omp
-       
-       IF (knon > 0) THEN
-#ifdef CPP_VEGET
-         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
-#endif
-       ENDIF
-
-       
-       IF (knon > 0) THEN
-
-#ifdef CPP_VEGET
-          CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-               lrestart_read, lrestart_write, lalo, &
-               contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
-               cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-               precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
-               evap, fluxsens, fluxlat, coastalflow, riverflow, &
-               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
-               lon_scat, lat_scat, q2m, t2m, coszang=yrmu0)
-#endif         
-       ENDIF
-
-       CALL Synchro_omp
-
-       albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-    ENDIF
-
-    
-!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
-    swdown_vrai(1:knon) = swdown(1:knon)
-
-    IF (knon > 0) THEN
-#ifdef CPP_VEGET    
-
-       CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime,  &
-            lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-            cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-            precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
-            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
-            lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), coszang=yrmu0(1:knon))
-#endif       
-    ENDIF
-    z0h_new(:)=z0_new(:)
-
-    CALL Synchro_omp
-    
-    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
-
-!* Send to coupler
-!
-    IF (type_ocean=='couple') THEN
-       CALL cpl_send_land_fields(itime, knon, knindex, &
-            riverflow, coastalflow)
-    ENDIF
-
-    alb1_new(1:knon) = albedo_out(1:knon,1) 
-    alb2_new(1:knon) = albedo_out(1:knon,2)
-
-! Convention orchidee: positif vers le haut
-    fluxsens(1:knon) = -1. * fluxsens(1:knon)
-    fluxlat(1:knon)  = -1. * fluxlat(1:knon)
-    
-!  evap     = -1. * evap
-
-    IF (debut) lrestart_read = .FALSE.
-    
-    IF (debut) CALL Finalize_surf_para
-
-    
-  END SUBROUTINE surf_land_orchidee
-!
-!****************************************************************************************
-!
-  SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
-  USE mod_surf_para
-  USE mod_grid_phy_lmdz
-  
-    INTEGER,INTENT(IN)    :: knon
-    INTEGER,INTENT(IN)    :: knindex(klon)    
-    INTEGER,INTENT(OUT)   :: offset
-    INTEGER,INTENT(OUT)   :: ktindex(klon)
-    
-    INTEGER               :: ktindex_glo(knon_glo)
-    INTEGER               :: offset_para(0:omp_size*mpi_size-1)
-    INTEGER               :: LastPoint
-    INTEGER               :: task
-    
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo) 
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      LastPoint=0
-      DO Task=0,mpi_size*omp_size-1
-        IF (knon_glo_para(Task)>0) THEN
-           offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
-           LastPoint=ktindex_glo(knon_glo_end_para(task))
-        ENDIF
-      ENDDO
-    ENDIF
-    
-    CALL bcast(offset_para)
-    
-    offset=offset_para(omp_size*mpi_rank+omp_rank)
-    
-    ktindex(1:knon)=ktindex(1:knon)-offset
-
-  END SUBROUTINE Init_orchidee_index
-
-!
-!************************* ***************************************************************
-! 
-
-  SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
-  USE  mod_surf_para
-      
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-    INTEGER,INTENT(OUT) :: orch_comm
-    INTEGER,INTENT(OUT) :: orch_omp_size
-    INTEGER,INTENT(OUT) :: orch_omp_rank
-    INTEGER             :: color
-    INTEGER             :: i,ierr
-!
-! End definition
-!****************************************************************************************
-    
-    
-    IF (is_omp_root) THEN          
-      
-      IF (knon_mpi==0) THEN 
-         color = 0
-      ELSE 
-         color = 1
-      ENDIF
-    
-#ifdef CPP_MPI    
-      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
-    
-    ENDIF
-    CALL bcast_omp(orch_comm)
-    
-    IF (knon_mpi /= 0) THEN
-      orch_omp_size=0
-      DO i=0,omp_size-1
-        IF (knon_omp_para(i) /=0) THEN
-          orch_omp_size=orch_omp_size+1
-          IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
-        ENDIF
-      ENDDO
-    ENDIF
-   
-    
-  END SUBROUTINE Get_orchidee_communicator
-!
-!****************************************************************************************
-!  
-
-  SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
-    USE mod_grid_phy_lmdz
-    USE mod_surf_para    
-    USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    REAL, DIMENSION(klon), INTENT(IN)       :: pctsrf
-    
-! Output arguments
-!****************************************************************************************
-    INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
-
-! Local variables
-!****************************************************************************************
-    INTEGER                              :: i, igrid, jj, ij, iglob
-    INTEGER                              :: ierr, ireal, index
-    INTEGER, DIMENSION(8,3)              :: off_ini
-    INTEGER, DIMENSION(8)                :: offset  
-    INTEGER, DIMENSION(nbp_lon,nbp_lat)  :: correspond
-    INTEGER, DIMENSION(knon_glo)         :: ktindex_glo
-    INTEGER, DIMENSION(knon_glo,8)       :: neighbours_glo
-    REAL, DIMENSION(klon_glo)            :: pctsrf_glo
-    INTEGER                              :: ktindex(klon)
-!
-! End definition
-!****************************************************************************************
-
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
-    
-    CALL gather_surf(ktindex(1:knon),ktindex_glo)
-    CALL gather(pctsrf,pctsrf_glo)
-    
-    IF (is_mpi_root .AND. is_omp_root) THEN
-      neighbours_glo(:,:)=-1
-!  Initialisation des offset    
-!
-! offset bord ouest
-       off_ini(1,1) = - nbp_lon   ; off_ini(2,1) = - nbp_lon + 1     ; off_ini(3,1) = 1
-       off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon           ; off_ini(6,1) = 2 * nbp_lon - 1
-       off_ini(7,1) = nbp_lon -1  ; off_ini(8,1) = - 1 
-! offset point normal
-       off_ini(1,2) = - nbp_lon   ; off_ini(2,2) = - nbp_lon + 1     ; off_ini(3,2) = 1
-       off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon           ; off_ini(6,2) = nbp_lon - 1
-       off_ini(7,2) = -1          ; off_ini(8,2) = - nbp_lon - 1
-! offset bord   est
-       off_ini(1,3) = - nbp_lon   ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
-       off_ini(4,3) =  1          ; off_ini(5,3) = nbp_lon           ; off_ini(6,3) = nbp_lon - 1
-       off_ini(7,3) = -1          ; off_ini(8,3) = - nbp_lon - 1
-!
-!
-! Attention aux poles
-!
-       DO igrid = 1, knon_glo
-          index = ktindex_glo(igrid)
-          jj = INT((index - 1)/nbp_lon) + 1
-          ij = index - (jj - 1) * nbp_lon
-          correspond(ij,jj) = igrid
-       ENDDO
-!sonia : Les mailles des voisines doivent etre toutes egales (pour couplage orchidee)
-       IF (knon_glo == 1) THEN
-         igrid = 1
-         DO i = 1,8
-           neighbours_glo(igrid, i) = igrid
-         ENDDO
-       ELSE
-       print*,'sonia : knon_glo,ij,jj', knon_glo, ij,jj
-       
-       DO igrid = 1, knon_glo
-          iglob = ktindex_glo(igrid)
-          
-          IF (MOD(iglob, nbp_lon) == 1) THEN
-             offset = off_ini(:,1)
-          ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
-             offset = off_ini(:,3)
-          ELSE
-             offset = off_ini(:,2)
-          ENDIF
-          
-          DO i = 1, 8
-             index = iglob + offset(i)
-             ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
-             IF (pctsrf_glo(ireal) > EPSFRA) THEN
-                jj = INT((index - 1)/nbp_lon) + 1
-                ij = index - (jj - 1) * nbp_lon
-                neighbours_glo(igrid, i) = correspond(ij, jj)
-             ENDIF
-          ENDDO
-       ENDDO
-       ENDIF !fin knon_glo == 1
-
-    ENDIF
-    
-    DO i = 1, 8
-      CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
-    ENDDO
-  END SUBROUTINE Init_neighbours
-
-!
-!****************************************************************************************
-!
-#endif
-END MODULE surf_land_orchidee_noz0h_mod
+link ../phylmd/surf_land_orchidee_noz0h_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/surf_landice_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_landice_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_landice_mod.F90	(revision 3940)
@@ -19,5 +19,5 @@
        tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
        tsurf_new, dflux_s, dflux_l, &
-       slope, cloudf, &
+       alt, slope, cloudf, &
        snowhgt, qsnow, to_ice, sissnow, &
        alb3, runoff, &
@@ -30,6 +30,6 @@
 
     USE dimphy
-    USE surface_data,     ONLY : type_ocean, calice, calsno, ok_snow
-    USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
+    USE surface_data,     ONLY : type_ocean, calice, calsno, landice_opt, iflag_albcalc
+    USE fonte_neige_mod,  ONLY : fonte_neige,run_off_lic,fqcalving_global,ffonte_global,fqfonte_global,runofflic_global
     USE cpl_mod,          ONLY : cpl_send_landice_fields
     USE calcul_fluxs_mod
@@ -47,7 +47,9 @@
     USE ioipsl_getin_p_mod, ONLY : getin_p
 
-#ifdef CPP_SISVAT
-    USE surf_sisvat_mod,  ONLY : surf_sisvat
-#endif
+
+#ifdef CPP_INLANDSIS
+    USE surf_inlandsis_mod,  ONLY : surf_inlandsis
+#endif
+
     USE indice_sol_mod
 
@@ -88,4 +90,5 @@
     REAL, DIMENSION(klon), INTENT(IN)             :: albedo  !mean albedo
     REAL, DIMENSION(klon), INTENT(IN)             :: pphi1    
+    REAL, DIMENSION(klon), INTENT(IN)             :: alt   !mean altitude of the grid box  
     REAL, DIMENSION(klon), INTENT(IN)             :: slope   !mean slope in grid box  
     REAL, DIMENSION(klon), INTENT(IN)             :: cloudf  !total cloud fraction
@@ -108,6 +111,6 @@
 !    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
 !    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2  ! new albedo in near IR interval
-    REAL, DIMENSION(6), INTENT(IN)              ::SFRWL
-    REAL, DIMENSION(klon,nsw), INTENT(OUT)        ::alb_dir,alb_dif
+    REAL, DIMENSION(6), INTENT(IN)                :: SFRWL
+    REAL, DIMENSION(klon,nsw), INTENT(OUT)        :: alb_dir,alb_dif
 !albedo SB <<<
     REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
@@ -135,6 +138,7 @@
     REAL, DIMENSION(klon)    :: zfra, alb_neig
     REAL, DIMENSION(klon)    :: radsol
-    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay
-    INTEGER                  :: i,j
+    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay, ustar
+    INTEGER                  :: i,j,nt
+    REAL, DIMENSION(klon)    :: fqfonte,ffonte
 #ifdef ISO       
       real, parameter :: t_coup = 273.15
@@ -155,11 +159,14 @@
     REAL, DIMENSION(klon)    :: emis_new                  !Emissivity
     REAL, DIMENSION(klon)    :: swdown,lwdown
-    REAL, DIMENSION(klon)    :: precip_snow_adv, snow_adv !Snow Drift precip./advection
-    REAL, DIMENSION(klon)    :: bl_height, wind_velo      !height boundary layer, wind spd
+    REAL, DIMENSION(klon)    :: precip_snow_adv, snow_adv !Snow Drift precip./advection (not used in inlandsis)
+    REAL, DIMENSION(klon)    :: erod                      !erosion of surface snow (flux, kg/m2/s like evap)
+    REAL, DIMENSION(klon)    :: zsl_height, wind_velo     !surface layer height, wind spd
     REAL, DIMENSION(klon)    :: dens_air,  snow_cont_air  !air density; snow content air
     REAL, DIMENSION(klon)    :: alb_soil                  !albedo of underlying ice
     REAL, DIMENSION(klon)    :: pexner                    !Exner potential
     REAL                     :: pref
-    REAL, DIMENSION(klon,nsoilmx) :: tsoil0 !modfi
+    REAL, DIMENSION(klon,nsoilmx) :: tsoil0               !modif
+    REAL                          :: dtis                ! subtimestep
+    LOGICAL                       :: debut_is, lafin_is  ! debut and lafin for inlandsis
 
     CHARACTER (len = 20)                      :: modname = 'surf_landice'
@@ -167,8 +174,6 @@
 
 
-!albedo SB >>>
-    real,dimension(klon) :: alb1,alb2
-!albedo SB <<<
-
+    REAL,DIMENSION(klon) :: alb1,alb2
+    REAL, DIMENSION (klon,6) :: alb6
 ! End definition
 !****************************************************************************************
@@ -181,7 +186,8 @@
   LOGICAL, SAVE :: firstcall = .TRUE.
   !$OMP THREADPRIVATE(firstcall)
-!FC
-
-
+
+
+!FC firtscall initializations
+!******************************************************************************************
 #ifdef ISO
 #ifdef ISOVERIF
@@ -203,6 +209,10 @@
   CALL getin_p('alb_nir_sno_lic',alb_nir_sno_lic)
            PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic
+  
+!  z0m=1.e-3
+!  z0h = z0m
   firstcall=.false.
   ENDIF
+!******************************************************************************************
 !
 ! Initialize output variables
@@ -220,78 +230,99 @@
 
 !****************************************************************************************
-!   ok_snow = TRUE  : prepare and call SISVAT snow model
-!   ok_snow = FALSE : soil_model, calcul_flux, fonte_neige, ... 
-!
-!****************************************************************************************
-    IF (ok_snow) THEN
-#ifdef CPP_SISVAT
-       ! Prepare for calling SISVAT
+!  landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ...  
+!  landice_opt = 1  : prepare and call INterace Lmdz SISvat (INLANDSIS)
+!****************************************************************************************
+
+
+    IF (landice_opt .EQ. 1) THEN
+
+!****************************************************************************************    
+! CALL to INLANDSIS interface
+!****************************************************************************************
+#ifdef CPP_INLANDSIS
+
+#ifdef ISO
+        CALL abort_gcm('surf_landice 235','isotopes pas dans INLANDSIS',1)
+#endif
+
+        debut_is=debut
+        lafin_is=.false.
+        ! Suppose zero surface speed
+        u0(:)            = 0.0
+        v0(:)            = 0.0
+
+
+        CALL calcul_flux_wind(knon, dtime, &
+         u0, v0, u1, v1, gustiness, cdragm, &
+         AcoefU, AcoefV, BcoefU, BcoefV, &
+         p1lay, temp_air, &
+         flux_u1, flux_v1)
+
        
-       ! Calculate incoming flux for SW and LW interval: swdown, lwdown
+       ! Set constants and compute some input for SISVAT
+       ! = 1000 hPa
+       ! and calculate incoming flux for SW and LW interval: swdown, lwdown
        swdown(:)        = 0.0
        lwdown(:)        = 0.0
+       snow_cont_air(:) = 0.  ! the snow content in air is not a prognostic variable of the model      
+       alb_soil(:)      = 0.4 ! before albedo(:) but here it is the ice albedo that we have to set
+       ustar(:)         = 0.
+       pref             = 100000.       
        DO i = 1, knon
           swdown(i)        = swnet(i)/(1-albedo(i))
           lwdown(i)        = lwdownm(i)
-       END DO
-       
-       ! Set constants and compute some input for SISVAT
-       snow_adv(:)      = 0.                          ! no snow blown in for now
-       snow_cont_air(:) = 0.       
-       alb_soil(:)      = albedo(:)
-       pref             = 100000.                     ! = 1000 hPa
-       DO i = 1, knon
           wind_velo(i)     = u1(i)**2 + v1(i)**2
           wind_velo(i)     = wind_velo(i)**0.5
           pexner(i)        = (p1lay(i)/pref)**(RD/RCPD)
           dens_air(i)      = p1lay(i)/RD/temp_air(i)  ! dry air density
-          bl_height(i)     = pphi1(i)/RG              
+          zsl_height(i)    = pphi1(i)/RG      
+          tsoil0(i,:)      = tsoil(i,:)  
+          ustar(i)= (cdragm(i)*(wind_velo(i)**2))**0.5   
        END DO
-
-!****************************************************************************************
-! CALL to SISVAT interface
-!
-!****************************************************************************************
-       ! config: compute everything with SV but temperatures afterwards with soil/calculfluxs
-       DO i = 1, knon
-          tsoil0(i,:)=tsoil(i,:)
-       END DO
-           ! Martin
-           PRINT*, 'on appelle surf_sisvat'
-           ! Martin
-       CALL surf_sisvat(knon, rlon, rlat, knindex, itime, dtime, debut, lafin, &
-            rmu0, swdown, lwdown, pexner, ps, p1lay, &
-            precip_rain, precip_snow, precip_snow_adv, snow_adv, &
-            bl_height, wind_velo, temp_air, dens_air, spechum, tsurf, &
-            rugoro, snow_cont_air, alb_soil, slope, cloudf, &
-            radsol, qsol, tsoil0, snow, snowhgt, qsnow, to_ice,sissnow, agesno, &
-            AcoefH, AcoefQ, BcoefH, BcoefQ, cdragh, &
-            run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &        
-            tsurf_new, alb1, alb2, alb3, &
-            emis_new, z0m, qsurf)
-       z0h(1:knon)=z0m(1:knon) ! en attendant mieux
        
-       ! Suppose zero surface speed
-       u0(:)            = 0.0
-       v0(:)            = 0.0
-       ! The calculation of heat/water fluxes, otherwise done by "CALL calcul_fluxs" is 
-       ! integrated in SISVAT, using the same method. It can be found in "sisvat.f", in the
-       ! subroutine "SISVAT_TS2". 
-       ! u0, v0=0., dif_grnd=0. and beta=1 are assumed there! 
-       
-       CALL calcul_flux_wind(knon, dtime, &
-            u0, v0, u1, v1, gustiness, cdragm, &
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-            p1lay, temp_air, &
-            flux_u1, flux_v1)
+
+
+        dtis=dtime
+
+          IF (lafin) THEN
+            lafin_is=.true.
+          END IF
+
+          CALL surf_inlandsis(knon, rlon, rlat, knindex, itime, dtis, debut_is, lafin_is,&
+            rmu0, swdown, lwdown, albedo, pexner, ps, p1lay, precip_rain, precip_snow,   &
+            zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf,&
+            rugoro, snow_cont_air, alb_soil, alt, slope, cloudf, &
+            radsol, qsol, tsoil0, snow, zfra, snowhgt, qsnow, to_ice, sissnow,agesno,   &
+            AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
+            run_off_lic, fqfonte, ffonte, evap, erod, fluxsens, fluxlat,dflux_s, dflux_l, &
+            tsurf_new, alb1, alb2, alb3, alb6, &
+            emis_new, z0m, z0h, qsurf)
+
+          debut_is=.false.
+
+
+        ! Treatment of snow melting and calving
+
+        ! for consistency with standard LMDZ, add calving to run_off_lic
+        run_off_lic(:)=run_off_lic(:) + to_ice(:)
+
+        DO i = 1, knon
+           ffonte_global(knindex(i),is_lic)    = ffonte(i)
+           fqfonte_global(knindex(i),is_lic)   = fqfonte(i)! net melting= melting - refreezing
+           fqcalving_global(knindex(i),is_lic) = to_ice(i) ! flux
+           runofflic_global(knindex(i)) = run_off_lic(i)
+        ENDDO
+        ! Here, we assume that the calving term is equal to the to_ice term
+        ! (no ice accumulation)
+
+
 #else
-       abort_message='Pb de coherence: ok_snow = .true. mais CPP_SISVAT = .false.'
+       abort_message='Pb de coherence: landice_opt = 1  mais CPP_INLANDSIS = .false.'
        CALL abort_physic(modname,abort_message,1)
 #endif
-#ifdef ISO
-       abort_message='surf_landice 267: isotopes pas prevus ici'
-       CALL abort_physic(modname,abort_message,1) 
-#endif
-    ELSE ! ok_snow=FALSE
+
+
+
+    ELSE 
 
 !****************************************************************************************
@@ -299,4 +330,10 @@
 ! 
 !****************************************************************************************
+
+    ! EV: use calbeta
+    CALL calbeta(dtime, is_lic, knon, snow, qsol, beta, cal, dif_grnd)
+
+
+    ! use soil model and recalculate properly cal
     IF (soil_model) THEN 
        CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
@@ -313,6 +350,6 @@
 !
 !****************************************************************************************
-    beta(:) = 1.0
-    dif_grnd(:) = 0.0
+!    beta(:) = 1.0
+!    dif_grnd(:) = 0.0
 
 ! Suppose zero surface speed
@@ -367,5 +404,5 @@
 !    
 !****************************************************************************************
-    CALL fonte_neige( knon, is_lic, knindex, dtime, &
+    CALL fonte_neige(knon, is_lic, knindex, dtime, &
          tsurf, precip_rain, precip_snow, &
          snow, qsol, tsurf_new, evap &
@@ -408,4 +445,5 @@
 !****************************************************************************************
     CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
+
     WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
     zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
@@ -420,5 +458,5 @@
 !IM: KstaTER0.77 & LMD_ARMIP6    
 
-! Attantion: alb1 and alb2 are the same!
+! Attantion: alb1 and alb2 are not the same!
     alb1(1:knon)  = alb_vis_sno_lic
     alb2(1:knon)  = alb_nir_sno_lic
@@ -433,10 +471,12 @@
     z0m = SQRT(z0m**2+rugoro**2)
 
-    END IF ! ok_snow
+
+
+    END IF ! landice_opt
 
 
 !****************************************************************************************
 ! Send run-off on land-ice to coupler if coupled ocean.
-! run_off_lic has been calculated in fonte_neige or surf_sisvat
+! run_off_lic has been calculated in fonte_neige or surf_inlandsis
 !
 !****************************************************************************************
@@ -450,12 +490,13 @@
   
 !****************************************************************************************
-       snow_o=0.
-       zfra_o = 0.
-       DO j = 1, knon
-           i = knindex(j)
-           snow_o(i) = snow(j) 
-           zfra_o(i) = zfra(j)
-       ENDDO
-
+! Etienne: comment these lines because of duplication just below
+!       snow_o=0.
+!       zfra_o = 0.
+!       DO j = 1, knon
+!           i = knindex(j)
+!           snow_o(i) = snow(j) 
+!           zfra_o(i) = zfra(j)
+!       ENDDO
+!
 !****************************************************************************************
        snow_o=0.
@@ -485,10 +526,20 @@
        alb_dir(1:knon,5)=alb2(1:knon)
        alb_dir(1:knon,6)=alb2(1:knon)
+
+       IF ((landice_opt .EQ. 1) .AND. (iflag_albcalc .EQ. 2)) THEN
+       alb_dir(1:knon,1)=alb6(1:knon,1)
+       alb_dir(1:knon,2)=alb6(1:knon,2)
+       alb_dir(1:knon,3)=alb6(1:knon,3)
+       alb_dir(1:knon,4)=alb6(1:knon,4)
+       alb_dir(1:knon,5)=alb6(1:knon,5)
+       alb_dir(1:knon,6)=alb6(1:knon,6)
+       ENDIF
+
      end select
 alb_dif=alb_dir
 !albedo SB <<<
 
-
-
+  
+  
 
   END SUBROUTINE surf_landice
Index: LMDZ6/trunk/libf/phylmdiso/surf_ocean_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_ocean_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_ocean_mod.F90	(revision 3940)
@@ -20,5 +20,6 @@
        z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
        tsurf_new, dflux_s, dflux_l, lmt_bils, &
-       flux_u1, flux_v1 &
+       flux_u1, flux_v1, delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, tkt, tks, &
+       taur, sss &
 #ifdef ISO
         &       ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
@@ -28,4 +29,5 @@
 
     use albedo, only: alboc, alboc_cd
+    use bulk_flux_m, only: bulk_flux
     USE dimphy, ONLY: klon, zmasq
     USE surface_data, ONLY     : type_ocean
@@ -42,4 +44,5 @@
 #endif
     USE limit_read_mod
+    use config_ocean_skin_m, only: activate_ocean_skin
     !
     ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, 
@@ -62,8 +65,8 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface  
     REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
+    REAL, DIMENSION(klon), INTENT(IN)        :: windsp ! wind at 10 m, in m s-1
     REAL, DIMENSION(klon), INTENT(IN)        :: rmu0  
     REAL, DIMENSION(klon), INTENT(IN)        :: fder
-    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
+    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in     ! defined only for subscripts 1:knon
     REAL, DIMENSION(klon), INTENT(IN)        :: p1lay,z1lay ! pression (Pa) et altitude (m) du premier niveau
     REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
@@ -87,24 +90,66 @@
     REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
     REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
+    REAL, DIMENSION(klon), INTENT(inOUT)     :: z0h
 #ifdef ISO
     REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsnow 
     REAL, DIMENSION(niso,klon), INTENT(INOUT)        :: Roce  
 #endif
-    REAL, DIMENSION(klon), INTENT(inOUT):: z0h
+
+    REAL, intent(inout):: delta_sst(:) ! (knon)
+    ! Ocean-air interface temperature minus bulk SST, in K. Defined
+    ! only if activate_ocean_skin >= 1.
+
+    real, intent(inout):: delta_sal(:) ! (knon)
+    ! Ocean-air interface salinity minus bulk salinity, in ppt. Defined
+    ! only if activate_ocean_skin >= 1.
+
+    REAL, intent(inout):: ds_ns(:) ! (knon)
+    ! "delta salinity near surface". Salinity variation in the
+    ! near-surface turbulent layer. That is subskin salinity minus
+    ! foundation salinity. In ppt.
+
+    REAL, intent(inout):: dt_ns(:) ! (knon)
+    ! "delta temperature near surface". Temperature variation in the
+    ! near-surface turbulent layer. That is subskin temperature
+    ! minus foundation temperature. (Can be negative.) In K.
 
     ! Output variables
-    !******************************************************************************
+    !**************************************************************************
     REAL, DIMENSION(klon), INTENT(OUT)       :: z0m
     !albedo SB >>>
-    !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
-    !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
-    REAL, DIMENSION(6), INTENT(IN)          :: SFRWL 
-    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
+    !    REAL, DIMENSION(klon), INTENT(OUT)  :: alb1_new  ! new albedo in visible SW interval
+    !    REAL, DIMENSION(klon), INTENT(OUT)  :: alb2_new  ! new albedo in near IR interval
+    REAL, DIMENSION(6), INTENT(IN)           :: SFRWL 
+    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
     !albedo SB <<<     
     REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
+    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new    ! sea surface temperature, in K
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
     REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
     REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
+
+    REAL, intent(out):: dter(:) ! (knon)
+    ! Temperature variation in the diffusive microlayer, that is
+    ! ocean-air interface temperature minus subskin temperature. In
+    ! K.
+
+    REAL, intent(out):: dser(:) ! (knon)
+    ! Salinity variation in the diffusive microlayer, that is
+    ! ocean-air interface salinity minus subskin salinity. In ppt.
+
+    REAL, intent(out):: tkt(:) ! (knon)
+    ! épaisseur (m) de la couche de diffusion thermique (microlayer)
+    ! cool skin thickness
+
+    REAL, intent(out):: tks(:) ! (knon)
+    ! épaisseur (m) de la couche de diffusion de masse (microlayer)
+
+    REAL, intent(out):: taur(:) ! (knon)
+    ! momentum flux due to rain, in Pa
+
+    real, intent(out):: sss(:) ! (klon)
+    ! Bulk salinity of the surface layer of the ocean, in ppt. (Only
+    ! defined for subscripts 1:knon, but we have to declare it with
+    ! size klon because of the coupling machinery.)
 #ifdef ISO
     REAL, DIMENSION(ntraciso,klon), INTENT(out)        :: xtevap ! isotopes in surface evaporation flux 
@@ -113,5 +158,5 @@
 
     ! Local variables
-    !******************************************************************************
+    !*************************************************************************
     INTEGER               :: i, k
     REAL                  :: tmp
@@ -121,6 +166,10 @@
     REAL, DIMENSION(klon) :: cdragq ! Cdrag pour l'evaporation
     CHARACTER(len=20),PARAMETER :: modname="surf_ocean"
-
-    ! End definition
+    real rhoa(knon) ! density of moist air  (kg / m3)
+    REAL sens_prec_liq(knon)
+
+    REAL t_int(knon) ! ocean-air interface temperature, in K
+    real s_int(knon) ! ocean-air interface salinity, in ppt
+
     !******************************************************************************
 
@@ -165,4 +214,6 @@
 
 
+    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
+
     !******************************************************************************
     ! Switch according to type of ocean (couple, slab or forced)
@@ -177,8 +228,9 @@
             AcoefH, AcoefQ, BcoefH, BcoefQ, &
             AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, &
+            ps, u1, v1, gustiness, tsurf_in, &
             radsol, snow, agesno, &
             qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l)
+            tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
+            delta_sst)
 
     CASE('slab')
@@ -200,8 +252,8 @@
             AcoefH, AcoefQ, BcoefH, BcoefQ, &
             AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, &
+            ps, u1, v1, gustiness, tsurf_in, &
             radsol, snow, agesno, &
             qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l &
+            tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
 #ifdef ISO
             ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
@@ -311,8 +363,22 @@
        CALL abort_physic(modname,'version non prevue',1)
     ENDIF
-    !
-    !******************************************************************************
+
+    if (activate_ocean_skin >= 1) then
+       if (type_ocean /= 'couple') sss(:knon) = 35.
+       call bulk_flux(tkt, tks, taur, dter, dser, t_int, s_int, ds_ns, dt_ns, &
+            u = windsp(:knon), t_ocean_1 = tsurf_new(:knon), s1 = sss(:knon), &
+            rain = precip_rain(:knon) + precip_snow(:knon), &
+            hf = - fluxsens(:knon), hlb = - fluxlat(:knon), &
+            rnl = - lwnet(:knon), &
+            tau = sqrt(flux_u1(:knon)**2 + flux_v1(:knon)**2), rhoa = rhoa, &
+            xlv = [(rlvtt, i = 1, knon)], rf = - sens_prec_liq, dtime = dtime, &
+            rns = swnet(:knon))
+       delta_sst = t_int - tsurf_new(:knon)
+       delta_sal = s_int - sss(:knon)
+       if (activate_ocean_skin >= 2) tsurf_new(:knon) = t_int
+    end if
+
   END SUBROUTINE surf_ocean
-  !******************************************************************************
+  !****************************************************************************
   !
 END MODULE surf_ocean_mod
Index: LMDZ6/trunk/libf/phylmdiso/surf_seaice_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surf_seaice_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surf_seaice_mod.F90	(revision 3940)
@@ -45,4 +45,7 @@
     INCLUDE "dimsoil.h"
     INCLUDE "clesphys.h"
+
+    INCLUDE "YOMCST.h"
+    ! for rd and retv
 
 ! Input arguments
@@ -113,5 +116,7 @@
     REAL, DIMENSION(klon) :: alb1_new,alb2_new
 !albedo SB <<<
-!
+
+    real rhoa(knon) ! density of moist air  (kg / m3)
+
 ! End definitions
 !****************************************************************************************
@@ -124,4 +129,6 @@
     radsol(:) = 0.0
     radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
 
 !****************************************************************************************
@@ -142,5 +149,5 @@
             radsol, snow, qsurf, &
             alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l)
+            tsurf_new, dflux_s, dflux_l, rhoa)
        
     ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
@@ -164,5 +171,5 @@
             radsol, snow, qsol, agesno, tsoil, &
             qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l &
+            tsurf_new, dflux_s, dflux_l, rhoa &
 #ifdef ISO
             ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
Index: LMDZ6/trunk/libf/phylmdiso/surface_data.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/surface_data.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/surface_data.F90	(revision 3940)
@@ -1,32 +1,1 @@
-!
-! $Id: surface_data.F90 3327 2018-05-16 13:58:59Z musat $
-!
-MODULE surface_data
-
-  IMPLICIT NONE
-
-  REAL, PARAMETER        :: calice=1.0/(5.1444e+06*0.15)
-  REAL, PARAMETER        :: calsno=1./(2.3867e+06*.15)
-  
-  LOGICAL, SAVE          :: ok_veget      ! true for use of vegetation model ORCHIDEE
-  !$OMP THREADPRIVATE(ok_veget)
-
-  CHARACTER(len=10), SAVE :: type_veget   ! orchidee/y/bucket/n/betaclim
-  !$OMP THREADPRIVATE(type_veget)
-
-  LOGICAL, SAVE          :: ok_snow       ! true for coupling to snow model SISVAT
-  !$OMP THREADPRIVATE(ok_snow)
-
-  CHARACTER(len=6), SAVE :: type_ocean    ! force/slab/couple
-  !$OMP THREADPRIVATE(type_ocean)
-
-  ! if type_ocean=couple : version_ocean=opa8 ou nemo
-  ! if type_ocean=slab   : version_ocean=sicOBS or sicINT or sicNO
-  CHARACTER(len=6), SAVE :: version_ocean 
-  !$OMP THREADPRIVATE(version_ocean)
-
-  ! Pas de temps couplage atm/oce (en secondes)
-  REAL, SAVE             :: t_coupl
-  !$OMP THREADPRIVATE(t_coupl)
-
-END MODULE surface_data
+link ../phylmd/surface_data.F90
Index: LMDZ6/trunk/libf/phylmdiso/sw_aeroAR4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/sw_aeroAR4.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/sw_aeroAR4.F90	(revision 3940)
@@ -1,641 +1,1 @@
-!
-! $Id$
-!
-SUBROUTINE SW_AEROAR4(PSCT, PRMU0, PFRAC, &
-     PPMB, PDP, &
-     PPSOL, PALBD, PALBP,&
-     PTAVE, PWV, PQS, POZON, PAER,&
-     PCLDSW, PTAU, POMEGA, PCG,&
-     PHEAT, PHEAT0,&
-     PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,&
-     ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
-     tauaero, pizaero, cgaero,&
-     PTAUA, POMEGAA,&
-     PTOPSWADAERO,PSOLSWADAERO,&
-     PTOPSWAD0AERO,PSOLSWAD0AERO,&
-     PTOPSWAIAERO,PSOLSWAIAERO,&
-     PTOPSWAERO,PTOPSW0AERO,&
-     PSOLSWAERO,PSOLSW0AERO,&
-     PTOPSWCFAERO,PSOLSWCFAERO,&
-     ok_ade, ok_aie, flag_aerosol, flag_aerosol_strat )
-
-  USE dimphy
-  USE phys_output_mod, ONLY : swaero_diag
-  USE print_control_mod, ONLY: lunout
-  USE aero_mod, ONLY : naero_grp
-  IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "clesphys.h"
-  !
-  !     ------------------------------------------------------------------
-  !
-  !     PURPOSE.
-  !     --------
-  !
-  !          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
-  !     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
-  !
-  !     METHOD.
-  !     -------
-  !
-  !          1. COMPUTES ABSORBER AMOUNTS                 (SWU)
-  !          2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL  (SW1S)
-  !          3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL  (SW2S)
-  !
-  !     REFERENCE.
-  !     ----------
-  !
-  !        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-  !        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-  !
-  !     AUTHOR.
-  !     -------
-  !        JEAN-JACQUES MORCRETTE  *ECMWF*
-  !
-  !     MODIFICATIONS.
-  !     --------------
-  !        ORIGINAL : 89-07-14
-  !        1995-01-01  J.-J. MORCRETTE  Direct/Diffuse Albedo
-  !        2003-11-27  J. QUAAS Introduce aerosol forcings (based on BOUCHER)
-  !        2009-04     A. COZIC - C.DEANDREIS Indroduce NAT/BC/POM/DUST/SS aerosol forcing
-  !        2012-09     O. BOUCHER - reorganise aerosol cases with ok_ade, ok_aie, flag_aerosol
-  !     ------------------------------------------------------------------
-  !
-  !* ARGUMENTS:
-  !
-  REAL(KIND=8) PSCT  ! constante solaire (valeur conseillee: 1370)
-
-  REAL(KIND=8) PPSOL(KDLON)        ! SURFACE PRESSURE (PA)
-  REAL(KIND=8) PDP(KDLON,KFLEV)    ! LAYER THICKNESS (PA)
-  REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
-
-  REAL(KIND=8) PRMU0(KDLON)  ! COSINE OF ZENITHAL ANGLE
-  REAL(KIND=8) PFRAC(KDLON)  ! fraction de la journee
-
-  REAL(KIND=8) PTAVE(KDLON,KFLEV)  ! LAYER TEMPERATURE (K)
-  REAL(KIND=8) PWV(KDLON,KFLEV)    ! SPECIFI! HUMIDITY (KG/KG)
-  REAL(KIND=8) PQS(KDLON,KFLEV)    ! SATURATED WATER VAPOUR (KG/KG)
-  REAL(KIND=8) POZON(KDLON,KFLEV)  ! OZONE CONCENTRATION (KG/KG)
-  REAL(KIND=8) PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
-
-  REAL(KIND=8) PALBD(KDLON,2)  ! albedo du sol (lumiere diffuse)
-  REAL(KIND=8) PALBP(KDLON,2)  ! albedo du sol (lumiere parallele)
-
-  REAL(KIND=8) PCLDSW(KDLON,KFLEV)    ! CLOUD FRACTION
-  REAL(KIND=8) PTAU(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)
-  REAL(KIND=8) PCG(KDLON,2,KFLEV)     ! ASYMETRY FACTOR
-  REAL(KIND=8) POMEGA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
-
-  REAL(KIND=8) PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
-  REAL(KIND=8) PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
-  REAL(KIND=8) PALBPLA(KDLON)     ! PLANETARY ALBEDO
-  REAL(KIND=8) PTOPSW(KDLON)      ! SHORTWAVE FLUX AT T.O.A.
-  REAL(KIND=8) PSOLSW(KDLON)      ! SHORTWAVE FLUX AT SURFACE
-  REAL(KIND=8) PTOPSW0(KDLON)     ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
-  REAL(KIND=8) PSOLSW0(KDLON)     ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
-  !
-  !* LOCAL VARIABLES:
-  !
-  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
-
-  REAL(KIND=8) ZOZ(KDLON,KFLEV)
-  ! column-density of ozone in layer, in kilo-Dobsons
-
-  REAL(KIND=8) ZAKI(KDLON,2)     
-  REAL(KIND=8) ZCLD(KDLON,KFLEV)
-  REAL(KIND=8) ZCLEAR(KDLON) 
-  REAL(KIND=8) ZDSIG(KDLON,KFLEV)
-  REAL(KIND=8) ZFACT(KDLON)
-  REAL(KIND=8) ZFD(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFDOWN(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFU(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFUP(KDLON,KFLEV+1)
-  REAL(KIND=8) ZRMU(KDLON)
-  REAL(KIND=8) ZSEC(KDLON)
-  REAL(KIND=8) ZUD(KDLON,5,KFLEV+1)
-  REAL(KIND=8) ZCLDSW0(KDLON,KFLEV)
-
-  REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
-  REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
-
-  INTEGER inu, jl, jk, i, k, kpl1
-
-  INTEGER swpas  ! Every swpas steps, sw is calculated
-  PARAMETER(swpas=1)
-
-  INTEGER, SAVE :: itapsw = 0
-  !$OMP THREADPRIVATE(itapsw)
-  LOGICAL, SAVE :: appel1er = .TRUE.
-  !$OMP THREADPRIVATE(appel1er)
-  LOGICAL, SAVE :: initialized = .FALSE.
-  !$OMP THREADPRIVATE(initialized)
-
-  !jq-local flag introduced for aerosol forcings
-  REAL(KIND=8), SAVE :: flag_aer
-  !$OMP THREADPRIVATE(flag_aer)
-
-  LOGICAL ok_ade, ok_aie    ! use aerosol forcings or not?
-  INTEGER flag_aerosol_strat ! use stratospehric aerosols
-  INTEGER flag_aerosol      ! global flag for aerosol 0 (no aerosol) or 1-5 (aerosols)
-  REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2)  ! aerosol optical properties
-  REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2)  ! (see aeropt.F)
-  REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2)   ! -"-
-  REAL(KIND=8) PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (present-day value)
-  REAL(KIND=8) POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
-  REAL(KIND=8) PTOPSWADAERO(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
-  REAL(KIND=8) PSOLSWADAERO(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
-  REAL(KIND=8) PTOPSWAD0AERO(KDLON)    ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
-  REAL(KIND=8) PSOLSWAD0AERO(KDLON)    ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
-  REAL(KIND=8) PTOPSWAIAERO(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
-  REAL(KIND=8) PSOLSWAIAERO(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
-  REAL(KIND=8) PTOPSWAERO(KDLON,9)     ! SW TOA AS DRF nat & ant 
-  REAL(KIND=8) PTOPSW0AERO(KDLON,9)    ! SW SRF AS DRF nat & ant 
-  REAL(KIND=8) PSOLSWAERO(KDLON,9)     ! SW TOA CS DRF nat & ant
-  REAL(KIND=8) PSOLSW0AERO(KDLON,9)    ! SW SRF CS DRF nat & ant
-  REAL(KIND=8) PTOPSWCFAERO(KDLON,3)   !  SW TOA AS cloudRF nat & ant 
-  REAL(KIND=8) PSOLSWCFAERO(KDLON,3)   !  SW SRF AS cloudRF nat & ant 
-
-  !jq - Fluxes including aerosol effects
-  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
-  !$OMP THREADPRIVATE(ZFSUPAD_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
-  !$OMP THREADPRIVATE(ZFSDNAD_AERO)
-  !jq - Fluxes including aerosol effects
-  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
-  !$OMP THREADPRIVATE(ZFSUPAD0_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
-  !$OMP THREADPRIVATE(ZFSDNAD0_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
-  !$OMP THREADPRIVATE(ZFSUPAI_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
-  !$OMP THREADPRIVATE(ZFSDNAI_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE ::  ZFSUP_AERO(:,:,:)
-  !$OMP THREADPRIVATE(ZFSUP_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE ::  ZFSDN_AERO(:,:,:)
-  !$OMP THREADPRIVATE(ZFSDN_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE ::  ZFSUP0_AERO(:,:,:)
-  !$OMP THREADPRIVATE(ZFSUP0_AERO)
-  REAL(KIND=8),ALLOCATABLE,SAVE ::  ZFSDN0_AERO(:,:,:)
-  !$OMP THREADPRIVATE(ZFSDN0_AERO)
-
-! Key to define the aerosol effect acting on climate
-! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
-! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
-! FALSE: fluxes use no aerosols (case 1)
-
-  LOGICAL,SAVE :: AEROSOLFEEDBACK_ACTIVE = .TRUE.
-!$OMP THREADPRIVATE(AEROSOLFEEDBACK_ACTIVE)  
-
-      CHARACTER (LEN=20) :: modname='sw_aeroAR4'
-      CHARACTER (LEN=80) :: abort_message
-
-  IF(.NOT.initialized) THEN
-     flag_aer=0.
-     initialized=.TRUE.
-     ALLOCATE(ZFSUPAD_AERO(KDLON,KFLEV+1))
-     ALLOCATE(ZFSDNAD_AERO(KDLON,KFLEV+1))
-     ALLOCATE(ZFSUPAD0_AERO(KDLON,KFLEV+1))
-     ALLOCATE(ZFSDNAD0_AERO(KDLON,KFLEV+1))
-     ALLOCATE(ZFSUPAI_AERO(KDLON,KFLEV+1))
-     ALLOCATE(ZFSDNAI_AERO(KDLON,KFLEV+1))
-!-OB decrease size of these arrays to what is needed
-!                | direct effect 
-!ind effect      | no aerosol   natural  total
-!natural (PTAU)  |   1            3       2     --ZFSUP/ZFSDN
-!total (PTAUA)   |                5       4     --ZFSUP/ZFSDN
-!no cloud        |   1            3       2     --ZFSUP0/ZFSDN0
-! so we need which case when ? 
-! ok_ade and ok_aie = 4-5, 4-2 and 2 
-! ok_ade and not ok_aie = 2-3 and 2 
-! not ok_ade and ok_aie = 5-3 and 5 
-! not ok_ade and not ok_aie = 3 
-! therefore the cases have the folliwng switches 
-! 3 = not ok_ade or not ok_aie 
-! 4 = ok_ade and ok_aie 
-! 2 = ok_ade 
-! 5 = ok_aie 
-     ALLOCATE(ZFSUP_AERO (KDLON,KFLEV+1,5))
-     ALLOCATE(ZFSDN_AERO (KDLON,KFLEV+1,5))
-     ALLOCATE(ZFSUP0_AERO(KDLON,KFLEV+1,3))
-     ALLOCATE(ZFSDN0_AERO(KDLON,KFLEV+1,3))
-! end OB modif
-     ZFSUPAD_AERO(:,:)=0.
-     ZFSDNAD_AERO(:,:)=0.
-     ZFSUPAD0_AERO(:,:)=0.
-     ZFSDNAD0_AERO(:,:)=0.
-     ZFSUPAI_AERO(:,:)=0.
-     ZFSDNAI_AERO(:,:)=0.
-     ZFSUP_AERO (:,:,:)=0.
-     ZFSDN_AERO (:,:,:)=0.
-     ZFSUP0_AERO(:,:,:)=0.
-     ZFSDN0_AERO(:,:,:)=0.
-  ENDIF
-
-  IF (appel1er) THEN
-     WRITE(lunout,*)'SW calling frequency : ', swpas
-     WRITE(lunout,*) "   In general, it should be 1"
-     appel1er = .FALSE.
-  ENDIF
-  !     ------------------------------------------------------------------
-  IF (MOD(itapsw,swpas).EQ.0) THEN
-
-     DO JK = 1 , KFLEV
-        DO JL = 1, KDLON
-           ZCLDSW0(JL,JK) = 0.0
-           ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG &
-                *PDP(JL,JK)*(101325.0/PPSOL(JL))
-        ENDDO
-     ENDDO
-
-! clear sky with no aerosols at all is computed IF ACTIVEFEEDBACK_ACTIVE is false or for extended diag
-     IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN    
-
-     ! clear-sky: zero aerosol effect
-     flag_aer=0.0
-     CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
-          PRMU0,PFRAC,PTAVE,PWV,&
-          ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-     INU = 1
-     CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
-          tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
-          PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
-          ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-          ZFD, ZFU)
-     INU = 2
-     CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
-          tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
-          ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
-          ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-          PWV, PQS,&
-          ZFDOWN, ZFUP)
-     DO JK = 1 , KFLEV+1
-        DO JL = 1, KDLON
-           ZFSUP0_AERO(JL,JK,1) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-           ZFSDN0_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
-        ENDDO
-     ENDDO
-     ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
-
-! cloudy sky with no aerosols at all is either computed IF no indirect effect is asked for, or for extended diag
-     IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN    
-     ! cloudy-sky: zero aerosol effect
-     flag_aer=0.0
-     CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
-          PRMU0,PFRAC,PTAVE,PWV,&
-          ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-     INU = 1
-     CALL SW1S_LMDAR4(INU, PAER, flag_aer, &
-          tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
-          PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-          ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-          ZFD, ZFU)
-     INU = 2
-     CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
-          tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
-          ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-          ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-          PWV, PQS,&
-          ZFDOWN, ZFUP)
-
-     DO JK = 1 , KFLEV+1
-        DO JL = 1, KDLON
-           ZFSUP_AERO(JL,JK,1) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-           ZFSDN_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
-        ENDDO
-     ENDDO
-     ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
-
-     IF (flag_aerosol.GT.0 .OR. flag_aerosol_strat.GT.0) THEN
-
-     IF (ok_ade.and.swaero_diag .or. .not. ok_ade) THEN
-
-        ! clear sky direct effect natural aerosol
-        ! CAS AER (3)
-        flag_aer=1.0
-        CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
-             PRMU0,PFRAC,PTAVE,PWV,&
-             ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-        INU = 1
-        CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
-             PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             ZFD, ZFU)
-        INU = 2
-        CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
-             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             PWV, PQS,&
-             ZFDOWN, ZFUP)
-
-        DO JK = 1 , KFLEV+1
-           DO JL = 1, KDLON
-              ZFSUP0_AERO(JL,JK,3) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-              ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
-           ENDDO
-        ENDDO
-     ENDIF !--end not swaero_diag or not ok_ade
-
-     IF (ok_ade) THEN
-
-        ! clear sky direct effect of total aerosol
-        ! CAS AER (2)
-        flag_aer=1.0
-        CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
-             PRMU0,PFRAC,PTAVE,PWV,&
-             ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-        INU = 1
-        CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
-             PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             ZFD, ZFU)
-        INU = 2
-        CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
-             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             PWV, PQS,&
-             ZFDOWN, ZFUP)
-
-        DO JK = 1 , KFLEV+1
-           DO JL = 1, KDLON
-              ZFSUP0_AERO(JL,JK,2) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL) 
-              ZFSDN0_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) 
-           ENDDO
-        ENDDO
-
-        ! cloudy-sky with natural aerosols for indirect effect 
-        ! but total aerosols for direct effect
-        ! PTAU
-        ! CAS AER (2)
-        flag_aer=1.0
-        CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
-             PRMU0,PFRAC,PTAVE,PWV,&
-             ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-        INU = 1
-        CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
-             PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             ZFD, ZFU)
-        INU = 2
-        CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
-             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             PWV, PQS,&
-             ZFDOWN, ZFUP)
-
-        DO JK = 1 , KFLEV+1
-           DO JL = 1, KDLON
-              ZFSUP_AERO(JL,JK,2) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL) 
-              ZFSDN_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) 
-           ENDDO
-        ENDDO
-
-     ENDIF !-end ok_ade
-
-     IF ( .not. ok_ade .or. .not. ok_aie ) THEN
-
-        ! cloudy-sky with natural aerosols for indirect effect 
-        ! and natural aerosols for direct effect
-        ! PTAU
-        ! CAS AER (3)
-        ! cloudy-sky direct effect natural aerosol
-        flag_aer=1.0
-        CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
-             PRMU0,PFRAC,PTAVE,PWV,&
-             ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-        INU = 1
-        CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
-             PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             ZFD, ZFU)
-        INU = 2
-        CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
-             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
-             PWV, PQS,&
-             ZFDOWN, ZFUP)
-
-        DO JK = 1 , KFLEV+1
-           DO JL = 1, KDLON
-              ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-              ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
-           ENDDO
-        ENDDO
-
-     ENDIF  !--true/false or false/true
-
-     IF (ok_ade .and. ok_aie) THEN
-
-        ! cloudy-sky with total aerosols for indirect effect 
-        ! and total aerosols for direct effect
-        ! PTAUA
-        ! CAS AER (2)
-        flag_aer=1.0
-        CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
-             PRMU0,PFRAC,PTAVE,PWV,&
-             ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-        INU = 1
-        CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
-             PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
-             ZFD, ZFU)
-        INU = 2
-        CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
-             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
-             PWV, PQS,&
-             ZFDOWN, ZFUP)
-
-        DO JK = 1 , KFLEV+1
-           DO JL = 1, KDLON
-              ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-              ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) 
-           ENDDO
-        ENDDO
-  
-      ENDIF ! ok_ade .and. ok_aie
-
-     IF (ok_aie) THEN
-        ! cloudy-sky with total aerosols for indirect effect 
-        ! and natural aerosols for direct effect
-        ! PTAUA
-        ! CAS AER (3)
-        flag_aer=1.0
-        CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
-             PRMU0,PFRAC,PTAVE,PWV,&
-             ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-        INU = 1
-        CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
-             PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
-             ZFD, ZFU)
-        INU = 2
-        CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
-             tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
-             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
-             ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
-             PWV, PQS,&
-             ZFDOWN, ZFUP)
-  
-        DO JK = 1 , KFLEV+1
-           DO JL = 1, KDLON
-              ZFSUP_AERO(JL,JK,5) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-              ZFSDN_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) 
-           ENDDO
-        ENDDO
-
-     ENDIF ! ok_aie      
-
-     ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat GT 0
-
-     itapsw = 0
-  ENDIF
-  itapsw = itapsw + 1
-
-  IF  ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol.GT.0 .OR. flag_aerosol_strat.GT.0) ) THEN
-  IF ( ok_ade .and. ok_aie  ) THEN
-    ZFSUP(:,:) =    ZFSUP_AERO(:,:,4)
-    ZFSDN(:,:) =    ZFSDN_AERO(:,:,4)
-    ZFSUP0(:,:) =   ZFSUP0_AERO(:,:,2)
-    ZFSDN0(:,:) =   ZFSDN0_AERO(:,:,2)
-  ENDIF
-
-  IF ( ok_ade .and. (.not. ok_aie) )  THEN
-    ZFSUP(:,:) =    ZFSUP_AERO(:,:,2)
-    ZFSDN(:,:) =    ZFSDN_AERO(:,:,2)
-    ZFSUP0(:,:) =   ZFSUP0_AERO(:,:,2)
-    ZFSDN0(:,:) =   ZFSDN0_AERO(:,:,2)
-  ENDIF
-
-  IF ( (.not. ok_ade) .and. ok_aie  )  THEN
-    ZFSUP(:,:) =    ZFSUP_AERO(:,:,5)
-    ZFSDN(:,:) =    ZFSDN_AERO(:,:,5)
-    ZFSUP0(:,:) =   ZFSUP0_AERO(:,:,3)
-    ZFSDN0(:,:) =   ZFSDN0_AERO(:,:,3)
-  ENDIF
-
-  IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
-    ZFSUP(:,:) =    ZFSUP_AERO(:,:,3)
-    ZFSDN(:,:) =    ZFSDN_AERO(:,:,3)
-    ZFSUP0(:,:) =   ZFSUP0_AERO(:,:,3)
-    ZFSDN0(:,:) =   ZFSDN0_AERO(:,:,3)
-  ENDIF
-
-! MS the following allows to compute the forcing diagostics without
-! letting the aerosol forcing act on the meteorology
-! SEE logic above
-  ELSE 
-    ZFSUP(:,:) =    ZFSUP_AERO(:,:,1)
-    ZFSDN(:,:) =    ZFSDN_AERO(:,:,1)
-    ZFSUP0(:,:) =   ZFSUP0_AERO(:,:,1)
-    ZFSDN0(:,:) =   ZFSDN0_AERO(:,:,1)
-  ENDIF
-
-! Now computes heating rates
-  DO k = 1, KFLEV
-     kpl1 = k+1
-     DO i = 1, KDLON
-        PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))-(ZFSDN(i,k)-ZFSDN(i,kpl1))
-        PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
-        PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))-(ZFSDN0(i,k)-ZFSDN0(i,kpl1))
-        PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
-     ENDDO
-  ENDDO
-
-  DO i = 1, KDLON
-! effective SW surface albedo calculation
-     PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
-     
-! clear sky net fluxes at TOA and SRF
-     PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
-     PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
-
-! cloudy sky net fluxes at TOA and SRF
-     PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
-     PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
-
-! net anthropogenic forcing direct and 1st indirect effect diagnostics
-! requires a natural aerosol field read and used 
-! Difference of net fluxes from double call to radiation
-
-IF (ok_ade) THEN
-
-! indices 1: natural; 2 anthropogenic 
-
-! TOA/SRF all sky natural forcing
-     PSOLSWAERO(i,1) = (ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))-(ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))
-     PTOPSWAERO(i,1) = (ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))- (ZFSDN_AERO(i,KFLEV+1,1) - ZFSUP_AERO(i,KFLEV+1,1))
-
-! TOA/SRF clear sky natural forcing
-     PSOLSW0AERO(i,1) = (ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
-     PTOPSW0AERO(i,1) = (ZFSDN0_AERO(i,KFLEV+1,3) - ZFSUP0_AERO(i,KFLEV+1,3))-(ZFSDN0_AERO(i,KFLEV+1,1) - ZFSUP0_AERO(i,KFLEV+1,1))
-
-   IF (ok_aie) THEN 
-
-! TOA/SRF all sky anthropogenic forcing
-     PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))
-     PTOPSWAERO(i,2) = (ZFSDN_AERO(i,KFLEV+1,4) - ZFSUP_AERO(i,KFLEV+1,4))- (ZFSDN_AERO(i,KFLEV+1,5) - ZFSUP_AERO(i,KFLEV+1,5))
-
-   ELSE 
-
-! TOA/SRF all sky anthropogenic forcing
-     PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
-     PTOPSWAERO(i,2) = (ZFSDN_AERO(i,KFLEV+1,2) - ZFSUP_AERO(i,KFLEV+1,2))- (ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))
-
-   ENDIF
-
-! TOA/SRF clear sky anthropogenic forcing
-     PSOLSW0AERO(i,2) = (ZFSDN0_AERO(i,1,2) - ZFSUP0_AERO(i,1,2))-(ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))
-     PTOPSW0AERO(i,2) = (ZFSDN0_AERO(i,KFLEV+1,2) - ZFSUP0_AERO(i,KFLEV+1,2))-(ZFSDN0_AERO(i,KFLEV+1,3) - ZFSUP0_AERO(i,KFLEV+1,3))
-
-! direct anthropogenic forcing , as in old LMDzT, however differences of net fluxes
-     PSOLSWADAERO(i) = PSOLSWAERO(i,2)
-     PTOPSWADAERO(i) = PTOPSWAERO(i,2)
-     PSOLSWAD0AERO(i) = PSOLSW0AERO(i,2)
-     PTOPSWAD0AERO(i) = PTOPSW0AERO(i,2)
-
-! OB: these diagnostics may not always work but who need them
-! Cloud forcing indices 1: natural; 2 anthropogenic; 3: zero aerosol direct effect
-! Instantaneously computed cloudy sky direct aerosol effect, cloud forcing due to aerosols above clouds
-! natural
-     PSOLSWCFAERO(i,1) = PSOLSWAERO(i,1) - PSOLSW0AERO(i,1)
-     PTOPSWCFAERO(i,1) = PTOPSWAERO(i,1) - PTOPSW0AERO(i,1)
-
-! Instantaneously computed cloudy SKY DIRECT aerosol effect, cloud forcing due to aerosols above clouds
-! anthropogenic
-     PSOLSWCFAERO(i,2) = PSOLSWAERO(i,2) - PSOLSW0AERO(i,2)
-     PTOPSWCFAERO(i,2) = PTOPSWAERO(i,2) - PTOPSW0AERO(i,2)
-
-! Cloudforcing without aerosol
-! zero
-     PSOLSWCFAERO(i,3) = (ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
-     PTOPSWCFAERO(i,3) = (ZFSDN_AERO(i,KFLEV+1,1) - ZFSUP_AERO(i,KFLEV+1,1))- (ZFSDN0_AERO(i,KFLEV+1,1) - ZFSUP0_AERO(i,KFLEV+1,1))
-
-ENDIF
-
-IF (ok_aie) THEN
-   IF (ok_ade) THEN 
-     PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))
-     PTOPSWAIAERO(i) = (ZFSDN_AERO(i,KFLEV+1,4) - ZFSUP_AERO(i,KFLEV+1,4))-(ZFSDN_AERO(i,KFLEV+1,2) - ZFSUP_AERO(i,KFLEV+1,2))
-   ELSE 
-     PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
-     PTOPSWAIAERO(i) = (ZFSDN_AERO(i,KFLEV+1,5) - ZFSUP_AERO(i,KFLEV+1,5))-(ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))
-   ENDIF
-ENDIF
-
-ENDDO
-
-END SUBROUTINE SW_AEROAR4
+link ../phylmd/sw_aeroAR4.F90
Index: LMDZ6/trunk/libf/phylmdiso/tend_to_tke.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tend_to_tke.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tend_to_tke.F90	(revision 3940)
@@ -1,149 +1,1 @@
-!***************************************************************************************
-! tend_to_tke.F90
-!*************
-!
-! Subroutine that adds a tendency on the TKE created by the 
-! fluxes of momentum retrieved from the wind speed tendencies
-! of the physics.
-! 
-! The basic concept is the following:
-! the TKE equation writes  de/dt = -u'w' du/dz -v'w' dv/dz +g/theta dtheta/dz +......
-!
-!
-! We expect contributions to the term u'w' and v'w' that do not come from the Yamada
-! scheme, for instance: gravity waves, drag from high vegetation..... These contributions
-! need to be accounted for.
-! we explicitely calculate the fluxes, integrating the wind speed 
-!                        tendency from the top of the atmospher
-!
-!
-!
-! contacts: Frederic Hourdin, Etienne Vignon
-!
-! History:
-!---------
-! - 1st redaction, Etienne, 15/10/2016
-! Ajout des 4 sous surfaces pour la tke
-! on sort l'ajout des tendances du if sur les deux cas, pour ne pas
-! dupliuqer les lignes
-! on enleve le pas de temps qui disprait dans les calculs
-!
-!
-!**************************************************************************************
-
- SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,pctsrf,tke)
-
- USE dimphy, ONLY: klon, klev
- USE indice_sol_mod, ONLY: nbsrf
-
-IMPLICIT NONE
-#include "YOMCST.h"
-
-! Declarations
-!==============
-
-
-! Inputs
-!-------
-  REAL dt                   ! Time step [s]
-  REAL plev(klon,klev+1)    ! inter-layer pressure [Pa]
-  REAL temp(klon,klev)      ! temperature [K], grid-cell average or for a one subsurface
-  REAL windu(klon,klev)     ! zonal wind [m/s], grid-cell average or for a one subsurface
-  REAL windv(klon,klev)     ! meridonal wind [m/s], grid-cell average or for a one subsurface
-  REAL exner(klon,klev)     ! Fonction d'Exner = T/theta
-  REAL dt_a(klon,klev)      ! Temperature tendency [K], grid-cell average or for a one subsurface
-  REAL du_a(klon,klev)      ! Zonal wind speed tendency [m/s], grid-cell average or for a one subsurface
-  REAL dv_a(klon,klev)      ! Meridional wind speed tendency [m/s], grid-cell average or for a one subsurface
-  REAL pctsrf(klon,nbsrf+1)       ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface
-
-! Inputs/Outputs
-!---------------
-  REAL tke(klon,klev+1,nbsrf+1)       ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface
-
-
-! Local
-!-------
-
-
-  INTEGER i,k,isrf                 ! indices
-  REAL    masse(klon,klev)          ! mass in the layers [kg/m2]
-  REAL    unsmasse(klon,klev+1)     ! linear mass in the layers [kg/m2]
-  REAL    flux_rhotw(klon,klev+1)   ! flux massique de tempe. pot. rho*u'*theta'
-  REAL    flux_rhouw(klon,klev+1)   ! flux massique de quantit?? de mouvement rho*u'*w' [kg/m/s2]
-  REAL    flux_rhovw(klon,klev+1)   ! flux massique de quantit?? de mouvement rho*v'*w' [kg/m/s2]
-  REAL    tendt(klon,klev)        ! new temperature tke tendency [m2/s2/s]
-  REAL    tendu(klon,klev)        ! new zonal tke tendency [m2/s2/s]
-  REAL    tendv(klon,klev)        ! new meridonal tke tendency [m2/s2/s]
-  
-
-
-
-! First calculations:
-!=====================
-
-      unsmasse(:,:)=0.
-      DO k=1,klev
-         masse(:,k)=(plev(:,k)-plev(:,k+1))/RG
-         unsmasse(:,k)=unsmasse(:,k)+0.5/masse(:,k)
-         unsmasse(:,k+1)=unsmasse(:,k+1)+0.5/masse(:,k)
-      END DO
-
-      tendu(:,:)=0.0
-      tendv(:,:)=0.0
-
-! Method 1: Calculation of fluxes using a downward integration
-!============================================================
-
-
- 
-! Flux calculation
-
- flux_rhotw(:,klev+1)=0.
- flux_rhouw(:,klev+1)=0.
- flux_rhovw(:,klev+1)=0.
-
-   DO k=klev,1,-1
-      flux_rhotw(:,k)=flux_rhotw(:,k+1)+masse(:,k)*dt_a(:,k)/exner(:,k)
-      flux_rhouw(:,k)=flux_rhouw(:,k+1)+masse(:,k)*du_a(:,k)
-      flux_rhovw(:,k)=flux_rhovw(:,k+1)+masse(:,k)*dv_a(:,k)
-   ENDDO
-
-
-! TKE update:
-
-   DO k=2,klev
-      tendt(:,k)=-flux_rhotw(:,k)*(exner(:,k)-exner(:,k-1))*unsmasse(:,k)*RCPD
-      tendu(:,k)=-flux_rhouw(:,k)*(windu(:,k)-windu(:,k-1))*unsmasse(:,k)
-      tendv(:,k)=-flux_rhovw(:,k)*(windv(:,k)-windv(:,k-1))*unsmasse(:,k)
-   ENDDO
-   tendt(:,1)=-flux_rhotw(:,1)*(exner(:,1)-1.)*unsmasse(:,1)*RCPD
-   tendu(:,1)=-1.*flux_rhouw(:,1)*windu(:,1)*unsmasse(:,1)
-   tendv(:,1)=-1.*flux_rhovw(:,1)*windv(:,1)*unsmasse(:,1)
-
-
- DO isrf=1,nbsrf
-    DO k=1,klev
-       DO i=1,klon
-          IF (pctsrf(i,isrf)>0.) THEN
-            tke(i,k,isrf)= tke(i,k,isrf)+tendu(i,k)+tendv(i,k)+tendt(i,k)
-            tke(i,k,isrf)= max(tke(i,k,isrf),1.e-10)
-          ENDIF
-       ENDDO
-    ENDDO
- ENDDO
-
-
-!  IF (klon==1) THEN
-!  CALL iophys_ecrit('u',klev,'u','',windu)
-!  CALL iophys_ecrit('v',klev,'v','',windu)
-!  CALL iophys_ecrit('t',klev,'t','',temp)
-!  CALL iophys_ecrit('tke1',klev,'tke1','',tke(:,1:klev,1))
-!  CALL iophys_ecrit('tke2',klev,'tke2','',tke(:,1:klev,2))
-!  CALL iophys_ecrit('tke3',klev,'tke3','',tke(:,1:klev,3))
-!  CALL iophys_ecrit('tke4',klev,'tke4','',tke(:,1:klev,4))
-!  CALL iophys_ecrit('theta',klev,'theta','',temp/exner)
-!  CALL iophys_ecrit('Duv',klev,'Duv','',tendu(:,1:klev)+tendv(:,1:klev))
-!  CALL iophys_ecrit('Dt',klev,'Dt','',tendt(:,1:klev))
-!  ENDIF
-
- END SUBROUTINE tend_to_tke
+link ../phylmd/tend_to_tke.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell.F90	(revision 3940)
@@ -1,1168 +1,1 @@
-
-! $Id: thermcell.F90 3102 2017-12-03 20:27:42Z oboucher $
-
-SUBROUTINE calcul_sec(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, pu, &
-    pv, pt, po, zmax, wmax, zw2, lmix & ! s
-                                        ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zw2(klon, klev+1), ztva(klon, klev)
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  ! real zwd(klon,klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  ! integer isplit,nsplit
-  INTEGER isplit, nsplit, ialt
-  PARAMETER (nsplit=10)
-  DATA isplit/0/
-  SAVE isplit
-  !$OMP THREADPRIVATE(isplit)
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL zalim(klon)
-  INTEGER lalim(klon)
-  REAL norme(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL therm
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'calcul_sec'
-  CHARACTER (LEN=80) :: abort_message
-
-
-  ! LOGICAL vtest(klon),down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  therm = .FALSE.
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k + 1
-        therm = .TRUE.
-      END IF
-    END DO
-  END DO
-  ! limitation de la valeur du lentr
-  ! do ig=1,ngrid
-  ! lentr(ig)=min(5,lentr(ig))
-  ! enddo
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! initialisations
-  DO ig = 1, ngrid
-    zalim(ig) = 0.
-    norme(ig) = 0.
-    lalim(ig) = 1
-  END DO
-  DO k = 1, klev - 1
-    DO ig = 1, ngrid
-      zalim(ig) = zalim(ig) + zlev(ig, k)*max(0., (ztv(ig,k)-ztv(ig, &
-        k+1))/(zlev(ig,k+1)-zlev(ig,k)))
-      ! s         *(zlev(ig,k+1)-zlev(ig,k))
-      norme(ig) = norme(ig) + max(0., (ztv(ig,k)-ztv(ig,k+1))/(zlev(ig, &
-        k+1)-zlev(ig,k)))
-      ! s          *(zlev(ig,k+1)-zlev(ig,k))
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    IF (norme(ig)>1.E-10) THEN
-      zalim(ig) = max(10.*zalim(ig)/norme(ig), zlev(ig,2))
-      ! zalim(ig)=min(zalim(ig),zlev(ig,lentr(ig)))
-    END IF
-  END DO
-  ! détermination du lalim correspondant
-  DO k = 1, klev - 1
-    DO ig = 1, ngrid
-      IF ((zalim(ig)>zlev(ig,k)) .AND. (zalim(ig)<=zlev(ig,k+1))) THEN
-        lalim(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<lentr(ig)) THEN
-        entr_star(ig, l) = max((ztv(ig,l)-ztv(ig,l+1)), 0.) & ! s
-                                                              ! *(zlev(ig,l+1)-zlev(ig,l))
-          *sqrt(zlev(ig,l+1))
-        ! autre def
-        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
-        ! s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
-      END IF
-    END DO
-  END DO
-  ! nouveau test
-  ! if (therm) then
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lalim(ig) .AND. &
-          zalim(ig)>1.E-10) THEN
-        ! if (l.le.lentr(ig)) then
-        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
-        ! s                         /zalim(ig)))**(3./2.)
-        ! write(10,*)zlev(ig,l),entr_star(ig,l)
-      END IF
-    END DO
-  END DO
-  ! endif
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-  ! Calcul entrainement normalise
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)>1.E-10) THEN
-      ! do l=1,lentr(ig)
-      DO l = 1, klev
-        ! def possibles pour entr_star: zdthetadz, dthetadz, zdtheta
-        entr_star(ig, l) = entr_star(ig, l)/entr_star_tot(ig)
-      END DO
-    END IF
-  END DO
-
-  ! print*,'fin calcul entr_star'
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
-          f_star(ig, l+1)
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        ! test
-        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
-          ! print*,'pb linter'
-        END IF
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        IF (zw2(ig,l+1)<0.) THEN
-          ! print*,'pb1 zw2<0'
-        END IF
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  ! print*,'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-    ! lmax(ig)=lalim(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      ! do l=nlay,lalim(ig)+1,-1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-      lentr(ig) = 1
-      lalim(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          ! print*,'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-  DO ig = 1, ngrid
-    ! write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
-  END DO
-  ! on stope après les calculs de zmax et wmax
-  RETURN
-
-  ! print*,'avant fermeture'
-  ! Fermeture,determination de f
-  ! Attention! entrainement normalisé ou pas?
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        ! do k=lmin(ig),lalim(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))
-      ! s            *entr_star_tot(ig)
-      ! test
-      ! if (first) then
-      f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
-      ! endif
-    END IF
-    f0(ig) = f(ig)
-    ! first=.true.
-  END DO
-  ! print*,'apres fermeture'
-  ! on stoppe après la fermeture
-  RETURN
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! on stoppe après le calcul de entr
-  ! RETURN
-  ! CR:test pour entrainer moins que la masse
-  ! do ig=1,ngrid
-  ! do l=1,lentr(ig)
-  ! if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
-  ! entr(ig,l+1)=entr(ig,l+1)+entr(ig,l)
-  ! s                       -0.9*masse(ig,l)/ptimestep
-  ! entr(ig,l)=0.9*masse(ig,l)/ptimestep
-  ! endif
-  ! enddo
-  ! enddo
-  ! CR: fin test
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          ! print*,'pb l_mix*zlev<0'
-        END IF
-        ! CR: test: nouvelle def de lambda
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        IF (zw2(ig,l)>1.E-10) THEN
-          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
-        ELSE
-          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        END IF
-        ! RC
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        ! print*,'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<0.) THEN
-      zmix(ig) = 0.99*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! print*,'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-      IF (detr(ig,l)<0.) THEN
-        ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-        fm(ig, l+1) = fm(ig, l) + entr(ig, l)
-        detr(ig, l) = 0.
-        ! print*,'WARNING !!! detrainement negatif ',ig,l
-      END IF
-    END DO
-  END DO
-  ! RC
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-
-    ! deja fait
-    ! do l=1,nlay
-    ! do ig=1,ngrid
-    ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
-    ! if (detr(ig,l).lt.0.) then
-    ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-    ! detr(ig,l)=0.
-    ! print*,'WARNING !!! detrainement negatif ',ig,l
-    ! endif
-    ! enddo
-    ! enddo
-
-    ! print*,'15 OK convect8'
-
-    isplit = isplit + 1
-
-
-    ! #define und
-    GO TO 123
-#ifdef und
-    CALL writeg1d(1, nlay, wd, 'wd      ', 'wd      ')
-    CALL writeg1d(1, nlay, zwa, 'wa      ', 'wa      ')
-    CALL writeg1d(1, nlay, fracd, 'fracd      ', 'fracd      ')
-    CALL writeg1d(1, nlay, fraca, 'fraca      ', 'fraca      ')
-    CALL writeg1d(1, nlay, wa_moy, 'wam         ', 'wam         ')
-    CALL writeg1d(1, nlay, zla, 'la      ', 'la      ')
-    CALL writeg1d(1, nlay, zld, 'ld      ', 'ld      ')
-    CALL writeg1d(1, nlay, pt, 'pt      ', 'pt      ')
-    CALL writeg1d(1, nlay, zh, 'zh      ', 'zh      ')
-    CALL writeg1d(1, nlay, zha, 'zha      ', 'zha      ')
-    CALL writeg1d(1, nlay, zu, 'zu      ', 'zu      ')
-    CALL writeg1d(1, nlay, zv, 'zv      ', 'zv      ')
-    CALL writeg1d(1, nlay, zo, 'zo      ', 'zo      ')
-    CALL writeg1d(1, nlay, wh, 'wh      ', 'wh      ')
-    CALL writeg1d(1, nlay, wu, 'wu      ', 'wu      ')
-    CALL writeg1d(1, nlay, wv, 'wv      ', 'wv      ')
-    CALL writeg1d(1, nlay, wo, 'w15uo     ', 'wXo     ')
-    CALL writeg1d(1, nlay, zdhadj, 'zdhadj      ', 'zdhadj      ')
-    CALL writeg1d(1, nlay, pduadj, 'pduadj      ', 'pduadj      ')
-    CALL writeg1d(1, nlay, pdvadj, 'pdvadj      ', 'pdvadj      ')
-    CALL writeg1d(1, nlay, pdoadj, 'pdoadj      ', 'pdoadj      ')
-    CALL writeg1d(1, nlay, entr, 'entr        ', 'entr        ')
-    CALL writeg1d(1, nlay, detr, 'detr        ', 'detr        ')
-    CALL writeg1d(1, nlay, fm, 'fm          ', 'fm          ')
-
-    CALL writeg1d(1, nlay, pdtadj, 'pdtadj    ', 'pdtadj    ')
-    CALL writeg1d(1, nlay, pplay, 'pplay     ', 'pplay     ')
-    CALL writeg1d(1, nlay, pplev, 'pplev     ', 'pplev     ')
-
-    ! recalcul des flux en diagnostique...
-    ! print*,'PAS DE TEMPS ',ptimestep
-    CALL dt2f(pplev, pplay, pt, pdtadj, wh)
-    CALL writeg1d(1, nlay, wh, 'wh2     ', 'wh2     ')
-#endif
-123 CONTINUE
-
-  END IF
-
-  ! if(wa_moy(1,4).gt.1.e-10) stop
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE calcul_sec
-
-SUBROUTINE fermeture_seche(ngrid, nlay, pplay, pplev, pphi, zlev, rhobarz, &
-    f0, zpspsk, alim_star, zh, zo, lentr, lmin, nu_min, nu_max, r_aspect, &
-    zmax, wmax)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-
-  INTEGER ngrid, nlay
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-  REAL zlev(klon, klev+1)
-  REAL alim_star(klon, klev)
-  REAL f0(klon)
-  INTEGER lentr(klon)
-  INTEGER lmin(klon)
-  REAL zmax(klon)
-  REAL wmax(klon)
-  REAL nu_min
-  REAL nu_max
-  REAL r_aspect
-  REAL rhobarz(klon, klev+1)
-  REAL zh(klon, klev)
-  REAL zo(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  INTEGER ig, l
-
-  REAL f_star(klon, klev+1)
-  REAL detr_star(klon, klev)
-  REAL entr_star(klon, klev)
-  REAL zw2(klon, klev+1)
-  REAL linter(klon)
-  INTEGER lmix(klon)
-  INTEGER lmax(klon)
-  REAL zlevinter(klon)
-  REAL wa_moy(klon, klev+1)
-  REAL wmaxa(klon)
-  REAL ztv(klon, klev)
-  REAL ztva(klon, klev)
-  REAL nu(klon, klev)
-  ! real zmax0_sec(klon)
-  ! save zmax0_sec
-  REAL, SAVE, ALLOCATABLE :: zmax0_sec(:)
-  !$OMP THREADPRIVATE(zmax0_sec)
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-
-  IF (first) THEN
-    ALLOCATE (zmax0_sec(klon))
-    first = .FALSE.
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
-      ztv(ig, l) = ztv(ig, l)*(1.+retv*zo(ig,l))
-    END DO
-  END DO
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. alim_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = alim_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+alim_star(ig, &
-          l))>1.E-10) THEN
-        ! estimation du detrainement a partir de la geometrie du pas
-        ! precedent
-        ! tests sur la definition du detr
-        nu(ig, l) = (nu_min+nu_max)/2.*(1.-(nu_max-nu_min)/(nu_max+nu_min)* &
-          tanh((((ztva(ig,l-1)-ztv(ig,l))/ztv(ig,l))/0.0005)))
-
-        detr_star(ig, l) = rhobarz(ig, l)*sqrt(zw2(ig,l))/ &
-          (r_aspect*zmax0_sec(ig))* & ! s
-                                      ! /(r_aspect*zmax0(ig))*
-          (sqrt(nu(ig,l)*zlev(ig,l+1)/sqrt(zw2(ig,l)))-sqrt(nu(ig,l)*zlev(ig, &
-          l)/sqrt(zw2(ig,l))))
-        detr_star(ig, l) = detr_star(ig, l)/f0(ig)
-        IF ((detr_star(ig,l))>f_star(ig,l)) THEN
-          detr_star(ig, l) = f_star(ig, l)
-        END IF
-        entr_star(ig, l) = 0.9*detr_star(ig, l)
-        IF ((l<lentr(ig))) THEN
-          entr_star(ig, l) = 0.
-          ! detr_star(ig,l)=0.
-        END IF
-        ! print*,'ok detr_star'
-        ! prise en compte du detrainement dans le calcul du flux
-        f_star(ig, l+1) = f_star(ig, l) + alim_star(ig, l) + &
-          entr_star(ig, l) - detr_star(ig, l)
-        ! test sur le signe de f_star
-        IF ((f_star(ig,l+1)+detr_star(ig,l))>1.E-10) THEN
-          ! AM on melange Tl et qt du thermique
-          ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+(entr_star(ig, &
-            l)+alim_star(ig,l))*ztv(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
-          zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/(f_star(ig, &
-            l+1)+detr_star(ig,l)))**2 + 2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, &
-            l)*(zlev(ig,l+1)-zlev(ig,l))
-        END IF
-      END IF
-
-      IF (zw2(ig,l+1)<0.) THEN
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        ! print*,'linter=',linter(ig)
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  ! print*,'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-      lentr(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          ! print*,'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    ! pour le cas ou on prend tjs lmin=1
-    ! zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,1))
-    zmax0_sec(ig) = zmax(ig)
-  END DO
-
-  RETURN
-END SUBROUTINE fermeture_seche
+link ../phylmd/thermcell.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell.h	(revision 3940)
@@ -1,30 +1,1 @@
-      integer            :: iflag_thermals,nsplit_thermals
-
-!!! nrlmd le 10/04/2012
-      integer            :: iflag_trig_bl,iflag_clos_bl
-      integer            :: tau_trig_shallow,tau_trig_deep
-      real               :: s_trig
-!!! fin nrlmd le 10/04/2012
-
-      real,parameter     :: r_aspect_thermals=2.,l_mix_thermals=30.
-      real               :: alp_bl_k
-      real               :: tau_thermals,fact_thermals_ed_dz
-      integer,parameter  :: w2di_thermals=0
-      integer            :: isplit
-
-      integer            :: iflag_coupl,iflag_clos,iflag_wake
-      integer            :: iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure
-
-      common/ctherm1/iflag_thermals,nsplit_thermals,iflag_thermals_closure
-      common/ctherm2/tau_thermals,alp_bl_k,fact_thermals_ed_dz
-      common/ctherm4/iflag_coupl,iflag_clos,iflag_wake
-      common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux
-
-!!! nrlmd le 10/04/2012
-      common/ctherm6/iflag_trig_bl,iflag_clos_bl
-      common/ctherm7/tau_trig_shallow,tau_trig_deep
-      common/ctherm8/s_trig
-!!! fin nrlmd le 10/04/2012
-
-!$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/)
-!$OMP THREADPRIVATE(/ctherm6/,/ctherm7/,/ctherm8/)
+link ../phylmd/thermcell.h
Index: LMDZ6/trunk/libf/phylmdiso/thermcellV0_main.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcellV0_main.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcellV0_main.F90	(revision 3940)
@@ -1,2079 +1,1 @@
-!
-! $Id$
-!
-      SUBROUTINE thermcellV0_main(itap,ngrid,nlay,ptimestep  &
-     &                  ,pplay,pplev,pphi,debut  &
-     &                  ,pu,pv,pt,po  &
-     &                  ,pduadj,pdvadj,pdtadj,pdoadj  &
-     &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
-     &                  ,ratqscth,ratqsdiff,zqsatth  &
-     &                  ,r_aspect,l_mix,tau_thermals &
-     &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
-     &                  ,zmax0, f0,zw2,fraca)
-
-      USE dimphy
-      USE print_control_mod, ONLY: prt_level,lunout
-      IMPLICIT NONE
-
-!=======================================================================
-!   Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
-!   Version du 09.02.07
-!   Calcul du transport vertical dans la couche limite en presence
-!   de "thermiques" explicitement representes avec processus nuageux
-!
-!   Réécriture à partir d'un listing papier à Habas, le 14/02/00
-!
-!   le thermique est supposé homogène et dissipé par mélange avec
-!   son environnement. la longueur l_mix contrôle l'efficacité du
-!   mélange
-!
-!   Le calcul du transport des différentes espèces se fait en prenant
-!   en compte:
-!     1. un flux de masse montant
-!     2. un flux de masse descendant
-!     3. un entrainement
-!     4. un detrainement
-!
-!=======================================================================
-
-!-----------------------------------------------------------------------
-!   declarations:
-!   -------------
-
-      include "YOMCST.h"
-      include "YOETHF.h"
-      include "FCTTRE.h"
-
-!   arguments:
-!   ----------
-
-!IM 140508
-      INTEGER itap
-
-      INTEGER ngrid,nlay,w2di
-      real tau_thermals
-      real ptimestep,l_mix,r_aspect
-      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
-      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
-      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
-      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
-      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
-      real pphi(ngrid,nlay)
-
-!   local:
-!   ------
-
-      integer icount
-      data icount/0/
-      save icount
-!$OMP THREADPRIVATE(icount)
-
-      integer,save :: igout=1
-!$OMP THREADPRIVATE(igout)
-      integer,save :: lunout1=6
-!$OMP THREADPRIVATE(lunout1)
-      integer,save :: lev_out=10
-!$OMP THREADPRIVATE(lev_out)
-
-      INTEGER ig,k,l,ll
-      real zsortie1d(klon)
-      INTEGER lmax(klon),lmin(klon),lalim(klon)
-      INTEGER lmix(klon)
-      INTEGER lmix_bis(klon)
-      real linter(klon)
-      real zmix(klon)
-      real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1)
-!      real fraca(klon,klev)
-
-      real zmax_sec(klon)
-!on garde le zmax du pas de temps precedent
-      real zmax0(klon)
-!FH/IM     save zmax0
-
-      real lambda
-
-      real zlev(klon,klev+1),zlay(klon,klev)
-      real deltaz(klon,klev)
-      REAL zh(klon,klev)
-      real zthl(klon,klev),zdthladj(klon,klev)
-      REAL ztv(klon,klev)
-      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
-      real zl(klon,klev)
-      real zsortie(klon,klev)
-      real zva(klon,klev)
-      real zua(klon,klev)
-      real zoa(klon,klev)
-
-      real zta(klon,klev)
-      real zha(klon,klev)
-      real fraca(klon,klev+1)
-      real zf,zf2
-      real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev)
-      real q2(klon,klev)
-! FH probleme de dimensionnement avec l'allocation dynamique
-!     common/comtherm/thetath2,wth2
-    
-      real ratqscth(klon,klev)
-      real var
-      real vardiff
-      real ratqsdiff(klon,klev)
-
-      logical sorties
-      real rho(klon,klev),rhobarz(klon,klev),masse(klon,klev)
-      real zpspsk(klon,klev)
-
-      real wmax(klon)
-      real wmax_sec(klon)
-      real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev)
-      real fm(klon,klev+1),entr(klon,klev),detr(klon,klev)
-
-      real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
-!niveau de condensation
-      integer nivcon(klon)
-      real zcon(klon)
-      REAL CHI
-      real zcon2(klon)
-      real pcon(klon)
-      real zqsat(klon,klev)
-      real zqsatth(klon,klev) 
-
-      real f_star(klon,klev+1),entr_star(klon,klev)
-      real detr_star(klon,klev)
-      real alim_star_tot(klon),alim_star2(klon)
-      real alim_star(klon,klev)
-      real f(klon), f0(klon)
-!FH/IM     save f0
-      real zlevinter(klon)
-      logical debut
-       real seuil
-
-! Declaration uniquement pour les sorties dans thermcell_out3d.
-! Inutilise en 3D
-      real wthl(klon,klev)
-      real wthv(klon,klev)
-      real wq(klon,klev)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!
-      !nouvelles variables pour la convection
-      real Ale_bl(klon)
-      real Alp_bl(klon)
-      real alp_int(klon)
-      real ale_int(klon)
-      integer n_int(klon)
-      real fm_tot(klon)
-      real wght_th(klon,klev)
-      integer lalim_conv(klon)
-!v1d     logical therm
-!v1d     save therm
-
-      character*2 str2
-      character*10 str10
-
-      character (len=20) :: modname='thermcellV0_main'
-      character (len=80) :: abort_message
-
-      EXTERNAL SCOPY
-!
-
-!-----------------------------------------------------------------------
-!   initialisation:
-!   ---------------
-!
-
-      seuil=0.25
-
-      if (debut)  then
-         fm0=0.
-         entr0=0.
-         detr0=0.
-      endif
-      fm=0. ; entr=0. ; detr=0.
-
-      icount=icount+1
-
-!IM 090508 beg
-!print*,'====================================================================='
-!print*,'====================================================================='
-!print*,' PAS ',icount,' PAS ',icount,' PAS ',icount,' PAS ',icount
-!print*,'====================================================================='
-!print*,'====================================================================='
-!IM 090508 end
-
-      if (prt_level.ge.1) print*,'thermcell_main V4'
-
-       sorties=.true.
-      IF(ngrid.NE.klon) THEN
-         PRINT*
-         PRINT*,'STOP dans convadj'
-         PRINT*,'ngrid    =',ngrid
-         PRINT*,'klon  =',klon
-      ENDIF
-!
-!Initialisation
-!
-     if (prt_level.ge.10)write(lunout,*)                                &
-    &     'WARNING thermcell_main f0=max(f0,1.e-2)'
-     do ig=1,klon
-         f0(ig)=max(f0(ig),1.e-2)
-     enddo
-
-!-----------------------------------------------------------------------
-! Calcul de T,q,ql a partir de Tl et qT dans l environnement
-!   --------------------------------------------------------------------
-!
-      CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
-     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
-       
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env'
-
-!------------------------------------------------------------------------
-!                       --------------------
-!
-!
-!                       + + + + + + + + + + +
-!
-!
-!  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-!  wh,wt,wo ...
-!
-!                       + + + + + + + + + + +  zh,zu,zv,zo,rho
-!
-!
-!                       --------------------   zlev(1)
-!                       \\\\\\\\\\\\\\\\\\\\
-!
-!
-
-!-----------------------------------------------------------------------
-!   Calcul des altitudes des couches
-!-----------------------------------------------------------------------
-
-      do l=2,nlay
-         zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
-      enddo
-         zlev(:,1)=0.
-         zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG
-      do l=1,nlay
-         zlay(:,l)=pphi(:,l)/RG
-      enddo
-!calcul de l epaisseur des couches
-      do l=1,nlay
-         deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
-      enddo
-
-!     print*,'2 OK convect8'
-!-----------------------------------------------------------------------
-!   Calcul des densites
-!-----------------------------------------------------------------------
-
-      do l=1,nlay
-         rho(:,l)=pplay(:,l)/(zpspsk(:,l)*RD*ztv(:,l))
-      enddo
-
-!IM
-     if (prt_level.ge.10)write(lunout,*)                                &
-    &    'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
-      rhobarz(:,1)=rho(:,1)
-
-      do l=2,nlay
-         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
-      enddo
-
-!calcul de la masse
-      do l=1,nlay
-         masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
-      enddo
-
-      if (prt_level.ge.1) print*,'thermcell_main apres initialisation'
-
-!------------------------------------------------------------------
-!
-!             /|\
-!    --------  |  F_k+1 -------   
-!                              ----> D_k
-!             /|\              <---- E_k , A_k
-!    --------  |  F_k --------- 
-!                              ----> D_k-1
-!                              <---- E_k-1 , A_k-1
-!
-!
-!
-!
-!
-!    ---------------------------
-!
-!    ----- F_lmax+1=0 ----------         \
-!            lmax     (zmax)              |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |  E
-!    ---------------------------          |  D
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------  \       |
-!            lalim                 |      |
-!    ---------------------------   |      |
-!                                  |      |
-!    ---------------------------   |      |
-!                                  | A    |
-!    ---------------------------   |      |
-!                                  |      |
-!    ---------------------------   |      |
-!    lmin  (=1 pour le moment)     |      |
-!    ----- F_lmin=0 ------------  /      /
-!
-!    ---------------------------
-!    //////////////////////////
-!
-!
-!=============================================================================
-!  Calculs initiaux ne faisant pas intervenir les changements de phase
-!=============================================================================
-
-!------------------------------------------------------------------
-!  1. alim_star est le profil vertical de l'alimentation à la base du
-!     panache thermique, calculé à partir de la flotabilité de l'air sec
-!  2. lmin et lalim sont les indices inferieurs et superieurs de alim_star
-!------------------------------------------------------------------
-!
-      entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0.
-      CALL thermcellV0_init(ngrid,nlay,ztv,zlay,zlev,  &
-     &                    lalim,lmin,alim_star,alim_star_tot,lev_out)
-
-call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lmin  ')
-call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lalim ')
-
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_init'
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_main 1'
-         write(lunout1,*) 'lmin ',lmin(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) ' ig l alim_star thetav'
-         write(lunout1,'(i6,i4,2e15.5)') (igout,l,alim_star(igout,l) &
-     &   ,ztv(igout,l),l=1,lalim(igout)+4)
-      endif
-
-!v1d      do ig=1,klon
-!v1d     if (alim_star(ig,1).gt.1.e-10) then
-!v1d     therm=.true.
-!v1d     endif
-!v1d      enddo
-!-----------------------------------------------------------------------------
-!  3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un
-!     panache sec conservatif (e=d=0) alimente selon alim_star 
-!     Il s'agit d'un calcul de type CAPE
-!     zmax_sec est utilisé pour déterminer la géométrie du thermique.
-!------------------------------------------------------------------------------
-!
-      CALL thermcellV0_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
-     &                      lalim,lmin,zmax_sec,wmax_sec,lev_out)
-
-call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
-call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry'
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_main 1b'
-         write(lunout1,*) 'lmin ',lmin(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
-         write(lunout1,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) &
-     &    ,l=1,lalim(igout)+4)
-      endif
-
-
-
-!---------------------------------------------------------------------------------
-!calcul du melange et des variables dans le thermique
-!--------------------------------------------------------------------------------
-!
-      if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out
-!IM 140508   CALL thermcell_plume(ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-      CALL thermcellV0_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot,  &
-     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,zw_est,zqsatth,lmix,lmix_bis,linter &
-     &            ,lev_out,lunout1,igout)
-      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
-
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_main 2'
-         write(lunout1,*) 'lmin ',lmin(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
-         write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
-     &    ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
-      endif
-
-!-------------------------------------------------------------------------------
-! Calcul des caracteristiques du thermique:zmax,zmix,wmax
-!-------------------------------------------------------------------------------
-!
-      CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2,  &
-     &           zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)
-
-
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
-
-!-------------------------------------------------------------------------------
-! Fermeture,determination de f
-!-------------------------------------------------------------------------------
-!
-!avant closure: on redéfinit lalim, alim_star_tot et alim_star
-!       do ig=1,klon
-!       do l=2,lalim(ig)
-!       alim_star(ig,l)=entr_star(ig,l)
-!       entr_star(ig,l)=0.
-!       enddo
-!       enddo
-
-      CALL thermcellV0_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
-     &   zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out)
-
-      if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure'
-
-      if (tau_thermals>1.) then
-         lambda=exp(-ptimestep/tau_thermals)
-         f0=(1.-lambda)*f+lambda*f0
-      else
-         f0=f
-      endif
-
-! Test valable seulement en 1D mais pas genant
-      if (.not. (f0(1).ge.0.) ) then
-        abort_message = 'Dans thermcell_main f0(1).lt.0 '
-        CALL abort_physic (modname,abort_message,1)
-      endif
-
-!-------------------------------------------------------------------------------
-!deduction des flux
-!-------------------------------------------------------------------------------
-
-      CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, &
-     &       lalim,lmax,alim_star,  &
-     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
-     &       detr,zqla,lev_out,lunout1,igout)
-!IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux'
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
-      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
-
-!------------------------------------------------------------------
-!   On ne prend pas directement les profils issus des calculs precedents
-!   mais on s'autorise genereusement une relaxation vers ceci avec
-!   une constante de temps tau_thermals (typiquement 1800s).
-!------------------------------------------------------------------
-
-      if (tau_thermals>1.) then
-         lambda=exp(-ptimestep/tau_thermals)
-         fm0=(1.-lambda)*fm+lambda*fm0
-         entr0=(1.-lambda)*entr+lambda*entr0
-!        detr0=(1.-lambda)*detr+lambda*detr0
-      else
-         fm0=fm
-         entr0=entr
-         detr0=detr
-      endif
-
-!c------------------------------------------------------------------
-!   calcul du transport vertical
-!------------------------------------------------------------------
-
-      call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse,  &
-     &                    zthl,zdthladj,zta,lev_out)
-      call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse,  &
-     &                   po,pdoadj,zoa,lev_out)
-
-!------------------------------------------------------------------
-! Calcul de la fraction de l'ascendance
-!------------------------------------------------------------------
-      do ig=1,klon
-         fraca(ig,1)=0.
-         fraca(ig,nlay+1)=0.
-      enddo
-      do l=2,nlay
-         do ig=1,klon
-            if (zw2(ig,l).gt.1.e-10) then
-            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
-            else
-            fraca(ig,l)=0.
-            endif
-         enddo
-      enddo
-     
-!------------------------------------------------------------------
-!  calcul du transport vertical du moment horizontal
-!------------------------------------------------------------------
-
-!IM 090508  
-      if (1.eq.1) then
-!IM 070508 vers. _dq       
-!     if (1.eq.0) then
-
-
-! Calcul du transport de V tenant compte d'echange par gradient
-! de pression horizontal avec l'environnement
-
-         call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse  &
-     &    ,fraca,zmax  &
-     &    ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
-!IM 050508    &    ,zu,zv,pduadj,pdvadj,zua,zva,igout,lev_out)
-      else
-
-! calcul purement conservatif pour le transport de V
-         call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse  &
-     &    ,zu,pduadj,zua,lev_out)
-         call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse  &
-     &    ,zv,pdvadj,zva,lev_out)
-      endif
-
-!     print*,'13 OK convect8'
-      do l=1,nlay
-         do ig=1,ngrid
-           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)  
-         enddo
-      enddo
-
-      if (prt_level.ge.1) print*,'14 OK convect8'
-!------------------------------------------------------------------
-!   Calculs de diagnostiques pour les sorties
-!------------------------------------------------------------------
-!calcul de fraca pour les sorties
-      
-      if (sorties) then
-      if (prt_level.ge.1) print*,'14a OK convect8'
-! calcul du niveau de condensation
-! initialisation
-      do ig=1,ngrid
-         nivcon(ig)=0
-         zcon(ig)=0.
-      enddo 
-!nouveau calcul
-      do ig=1,ngrid
-      CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1))
-      pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI
-      enddo
-!IM   do k=1,nlay
-      do k=1,nlay-1
-         do ig=1,ngrid
-         if ((pcon(ig).le.pplay(ig,k))  &
-     &      .and.(pcon(ig).gt.pplay(ig,k+1))) then
-            zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100.
-         endif
-         enddo
-      enddo
-!IM
-      do ig=1,ngrid
-        if (pcon(ig).le.pplay(ig,nlay)) then 
-           zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100.
-           abort_message = 'thermcellV0_main: les thermiques vont trop haut '
-           CALL abort_physic (modname,abort_message,1)
-        endif
-      enddo
-      if (prt_level.ge.1) print*,'14b OK convect8'
-      do k=nlay,1,-1
-         do ig=1,ngrid
-            if (zqla(ig,k).gt.1e-10) then
-               nivcon(ig)=k
-               zcon(ig)=zlev(ig,k)
-            endif
-         enddo
-      enddo
-      if (prt_level.ge.1) print*,'14c OK convect8'
-!calcul des moments
-!initialisation
-      do l=1,nlay
-         do ig=1,ngrid
-            q2(ig,l)=0.
-            wth2(ig,l)=0.
-            wth3(ig,l)=0.
-            ratqscth(ig,l)=0.
-            ratqsdiff(ig,l)=0.
-         enddo
-      enddo      
-      if (prt_level.ge.1) print*,'14d OK convect8'
-      if (prt_level.ge.10)write(lunout,*)                                &
-    &     'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
-      do l=1,nlay
-         do ig=1,ngrid
-            zf=fraca(ig,l)
-            zf2=zf/(1.-zf)
-!
-            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
-            if(zw2(ig,l).gt.1.e-10) then
-             wth2(ig,l)=zf2*(zw2(ig,l))**2
-            else
-             wth2(ig,l)=0.
-            endif
-!           print*,'wth2=',wth2(ig,l)
-            wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
-     &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
-            q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-!test: on calcul q2/po=ratqsc
-            ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.))
-         enddo
-      enddo
-
-      if (prt_level.ge.10) then
-          print*,'14e OK convect8 ig,l,zf,zf2',ig,l,zf,zf2
-          ig=igout
-          do l=1,nlay
-             print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)
-          enddo
-          do l=1,nlay
-             print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l)
-          enddo
-      endif
-
-      do ig=1,ngrid
-      alp_int(ig)=0.
-      ale_int(ig)=0.
-      n_int(ig)=0
-      enddo
-!
-      do l=1,nlay
-      do ig=1,ngrid
-       if(l.LE.lmax(ig)) THEN
-        alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l)
-        ale_int(ig)=ale_int(ig)+0.5*zw2(ig,l)**2
-        n_int(ig)=n_int(ig)+1
-       endif
-      enddo
-      enddo
-!      print*,'avant calcul ale et alp' 
-!calcul de ALE et ALP pour la convection
-      do ig=1,ngrid
-!      Alp_bl(ig)=0.5*rhobarz(ig,lmix_bis(ig))*wth3(ig,lmix(ig))
-!          Alp_bl(ig)=0.5*rhobarz(ig,nivcon(ig))*wth3(ig,nivcon(ig))
-!      Alp_bl(ig)=0.5*rhobarz(ig,lmix(ig))*wth3(ig,lmix(ig)) 
-!     &           *0.1
-!valeur integree de alp_bl * 0.5:
-       if (n_int(ig).gt.0) then
-       Alp_bl(ig)=0.5*alp_int(ig)/n_int(ig)
-!       if (Alp_bl(ig).lt.0.) then
-!       Alp_bl(ig)=0.
-       endif
-!       endif
-!         write(18,*),'rhobarz,wth3,Alp',rhobarz(ig,nivcon(ig)),
-!     s               wth3(ig,nivcon(ig)),Alp_bl(ig)
-!            write(18,*),'ALP_BL',Alp_bl(ig),lmix(ig)
-!      Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2
-!      if (nivcon(ig).eq.1) then
-!       Ale_bl(ig)=0.
-!       else
-!valeur max de ale_bl:
-       Ale_bl(ig)=0.5*zw2(ig,lmix(ig))**2 
-!     & /2.
-!     & *0.1
-!        Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2 
-!       if (n_int(ig).gt.0) then
-!       Ale_bl(ig)=ale_int(ig)/n_int(ig)
-!        Ale_bl(ig)=4.
-!       endif
-!       endif
-!            Ale_bl(ig)=0.5*wth2(ig,lmix_bis(ig))
-!          Ale_bl(ig)=wth2(ig,nivcon(ig))
-!          write(19,*),'wth2,ALE_BL',wth2(ig,nivcon(ig)),Ale_bl(ig)
-      enddo
-!test:calcul de la ponderation des couches pour KE
-!initialisations
-!      print*,'ponderation'
-      do ig=1,ngrid
-           fm_tot(ig)=0.
-      enddo
-       do ig=1,ngrid
-        do k=1,klev
-           wght_th(ig,k)=1.
-        enddo
-       enddo
-       do ig=1,ngrid
-!         lalim_conv(ig)=lmix_bis(ig)
-!la hauteur de la couche alim_conv = hauteur couche alim_therm
-         lalim_conv(ig)=lalim(ig)
-!         zentr(ig)=zlev(ig,lalim(ig))
-      enddo
-      do ig=1,ngrid
-        do k=1,lalim_conv(ig)
-           fm_tot(ig)=fm_tot(ig)+fm(ig,k)
-        enddo
-      enddo
-      do ig=1,ngrid
-        do k=1,lalim_conv(ig)
-           if (fm_tot(ig).gt.1.e-10) then
-!           wght_th(ig,k)=fm(ig,k)/fm_tot(ig)
-           endif
-!on pondere chaque couche par a*
-             if (alim_star(ig,k).gt.1.e-10) then
-             wght_th(ig,k)=alim_star(ig,k)
-             else
-             wght_th(ig,k)=1.
-             endif
-        enddo
-      enddo
-!      print*,'apres wght_th'
-!test pour prolonger la convection
-      do ig=1,ngrid
-!v1d  if ((alim_star(ig,1).lt.1.e-10).and.(therm)) then
-      if ((alim_star(ig,1).lt.1.e-10)) then
-      lalim_conv(ig)=1
-      wght_th(ig,1)=1.
-!      print*,'lalim_conv ok',lalim_conv(ig),wght_th(ig,1)
-      endif
-      enddo
-
-!calcul du ratqscdiff
-      if (prt_level.ge.1) print*,'14e OK convect8'
-      var=0.
-      vardiff=0.
-      ratqsdiff(:,:)=0.
-      do ig=1,ngrid
-         do l=1,lalim(ig)
-            var=var+alim_star(ig,l)*zqta(ig,l)*1000.
-         enddo
-      enddo
-      if (prt_level.ge.1) print*,'14f OK convect8'
-      do ig=1,ngrid
-          do l=1,lalim(ig)
-          zf=fraca(ig,l)
-          zf2=zf/(1.-zf)
-          vardiff=vardiff+alim_star(ig,l)  &
-     &           *(zqta(ig,l)*1000.-var)**2
-!         ratqsdiff=ratqsdiff+alim_star(ig,l)*
-!     s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-          enddo
-      enddo
-      if (prt_level.ge.1) print*,'14g OK convect8'
-      do l=1,nlay
-         do ig=1,ngrid
-            ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
-!           write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
-         enddo
-      enddo 
-!--------------------------------------------------------------------    
-!
-!ecriture des fichiers sortie
-!     print*,'15 OK convect8'
-
-      if (prt_level.ge.1) print*,'thermcell_main sorties 3D'
-      endif
-
-      if (prt_level.ge.1) print*,'thermcell_main FIN  OK'
-
-!     if(icount.eq.501) stop'au pas 301 dans thermcell_main'
-      return
-      end
-
-!-----------------------------------------------------------------------------
-
-      subroutine testV0_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment)
-      USE print_control_mod, ONLY: prt_level
-      IMPLICIT NONE
-
-      integer i, k, klon,klev
-      real pplev(klon,klev+1),pplay(klon,klev)
-      real ztv(klon,klev)
-      real po(klon,klev)
-      real ztva(klon,klev)
-      real zqla(klon,klev)
-      real f_star(klon,klev)
-      real zw2(klon,klev)
-      integer long(klon)
-      real seuil
-      character*21 comment
-
-      if (prt_level.ge.1) THEN
-       print*,'WARNING !!! TEST ',comment
-      endif
-      return
-
-!  test sur la hauteur des thermiques ...
-         do i=1,klon
-!IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
-           if (prt_level.ge.10) then
-               print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
-               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
-               do k=1,klev
-                  write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
-               enddo
-           endif
-         enddo
-
-
-      return
-      end
-
-!==============================================================================
-      SUBROUTINE thermcellV0_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
-     &   zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out)
-
-!-------------------------------------------------------------------------
-!thermcell_closure: fermeture, determination de f
-!-------------------------------------------------------------------------
-      USE print_control_mod, ONLY: prt_level,lunout
-      IMPLICIT NONE
-
-      include "thermcell.h"
-      INTEGER ngrid,nlay
-      INTEGER ig,k       
-      REAL r_aspect,ptimestep
-      integer lev_out                           ! niveau pour les print
-
-      INTEGER lalim(ngrid)
-      REAL alim_star(ngrid,nlay)
-      REAL alim_star_tot(ngrid)
-      REAL rho(ngrid,nlay)
-      REAL zlev(ngrid,nlay)
-      REAL zmax(ngrid),zmax_sec(ngrid)
-      REAL wmax(ngrid),wmax_sec(ngrid)
-      real zdenom
-
-      REAL alim_star2(ngrid)
-
-      REAL f(ngrid)
-
-      character (len=20) :: modname='thermcellV0_main'
-      character (len=80) :: abort_message
-
-      do ig=1,ngrid
-         alim_star2(ig)=0.
-      enddo
-      do ig=1,ngrid
-         if (alim_star(ig,1).LT.1.e-10) then
-            f(ig)=0.
-         else   
-             do k=1,lalim(ig)
-                alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
-     &                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
-             enddo
-             zdenom=max(500.,zmax(ig))*r_aspect*alim_star2(ig)
-             if (zdenom<1.e-14) then
-                print*,'ig=',ig
-                print*,'alim_star2',alim_star2(ig)
-                print*,'zmax',zmax(ig)
-                print*,'r_aspect',r_aspect
-                print*,'zdenom',zdenom
-                print*,'alim_star',alim_star(ig,:)
-                print*,'zmax_sec',zmax_sec(ig)
-                print*,'wmax_sec',wmax_sec(ig)
-                abort_message = 'zdenom<1.e-14'
-                CALL abort_physic (modname,abort_message,1)
-             endif
-             if ((zmax_sec(ig).gt.1.e-10).and.(iflag_thermals_ed.eq.0)) then 
-             f(ig)=wmax_sec(ig)*alim_star_tot(ig)/(max(500.,zmax_sec(ig))*r_aspect  &
-     &             *alim_star2(ig))
-!            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
-!    &                     zmax_sec(ig))*wmax_sec(ig))
-             if(prt_level.GE.10) write(lunout,*)'closure dry',f(ig),wmax_sec(ig),alim_star_tot(ig),zmax_sec(ig)
-             else
-             f(ig)=wmax(ig)*alim_star_tot(ig)/zdenom
-!            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
-!     &                     zmax(ig))*wmax(ig))
-             if(prt_level.GE.10) print*,'closure moist',f(ig),wmax(ig),alim_star_tot(ig),zmax(ig)
-             endif
-         endif
-!         f0(ig)=f(ig)
-      enddo
-      if (prt_level.ge.1) print*,'apres fermeture'
-
-!
-      return
-      end
-!==============================================================================
-      SUBROUTINE thermcellV0_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot,  &
-     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,w_est,zqsatth,lmix,lmix_bis,linter &
-     &           ,lev_out,lunout1,igout)
-
-!--------------------------------------------------------------------------
-!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
-!--------------------------------------------------------------------------
-
-      USE print_control_mod, ONLY: prt_level
-      IMPLICIT NONE
-
-      include "YOMCST.h"
-      include "YOETHF.h"
-      include "FCTTRE.h"
-      include "thermcell.h"
-
-      INTEGER itap
-      INTEGER lunout1,igout
-      INTEGER ngrid,klev
-      REAL ptimestep
-      REAL ztv(ngrid,klev)
-      REAL zthl(ngrid,klev)
-      REAL po(ngrid,klev)
-      REAL zl(ngrid,klev)
-      REAL rhobarz(ngrid,klev)
-      REAL zlev(ngrid,klev+1)
-      REAL pplev(ngrid,klev+1)
-      REAL pphi(ngrid,klev)
-      REAL zpspsk(ngrid,klev)
-      REAL alim_star(ngrid,klev)
-      REAL zmax_sec(ngrid)
-      REAL f0(ngrid)
-      REAL l_mix
-      REAL r_aspect
-      INTEGER lalim(ngrid)
-      integer lev_out                           ! niveau pour les print
-      real zcon2(ngrid)
-    
-      real alim_star_tot(ngrid)
-
-      REAL ztva(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zqla(ngrid,klev)
-      REAL zqla0(ngrid,klev)
-      REAL zqta(ngrid,klev)
-      REAL zha(ngrid,klev)
-
-      REAL detr_star(ngrid,klev)
-      REAL coefc
-      REAL detr_stara(ngrid,klev)
-      REAL detr_starb(ngrid,klev)
-      REAL detr_starc(ngrid,klev)
-      REAL detr_star0(ngrid,klev)
-      REAL detr_star1(ngrid,klev)
-      REAL detr_star2(ngrid,klev)
-
-      REAL entr_star(ngrid,klev)
-      REAL entr_star1(ngrid,klev)
-      REAL entr_star2(ngrid,klev)
-      REAL detr(ngrid,klev)
-      REAL entr(ngrid,klev)
-
-      REAL zw2(ngrid,klev+1)
-      REAL w_est(ngrid,klev+1)
-      REAL f_star(ngrid,klev+1)
-      REAL wa_moy(ngrid,klev+1)
-
-      REAL ztva_est(ngrid,klev)
-      REAL zqla_est(ngrid,klev)
-      REAL zqsatth(ngrid,klev)
-      REAL zta_est(ngrid,klev)
-
-      REAL linter(ngrid)
-      INTEGER lmix(ngrid)
-      INTEGER lmix_bis(ngrid)
-      REAL    wmaxa(ngrid)
-
-      INTEGER ig,l,k
-
-      real zcor,zdelta,zcvm5,qlbef
-      real Tbef,qsatbef
-      real dqsat_dT,DT,num,denom
-      REAL REPS,RLvCp,DDT0
-      PARAMETER (DDT0=.01)
-      logical Zsat
-      REAL fact_gamma,fact_epsilon
-      REAL c2(ngrid,klev)
-
-      Zsat=.false.
-! Initialisation
-      RLvCp = RLVTT/RCPD
-     
-      if (iflag_thermals_ed==0) then
-         fact_gamma=1.
-         fact_epsilon=1.
-      else if (iflag_thermals_ed==1)  then
-         fact_gamma=1.
-         fact_epsilon=1.
-      else if (iflag_thermals_ed==2)  then
-         fact_gamma=1.
-         fact_epsilon=2.
-      endif
-
-      do l=1,klev
-         do ig=1,ngrid
-            zqla_est(ig,l)=0.
-            ztva_est(ig,l)=ztva(ig,l)
-            zqsatth(ig,l)=0.
-         enddo
-      enddo
-
-!CR: attention test couche alim
-!     do l=2,klev
-!     do ig=1,ngrid
-!        alim_star(ig,l)=0.
-!     enddo
-!     enddo
-!AM:initialisations du thermique
-      do k=1,klev
-         do ig=1,ngrid
-            ztva(ig,k)=ztv(ig,k)
-            ztla(ig,k)=zthl(ig,k)
-            zqla(ig,k)=0.
-            zqta(ig,k)=po(ig,k)
-!
-            ztva(ig,k) = ztla(ig,k)*zpspsk(ig,k)+RLvCp*zqla(ig,k)
-            ztva(ig,k) = ztva(ig,k)/zpspsk(ig,k)
-            zha(ig,k) = ztva(ig,k)
-!
-         enddo
-      enddo 
-      do k=1,klev
-        do ig=1,ngrid
-           detr_star(ig,k)=0.
-           entr_star(ig,k)=0.
-
-           detr_stara(ig,k)=0.
-           detr_starb(ig,k)=0.
-           detr_starc(ig,k)=0.
-           detr_star0(ig,k)=0.
-           zqla0(ig,k)=0.
-           detr_star1(ig,k)=0.
-           detr_star2(ig,k)=0.
-           entr_star1(ig,k)=0.
-           entr_star2(ig,k)=0.
-
-           detr(ig,k)=0.
-           entr(ig,k)=0.
-        enddo
-      enddo
-      if (prt_level.ge.1) print*,'7 OK convect8'
-      do k=1,klev+1
-         do ig=1,ngrid
-            zw2(ig,k)=0.
-            w_est(ig,k)=0.
-            f_star(ig,k)=0.
-            wa_moy(ig,k)=0.
-         enddo
-      enddo
-
-      if (prt_level.ge.1) print*,'8 OK convect8'
-      do ig=1,ngrid
-         linter(ig)=1.
-         lmix(ig)=1
-         lmix_bis(ig)=2
-         wmaxa(ig)=0.
-      enddo
-
-!-----------------------------------------------------------------------------------
-!boucle de calcul de la vitesse verticale dans le thermique
-!-----------------------------------------------------------------------------------
-      do l=1,klev-1
-         do ig=1,ngrid
-
-
-
-! Calcul dans la premiere couche active du thermique (ce qu'on teste
-! en disant que la couche est instable et que w2 en bas de la couche
-! est nulle.
-
-            if (ztv(ig,l).gt.ztv(ig,l+1)  &
-     &         .and.alim_star(ig,l).gt.1.e-10  &
-     &         .and.zw2(ig,l).lt.1e-10) then
-
-
-! Le panache va prendre au debut les caracteristiques de l'air contenu
-! dans cette couche.
-               ztla(ig,l)=zthl(ig,l) 
-               zqta(ig,l)=po(ig,l)
-               zqla(ig,l)=zl(ig,l)
-               f_star(ig,l+1)=alim_star(ig,l)
-
-               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
-     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
-               w_est(ig,l+1)=zw2(ig,l+1)
-!
-
-
-            else if ((zw2(ig,l).ge.1e-10).and.  &
-     &         (f_star(ig,l)+alim_star(ig,l)).gt.1.e-10) then
-!estimation du detrainement a partir de la geometrie du pas precedent
-!tests sur la definition du detr
-!calcul de detr_star et entr_star
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH le test miraculeux de Catherine ? Le bout du tunel ?
-!               w_est(ig,3)=zw2(ig,2)*  &
-!    &                   ((f_star(ig,2))**2)  &
-!    &                   /(f_star(ig,2)+alim_star(ig,2))**2+  &
-!    &                   2.*RG*(ztva(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-!    &                   *(zlev(ig,3)-zlev(ig,2))
-!     if (l.gt.2) then
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-
-! Premier calcul de la vitesse verticale a partir de la temperature
-! potentielle virtuelle
-
-! FH CESTQUOI CA ????
-#define int1d2
-!#undef int1d2
-#ifdef int1d2
-      if (l.ge.2) then
-#else
-      if (l.gt.2) then
-#endif
-
-      if (1.eq.1) then
-          w_est(ig,3)=zw2(ig,2)* &
-     &      ((f_star(ig,2))**2) &
-     &      /(f_star(ig,2)+alim_star(ig,2))**2+ &
-     &      2.*RG*(ztva(ig,2)-ztv(ig,2))/ztv(ig,2) &
-!     &      *1./3. &
-     &      *(zlev(ig,3)-zlev(ig,2))
-       endif
-
-
-!---------------------------------------------------------------------------
-!calcul de l entrainement et du detrainement lateral
-!---------------------------------------------------------------------------
-!
-!test:estimation de ztva_new_est sans entrainement
-
-               Tbef=ztla(ig,l-1)*zpspsk(ig,l)
-               zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-               qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
-               qsatbef=MIN(0.5,qsatbef)
-               zcor=1./(1.-retv*qsatbef)
-               qsatbef=qsatbef*zcor
-               Zsat = (max(0.,zqta(ig,l-1)-qsatbef) .gt. 1.e-10)
-               if (Zsat) then
-               qlbef=max(0.,zqta(ig,l-1)-qsatbef)
-               DT = 0.5*RLvCp*qlbef
-               do while (abs(DT).gt.DDT0)
-                 Tbef=Tbef+DT
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
-                 qsatbef=MIN(0.5,qsatbef)
-                 zcor=1./(1.-retv*qsatbef)
-                 qsatbef=qsatbef*zcor
-                 qlbef=zqta(ig,l-1)-qsatbef
-
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-                 zcor=1./(1.-retv*qsatbef)
-                 dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor)
-                 num=-Tbef+ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*qlbef
-                 denom=1.+RLvCp*dqsat_dT
-                 DT=num/denom
-               enddo
-                 zqla_est(ig,l) = max(0.,zqta(ig,l-1)-qsatbef) 
-               endif
-        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
-     &      -zqla_est(ig,l))-zqla_est(ig,l))
-
-             w_est(ig,l+1)=zw2(ig,l)*  &
-     &                   ((f_star(ig,l))**2)  &
-     &                   /(f_star(ig,l)+alim_star(ig,l))**2+  &
-     &                   2.*RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-!     &                   *1./3. &
-     &                   *(zlev(ig,l+1)-zlev(ig,l))
-             if (w_est(ig,l+1).lt.0.) then
-                w_est(ig,l+1)=zw2(ig,l)
-             endif
-!
-!calcul du detrainement
-!=======================
-
-!CR:on vire les modifs
-         if (iflag_thermals_ed==0) then
-
-! Modifications du calcul du detrainement.
-! Dans la version de la these de Catherine, on passe brusquement
-! de la version seche a la version nuageuse pour le detrainement
-! ce qui peut occasioner des oscillations.
-! dans la nouvelle version, on commence par calculer un detrainement sec.
-! Puis un autre en cas de nuages.
-! Puis on combine les deux lineairement en fonction de la quantite d'eau.
-
-#define int1d3
-!#undef int1d3
-#define RIO_TH
-#ifdef RIO_TH
-!1. Cas non nuageux
-! 1.1 on est sous le zmax_sec et w croit
-          if ((w_est(ig,l+1).gt.w_est(ig,l)).and.  &
-     &       (zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
-#ifdef int1d3
-     &       (zqla_est(ig,l).lt.1.e-10)) then 
-#else
-     &       (zqla(ig,l-1).lt.1.e-10)) then 
-#endif
-             detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1)  &
-     &       *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1))  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l)))  &
-     &       /(r_aspect*zmax_sec(ig)))
-             detr_stara(ig,l)=detr_star(ig,l)
-
-       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l',ig,l
-
-! 1.2 on est sous le zmax_sec et w decroit
-          else if ((zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
-#ifdef int1d3
-     &            (zqla_est(ig,l).lt.1.e-10)) then
-#else
-     &            (zqla(ig,l-1).lt.1.e-10)) then
-#endif
-             detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig))  &
-     &       /(rhobarz(ig,lmix(ig))*wmaxa(ig))*  &
-     &       (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1))  &
-     &       *((zmax_sec(ig)-zlev(ig,l+1))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))  &
-     &       *((zmax_sec(ig)-zlev(ig,l))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.)
-             detr_starb(ig,l)=detr_star(ig,l)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l',ig,l
-
-          else
-
-! 1.3 dans les autres cas
-             detr_star(ig,l)=0.002*f0(ig)*f_star(ig,l)  &
-     &                      *(zlev(ig,l+1)-zlev(ig,l))
-             detr_starc(ig,l)=detr_star(ig,l)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 3 n: ig, l',ig, l
-             
-          endif
-
-#else
-
-! 1.1 on est sous le zmax_sec et w croit
-          if ((w_est(ig,l+1).gt.w_est(ig,l)).and.  &
-     &       (zlev(ig,l+1).lt.zmax_sec(ig)) ) then
-             detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1)  &
-     &       *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1))  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l)))  &
-     &       /(r_aspect*zmax_sec(ig)))
-
-       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l
-
-! 1.2 on est sous le zmax_sec et w decroit
-          else if ((zlev(ig,l+1).lt.zmax_sec(ig)) ) then
-             detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig))  &
-     &       /(rhobarz(ig,lmix(ig))*wmaxa(ig))*  &
-     &       (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1))  &
-     &       *((zmax_sec(ig)-zlev(ig,l+1))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))  &
-     &       *((zmax_sec(ig)-zlev(ig,l))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.)
-       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l
-
-          else
-             detr_star=0.
-          endif
-
-! 1.3 dans les autres cas
-          detr_starc(ig,l)=0.002*f0(ig)*f_star(ig,l)  &
-     &                      *(zlev(ig,l+1)-zlev(ig,l))
-
-          coefc=min(zqla(ig,l-1)/1.e-3,1.)
-          if (zlev(ig,l+1).ge.zmax_sec(ig)) coefc=1.
-          coefc=1.
-! il semble qu'il soit important de baser le calcul sur
-! zqla_est(ig,l-1) plutot que sur zqla_est(ig,l)
-          detr_star(ig,l)=detr_starc(ig,l)*coefc+detr_star(ig,l)*(1.-coefc)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l', ig, l
-
-#endif
-
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 444: ig, l', ig, l
-!IM 730508 beg
-!        if(itap.GE.7200) THEN
-!         print*,'th_plume ig,l,itap,zqla_est=',ig,l,itap,zqla_est(ig,l)
-!        endif
-!IM 730508 end
-         
-         zqla0(ig,l)=zqla_est(ig,l)
-         detr_star0(ig,l)=detr_star(ig,l)
-!IM 060508 beg
-!         if(detr_star(ig,l).GT.1.) THEN
-!          print*,'th_plumeBEF ig l detr_star detr_starc coefc',ig,l,detr_star(ig,l) &
-!   &      ,detr_starc(ig,l),coefc
-!         endif
-!IM 060508 end
-!IM 160508 beg
-!IM 160508       IF (f0(ig).NE.0.) THEN
-           detr_star(ig,l)=detr_star(ig,l)/f0(ig)
-!IM 160508       ELSE IF(detr_star(ig,l).EQ.0.) THEN
-!IM 160508        print*,'WARNING1  : th_plume f0=0, detr_star=0: ig, l, itap',ig,l,itap
-!IM 160508       ELSE
-!IM 160508        print*,'WARNING2  : th_plume f0=0, ig, l, itap, detr_star',ig,l,itap,detr_star(ig,l)
-!IM 160508       ENDIF
-!IM 160508 end
-!IM 060508 beg
-!        if(detr_star(ig,l).GT.1.) THEN
-!         print*,'th_plumeAFT ig l detr_star f0 1/f0',ig,l,detr_star(ig,l),f0(ig), &
-!   &     REAL(1)/f0(ig)
-!        endif
-!IM 060508 end
-        if (prt_level.ge.20) print*,'coucou calcul detr 445: ig, l', ig, l
-!
-!calcul de entr_star
-
-! #undef test2
-! #ifdef test2
-! La version test2 destabilise beaucoup le modele.
-! Il semble donc que ca aide d'avoir un entrainement important sous
-! le nuage.
-!         if (zqla_est(ig,l-1).ge.1.e-10.and.l.gt.lalim(ig)) then
-!          entr_star(ig,l)=0.4*detr_star(ig,l)
-!         else
-!          entr_star(ig,l)=0.
-!         endif
-! #else
-!
-! Deplacement du calcul de entr_star pour eviter d'avoir aussi
-! entr_star > fstar.
-! Redeplacer suite a la transformation du cas detr>f
-! FH
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 446: ig, l', ig, l
-#define int1d
-!FH 070508 #define int1d4
-!#undef int1d4
-! L'option int1d4 correspond au choix dans le cas ou le detrainement
-! devient trop grand.
-
-#ifdef int1d
-
-#ifdef int1d4
-#else
-       detr_star(ig,l)=min(detr_star(ig,l),f_star(ig,l))
-!FH 070508 plus
-       detr_star(ig,l)=min(detr_star(ig,l),1.)
-#endif
-
-       entr_star(ig,l)=max(0.4*detr_star(ig,l)-alim_star(ig,l),0.)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 447: ig, l', ig, l
-#ifdef int1d4
-! Si le detrainement excede le flux en bas + l'entrainement, le thermique
-! doit disparaitre.
-       if (detr_star(ig,l)>f_star(ig,l)+entr_star(ig,l)) then
-          detr_star(ig,l)=f_star(ig,l)+entr_star(ig,l)
-          f_star(ig,l+1)=0.
-          linter(ig)=l+1
-          zw2(ig,l+1)=-1.e-10
-       endif
-#endif
-
-
-#else
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 448: ig, l', ig, l
-        if(l.gt.lalim(ig)) then
-         entr_star(ig,l)=0.4*detr_star(ig,l)
-        else
-
-! FH :
-! Cette ligne doit permettre de garantir qu'on a toujours un flux = 1
-! en haut de la couche d'alimentation.
-! A remettre en questoin a la premiere occasion mais ca peut aider a 
-! ecrire un code robuste.
-! Que ce soit avec ca ou avec l'ancienne facon de faire (e* = 0 mais
-! d* non nul) on a une discontinuité de e* ou d* en haut de la couche
-! d'alimentation, ce qui n'est pas forcement heureux.
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 449: ig, l', ig, l
-#undef pre_int1c
-#ifdef pre_int1c
-         entr_star(ig,l)=max(detr_star(ig,l)-alim_star(ig,l),0.)
-         detr_star(ig,l)=entr_star(ig,l)
-#else
-         entr_star(ig,l)=0.
-#endif
-
-        endif
-
-#endif
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 440: ig, l', ig, l
-        entr_star1(ig,l)=entr_star(ig,l)
-        detr_star1(ig,l)=detr_star(ig,l)
-!
-
-#ifdef int1d
-#else
-        if (detr_star(ig,l).gt.f_star(ig,l)) then
-
-!  Ce test est là entre autres parce qu'on passe par des valeurs
-!  delirantes de detr_star.
-!  ca vaut sans doute le coup de verifier pourquoi.
-
-           detr_star(ig,l)=f_star(ig,l)
-#ifdef pre_int1c
-           if (l.gt.lalim(ig)+1) then
-               entr_star(ig,l)=0.
-               alim_star(ig,l)=0.
-! FH ajout pour forcer a stoper le thermique juste sous le sommet
-! de la couche (voir calcul de finter)
-               zw2(ig,l+1)=-1.e-10
-               linter(ig)=l+1
-            else
-               entr_star(ig,l)=0.4*detr_star(ig,l)
-            endif
-#else
-           entr_star(ig,l)=0.4*detr_star(ig,l)
-#endif
-        endif
-#endif
-
-      else !l > 2
-         detr_star(ig,l)=0.
-         entr_star(ig,l)=0.
-      endif
-
-        entr_star2(ig,l)=entr_star(ig,l)
-        detr_star2(ig,l)=detr_star(ig,l)
-        if (prt_level.ge.20) print*,'coucou calcul detr 450: ig, l', ig, l
-
-       endif  ! iflag_thermals_ed==0
-
-!CR:nvlle def de entr_star et detr_star
-      if (iflag_thermals_ed>=1) then
-!      if (l.lt.lalim(ig)) then
-!      if (l.lt.2) then 
-!        entr_star(ig,l)=0.
-!        detr_star(ig,l)=0.
-!      else
-!      if (0.001.gt.(RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))/(2.*w_est(ig,l+1)))) then 
-!         entr_star(ig,l)=0.001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-!      else
-!         entr_star(ig,l)=  &
-!     &                f_star(ig,l)/(2.*w_est(ig,l+1))        &
-!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))   &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-
- 
-         entr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &          
-     &                f_star(ig,l)/(2.*w_est(ig,l+1))        &
-     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)   &
-     &                *(zlev(ig,l+1)-zlev(ig,l))) &
-     &                +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-
-        if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then
-            alim_star_tot(ig)=alim_star_tot(ig)+entr_star(ig,l)
-            lalim(ig)=lmix_bis(ig)
-            if(prt_level.GE.10) print*,'alim_star_tot',alim_star_tot(ig),entr_star(ig,l)
-        endif
-
-        if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then
-!        c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l))
-         c2(ig,l)=0.001
-         detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &
-     &                c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) &
-     &                -f_star(ig,l)/(2.*w_est(ig,l+1))       &
-     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)       &
-     &                *(zlev(ig,l+1)-zlev(ig,l)))                    &
-     &                +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-
-       else
-!         c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l))
-          c2(ig,l)=0.003
-
-         detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &
-     &                c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) &
-     &                -f_star(ig,l)/(2.*w_est(ig,l+1))       &
-     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)       &
-     &                *(zlev(ig,l+1)-zlev(ig,l))) &
-     &                +0.0002*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-       endif
-         
-           
-!        detr_star(ig,l)=detr_star(ig,l)*3.
-!        if (l.lt.lalim(ig)) then
-!          entr_star(ig,l)=0.
-!        endif
-!        if (l.lt.2) then
-!          entr_star(ig,l)=0.
-!          detr_star(ig,l)=0.
-!        endif
-
-
-!      endif 
-!      else if ((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10) then
-!      entr_star(ig,l)=MAX(0.,0.8*f_star(ig,l)/(2.*w_est(ig,l+1))        &
-!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))   &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      detr_star(ig,l)=0.002*f_star(ig,l)                         &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      else
-!      entr_star(ig,l)=0.001*f_star(ig,l)                         &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      detr_star(ig,l)=MAX(0.,-0.2*f_star(ig,l)/(2.*w_est(ig,l+1))       &
-!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))       &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))                      &
-!     &                +0.002*f_star(ig,l)                             &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      endif
-
-      endif   ! iflag_thermals_ed==1
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH inutile si on conserve comme on l'a fait plus haut entr=detr
-! dans la couche d'alimentation
-!pas d entrainement dans la couche alim
-!      if ((l.le.lalim(ig))) then
-!           entr_star(ig,l)=0.
-!      endif
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!prise en compte du detrainement et de l entrainement dans le calcul du flux
-
-      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
-     &              -detr_star(ig,l)
-
-!test sur le signe de f_star
-        if (prt_level.ge.20) print*,'coucou calcul detr 451: ig, l', ig, l
-       if (f_star(ig,l+1).gt.1.e-10) then 
-!----------------------------------------------------------------------------
-!calcul de la vitesse verticale en melangeant Tl et qt du thermique
-!---------------------------------------------------------------------------
-!
-       Zsat=.false.
-       ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-!
-       zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-!  
-               Tbef=ztla(ig,l)*zpspsk(ig,l)
-               zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-               qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)               
-               qsatbef=MIN(0.5,qsatbef)
-               zcor=1./(1.-retv*qsatbef)
-               qsatbef=qsatbef*zcor
-               Zsat = (max(0.,zqta(ig,l)-qsatbef) .gt. 1.e-10)
-               if (Zsat) then
-               qlbef=max(0.,zqta(ig,l)-qsatbef)
-               DT = 0.5*RLvCp*qlbef
-               do while (abs(DT).gt.DDT0)
-                 Tbef=Tbef+DT
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
-                 qsatbef=MIN(0.5,qsatbef)
-                 zcor=1./(1.-retv*qsatbef)
-                 qsatbef=qsatbef*zcor
-                 qlbef=zqta(ig,l)-qsatbef
-
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-                 zcor=1./(1.-retv*qsatbef)
-                 dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor)
-                 num=-Tbef+ztla(ig,l)*zpspsk(ig,l)+RLvCp*qlbef
-                 denom=1.+RLvCp*dqsat_dT
-                 DT=num/denom
-              enddo
-                 zqla(ig,l) = max(0.,qlbef) 
-              endif
-!    
-        if (prt_level.ge.20) print*,'coucou calcul detr 4512: ig, l', ig, l
-! on ecrit de maniere conservative (sat ou non)
-!          T = Tl +Lv/Cp ql
-           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-           zha(ig,l) = ztva(ig,l)
-           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
-     &              -zqla(ig,l))-zqla(ig,l))
-
-!on ecrit zqsat 
-           zqsatth(ig,l)=qsatbef  
-!calcul de vitesse
-           zw2(ig,l+1)=zw2(ig,l)*  &
-     &                 ((f_star(ig,l))**2)  &
-!  Tests de Catherine
-!     &                 /(f_star(ig,l+1)+detr_star(ig,l))**2+             &
-     &      /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-fact_epsilon))**2+ &
-     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-     &                 *fact_gamma &
-     &                 *(zlev(ig,l+1)-zlev(ig,l))
-!prise en compte des forces de pression que qd flottabilité<0
-!              zw2(ig,l+1)=zw2(ig,l)*  &
-!     &            1./(1.+2.*entr_star(ig,l)/f_star(ig,l)) + &        
-!     &                 (f_star(ig,l))**2 &
-!     &                 /(f_star(ig,l)+entr_star(ig,l))**2+ &
-!     &                 (f_star(ig,l)-2.*entr_star(ig,l))**2/(f_star(ig,l)+2.*entr_star(ig,l))**2+  &        
-!     &                 /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-2.))**2+ &
-!     &                 /(f_star(ig,l)**2+2.*2.*detr_star(ig,l)*f_star(ig,l)+2.*entr_star(ig,l)*f_star(ig,l))+ &
-!     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-!     &                 *1./3. &
-!     &                 *(zlev(ig,l+1)-zlev(ig,l))
-          
-!        write(30,*),l+1,zw2(ig,l+1)-zw2(ig,l), &
-!     &              -2.*entr_star(ig,l)/f_star(ig,l)*zw2(ig,l), &
-!     &               2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-
- 
-!             zw2(ig,l+1)=zw2(ig,l)*  &
-!     &                 (2.-2.*entr_star(ig,l)/f_star(ig,l)) &  
-!     &                 -zw2(ig,l-1)+  &        
-!     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-!     &                 *1./3. &
-!     &                 *(zlev(ig,l+1)-zlev(ig,l))             
-
-            endif
-        endif
-        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
-!
-!initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-                print*,'On tombe sur le cas particulier de thermcell_plume'
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-            endif
-
-!        if ((zw2(ig,l).gt.0.).and. (zw2(ig,l+1).le.0.)) then
-        if (zw2(ig,l+1).lt.0.) then 
-           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-           zw2(ig,l+1)=0.
-        endif
-
-           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
-
-        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-!on rajoute le calcul de lmix_bis
-            if (zqla(ig,l).lt.1.e-10) then
-               lmix_bis(ig)=l+1
-            endif
-            lmix(ig)=l+1
-            wmaxa(ig)=wa_moy(ig,l+1)
-        endif
-        enddo
-      enddo
-
-!on remplace a* par e* ds premiere couche
-!      if (iflag_thermals_ed.ge.1) then
-!       do ig=1,ngrid
-!       do l=2,klev
-!          if (l.lt.lalim(ig)) then
-!             alim_star(ig,l)=entr_star(ig,l)
-!          endif
-!       enddo
-!       enddo
-!       do ig=1,ngrid
-!          lalim(ig)=lmix_bis(ig)
-!       enddo
-!      endif
-       if (iflag_thermals_ed.ge.1) then
-          do ig=1,ngrid
-             do l=2,lalim(ig)
-                alim_star(ig,l)=entr_star(ig,l)
-                entr_star(ig,l)=0.
-             enddo
-           enddo
-       endif
-        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
-
-!     print*,'thermcell_plume OK'
-
-      return 
-      end
-!==============================================================================
-       SUBROUTINE thermcellV0_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
-     &                            lalim,lmin,zmax,wmax,lev_out)
-
-!--------------------------------------------------------------------------
-!thermcell_dry: calcul de zmax et wmax du thermique sec
-!--------------------------------------------------------------------------
-       USE print_control_mod, ONLY: prt_level
-       IMPLICIT NONE
-      include "YOMCST.h"       
-       INTEGER l,ig
-
-       INTEGER ngrid,nlay
-       REAL zlev(ngrid,nlay+1)
-       REAL pphi(ngrid,nlay)
-       REAl ztv(ngrid,nlay)
-       REAL alim_star(ngrid,nlay)
-       INTEGER lalim(ngrid)
-      integer lev_out                           ! niveau pour les print
-
-       REAL zmax(ngrid)
-       REAL wmax(ngrid)
-
-!variables locales
-       REAL zw2(ngrid,nlay+1)
-       REAL f_star(ngrid,nlay+1)
-       REAL ztva(ngrid,nlay+1)
-       REAL wmaxa(ngrid)
-       REAL wa_moy(ngrid,nlay+1)
-       REAL linter(ngrid),zlevinter(ngrid)
-       INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid)
-
-!initialisations
-       do ig=1,ngrid
-          do l=1,nlay+1
-             zw2(ig,l)=0.
-             wa_moy(ig,l)=0.
-          enddo
-       enddo
-       do ig=1,ngrid
-          do l=1,nlay
-             ztva(ig,l)=ztv(ig,l)
-          enddo
-       enddo
-       do ig=1,ngrid
-          wmax(ig)=0.
-          wmaxa(ig)=0.
-       enddo
-!calcul de la vitesse a partir de la CAPE en melangeant thetav
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! A eliminer
-! Ce if complique etait fait pour reperer la premiere couche instable
-! Ici, c'est lmin.
-!
-!       do l=1,nlay-2
-!         do ig=1,ngrid
-!            if (ztv(ig,l).gt.ztv(ig,l+1)  &
-!     &         .and.alim_star(ig,l).gt.1.e-10  &
-!     &         .and.zw2(ig,l).lt.1e-10) then
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-! Calcul des F^*, integrale verticale de E^*
-       f_star(:,1)=0.
-       do l=1,nlay
-          f_star(:,l+1)=f_star(:,l)+alim_star(:,l)
-       enddo
-
-! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise
-       linter(:)=0.
-
-! couche la plus haute concernee par le thermique. 
-       lmax(:)=1
-
-! Le niveau linter est une variable continue qui se trouve dans la couche
-! lmax
-
-       do l=1,nlay-2
-         do ig=1,ngrid
-            if (l.eq.lmin(ig).and.lalim(ig).gt.1) then
-
-!------------------------------------------------------------------------
-!  Calcul de la vitesse en haut de la premiere couche instable.
-!  Premiere couche du panache thermique
-!------------------------------------------------------------------------
-               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
-     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
-
-!------------------------------------------------------------------------
-! Tant que la vitesse en bas de la couche et la somme du flux de masse
-! et de l'entrainement (c'est a dire le flux de masse en haut) sont
-! positifs, on calcul
-! 1. le flux de masse en haut  f_star(ig,l+1)
-! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l)
-! 3. la vitesse au carré en haut zw2(ig,l+1)
-!------------------------------------------------------------------------
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!  A eliminer : dans cette version, si zw2 est > 0 on a un therique.
-!  et donc, au dessus, f_star(ig,l+1) est forcement suffisamment 
-!  grand puisque on n'a pas de detrainement.
-!  f_star est une fonction croissante.
-!  c'est donc vraiment sur zw2 uniquement qu'il faut faire le test.
-!           else if ((zw2(ig,l).ge.1e-10).and.  &
-!    &               (f_star(ig,l)+alim_star(ig,l).gt.1.e-10)) then
-!              f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-            else if (zw2(ig,l).ge.1e-10) then
-
-               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l)  &
-     &                    *ztv(ig,l))/f_star(ig,l+1)
-               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+  &
-     &                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))
-            endif
-! determination de zmax continu par interpolation lineaire
-!------------------------------------------------------------------------
-
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               print*,'On tombe sur le cas particulier de thermcell_dry'
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-                lmax(ig)=l
-            endif
-
-            if (zw2(ig,l+1).lt.0.) then
-               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-               zw2(ig,l+1)=0.
-               lmax(ig)=l
-            endif
-
-               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
-
-            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-               lmix(ig)=l+1
-               wmaxa(ig)=wa_moy(ig,l+1)
-            endif
-         enddo
-      enddo
-       if (prt_level.ge.1) print*,'fin calcul zw2'
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! A eliminer :
-! Ce calcul de lmax est fait en meme temps que celui de linter, plus haut
-! Calcul de la couche correspondant a la hauteur du thermique
-!      do ig=1,ngrid
-!         lmax(ig)=lalim(ig)
-!      enddo
-!      do ig=1,ngrid
-!         do l=nlay,lalim(ig)+1,-1
-!            if (zw2(ig,l).le.1.e-10) then
-!               lmax(ig)=l-1
-!            endif
-!         enddo
-!      enddo
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!    
-! Determination de zw2 max
-      do ig=1,ngrid
-         wmax(ig)=0.
-      enddo
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-                zw2(ig,l)=sqrt(zw2(ig,l))
-                wmax(ig)=max(wmax(ig),zw2(ig,l))
-            else
-                 zw2(ig,l)=0.
-            endif
-          enddo
-      enddo
-
-!   Longueur caracteristique correspondant a la hauteur des thermiques.
-      do  ig=1,ngrid
-         zmax(ig)=0.
-         zlevinter(ig)=zlev(ig,1)
-      enddo
-      do  ig=1,ngrid
-! calcul de zlevinter
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH A eliminer
-! Simplification
-!          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*  &
-!     &    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)  &
-!     &    -zlev(ig,lmax(ig)))
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-          zlevinter(ig)=zlev(ig,lmax(ig)) + &
-     &    (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-           zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-      enddo
-
-! Verification que lalim<=lmax
-      do ig=1,ngrid
-         if(lalim(ig)>lmax(ig)) then
-           if ( prt_level > 1 ) THEN
-            print*,'WARNING thermcell_dry ig=',ig,'  lalim=',lalim(ig),'  lmax(ig)=',lmax(ig)
-           endif
-           lmax(ig)=lalim(ig)
-         endif
-      enddo
-      
-      RETURN
-      END
-!==============================================================================
-      SUBROUTINE thermcellV0_init(ngrid,nlay,ztv,zlay,zlev,  &
-     &                  lalim,lmin,alim_star,alim_star_tot,lev_out)
-
-!----------------------------------------------------------------------
-!thermcell_init: calcul du profil d alimentation du thermique
-!----------------------------------------------------------------------
-      USE print_control_mod, ONLY: prt_level
-      IMPLICIT NONE
-      include "thermcell.h"
-
-      INTEGER l,ig
-!arguments d entree
-      INTEGER ngrid,nlay
-      REAL ztv(ngrid,nlay)
-      REAL zlay(ngrid,nlay)
-      REAL zlev(ngrid,nlay+1)
-!arguments de sortie
-      INTEGER lalim(ngrid)
-      INTEGER lmin(ngrid)
-      REAL alim_star(ngrid,nlay)
-      REAL alim_star_tot(ngrid)
-      integer lev_out                           ! niveau pour les print
-      
-      REAL zzalim(ngrid)
-!CR: ponderation entrainement des couches instables
-!def des alim_star tels que alim=f*alim_star      
-
-      do l=1,nlay
-         do ig=1,ngrid 
-            alim_star(ig,l)=0.
-         enddo
-      enddo
-! determination de la longueur de la couche d entrainement
-      do ig=1,ngrid
-         lalim(ig)=1
-      enddo
-
-      if (iflag_thermals_ed.ge.1) then
-!si la premiÃ¨re couche est instable, on declenche un thermique
-         do ig=1,ngrid
-            if (ztv(ig,1).gt.ztv(ig,2)) then
-               lmin(ig)=1
-               lalim(ig)=2
-               alim_star(ig,1)=1.
-               alim_star_tot(ig)=alim_star(ig,1)
-               if(prt_level.GE.10) print*,'init',alim_star(ig,1),alim_star_tot(ig)
-            else
-                lmin(ig)=1
-                lalim(ig)=1
-                alim_star(ig,1)=0.
-                alim_star_tot(ig)=0. 
-            endif
-         enddo
- 
-         else
-!else iflag_thermals_ed=0 ancienne def de l alim 
-
-!on ne considere que les premieres couches instables
-      do l=nlay-2,1,-1
-         do ig=1,ngrid
-            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
-     &          ztv(ig,l+1).le.ztv(ig,l+2)) then
-               lalim(ig)=l+1
-            endif
-          enddo
-      enddo
-
-! determination du lmin: couche d ou provient le thermique
-
-      do ig=1,ngrid
-! FH initialisation de lmin a nlay plutot que 1.
-!        lmin(ig)=nlay
-         lmin(ig)=1
-      enddo
-      do l=nlay,2,-1
-         do ig=1,ngrid
-            if (ztv(ig,l-1).gt.ztv(ig,l)) then
-               lmin(ig)=l-1
-            endif
-         enddo
-      enddo
-!
-      zzalim(:)=0.
-      do l=1,nlay-1
-         do ig=1,ngrid 
-             if (l<lalim(ig)) then
-                zzalim(ig)=zzalim(ig)+zlay(ig,l)*(ztv(ig,l)-ztv(ig,l+1))
-             endif
-          enddo
-      enddo
-      do ig=1,ngrid
-          if (lalim(ig)>1) then
-             zzalim(ig)=zlay(ig,1)+zzalim(ig)/(ztv(ig,1)-ztv(ig,lalim(ig)))
-          else
-             zzalim(ig)=zlay(ig,1)
-          endif
-      enddo
-
-      if(prt_level.GE.10) print*,'ZZALIM LALIM ',zzalim,lalim,zlay(1,lalim(1))
-
-! definition de l'entrainement des couches
-      if (1.eq.1) then
-      do l=1,nlay-1
-         do ig=1,ngrid 
-            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
-     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
-!def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
-             alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
-     &                       *sqrt(zlev(ig,l+1)) 
-            endif
-         enddo
-      enddo
-      else
-      do l=1,nlay-1
-         do ig=1,ngrid
-            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
-     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
-             alim_star(ig,l)=max(3.*zzalim(ig)-zlay(ig,l),0.) &
-     &        *(zlev(ig,l+1)-zlev(ig,l))
-            endif
-         enddo
-      enddo
-      endif
-      
-! pas de thermique si couche 1 stable
-      do ig=1,ngrid
-!CRnouveau test
-        if (alim_star(ig,1).lt.1.e-10) then 
-            do l=1,nlay
-                alim_star(ig,l)=0.
-            enddo
-            lmin(ig)=1
-         endif
-      enddo 
-! calcul de l alimentation totale
-      do ig=1,ngrid
-         alim_star_tot(ig)=0.
-      enddo
-      do l=1,nlay
-         do ig=1,ngrid
-            alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-         enddo
-      enddo
-!
-! Calcul entrainement normalise
-      do l=1,nlay 
-         do ig=1,ngrid 
-            if (alim_star_tot(ig).gt.1.e-10) then
-               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
-            endif
-         enddo
-      enddo
-       
-!on remet alim_star_tot a 1
-      do ig=1,ngrid 
-         alim_star_tot(ig)=1.
-      enddo
-
-      endif
-!endif iflag_thermals_ed
-      return 
-      end  
-!==============================================================================
+link ../phylmd/thermcellV0_main.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_alim.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_alim.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_alim.F90	(revision 3940)
@@ -1,129 +1,1 @@
-!
-! $Id: thermcell_plume.F90 2311 2015-06-25 07:45:24Z emillour $
-!
-      SUBROUTINE thermcell_alim(flag,ngrid,klev,ztv,d_temp,zlev,alim_star,lalim)
-IMPLICIT NONE
-
-!--------------------------------------------------------------------------
-! FH : 2015/11/06
-! thermcell_alim: calcule la distribution verticale de l'alimentation 
-! laterale a la base des panaches thermiques
-!--------------------------------------------------------------------------
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-
-!      fort(10) ptimestep,ztv,zthl,po,zl,rhobarz,zlev,pplev,pphi,zpspsk,f0
-      INTEGER, INTENT(IN) :: ngrid,klev
-      REAL, INTENT(IN) :: ztv(ngrid,klev)
-      REAL, INTENT(IN) :: d_temp(ngrid)
-      REAL, INTENT(IN) :: zlev(ngrid,klev+1)
-      REAL, INTENT(OUT) :: alim_star(ngrid,klev)
-      INTEGER, INTENT(OUT) :: lalim(ngrid)
-      INTEGER, INTENT(IN) :: flag
-
-      REAL :: alim_star_tot(ngrid),zi(ngrid),zh(ngrid)
-      REAL :: zlay(ngrid,klev)
-      REAL ztv_parcel
-
-      INTEGER ig,l
-
-      REAL h,z,falim
-      falim(h,z)=0.2*((z-h)**5+h**5)
-
-
-!===================================================================
-
-   lalim(:)=1
-   alim_star_tot(:)=0.
-
-!-------------------------------------------------------------------------
-! Definition de l'alimentation a l'origine dans thermcell_init
-!-------------------------------------------------------------------------
-   IF (flag==0) THEN ! CMIP5 version
-      do l=1,klev-1
-         do ig=1,ngrid
-            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
-               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
-     &                       *sqrt(zlev(ig,l+1)) 
-               lalim(ig)=l+1
-               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-            endif
-         enddo
-      enddo
-      do l=1,klev
-         do ig=1,ngrid 
-            if (alim_star_tot(ig) > 1.e-10 ) then
-               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
-            endif
-         enddo
-      enddo
-      alim_star_tot(:)=1.
-
-!-------------------------------------------------------------------------
-! Nouvelle definition avec possibilite d'introduire un DT en surface
-! On suppose que la forme du profile d'alimentation scale avec la hauteur
-! d'inversion calculée avec une particule partant de la premieere couche
-
-! Fonction  f(z) = z ( h - z ) , avec h = zi/3
-! On utilise l'integralle
-! Int_0^z f(z') dz' = z^2 ( h/2 - z/3 ) = falim(h,z)
-! Pour calculer l'alimentation des couches
-!-------------------------------------------------------------------------
-   ELSE
-! Computing inversion height zi and zh=zi/3.
-      zi(:)=0.
-! Il faut recalculer zlay qui n'est pas dispo dans thermcell_plume
-! A changer eventuellement.
-      do l=1,klev
-         zlay(:,l)=0.5*(zlev(:,l)+zlev(:,l+1))
-      enddo
-
-      do l=klev-1,1,-1
-         do ig=1,ngrid
-            ztv_parcel=ztv(ig,1)+d_temp(ig)
-            if (ztv_parcel<ztv(ig,l+1)) lalim(ig)=l
-         enddo
-      enddo
-
-      do ig=1,ngrid
-         l=lalim(ig)
-         IF (l==1) THEN
-            zi(ig)=0.
-         ELSE
-            ztv_parcel=ztv(ig,1)+d_temp(ig)
-            zi(ig)=zlay(ig,l)+(zlay(ig,l+1)-zlay(ig,l))/(ztv(ig,l+1)-ztv(ig,l))*(ztv_parcel-ztv(ig,l))
-         ENDIF
-      enddo
-
-      zh(:)=zi(:)/2.
-      alim_star_tot(:)=0.
-      alim_star(:,:)=0.
-      lalim(:)=0
-      do l=1,klev-1
-         do ig=1,ngrid
-            IF (zh(ig)==0.) THEN
-               alim_star(ig,l)=0.
-               lalim(ig)=1
-            ELSE IF (zlev(ig,l+1)<=zh(ig)) THEN
-               alim_star(ig,l)=(falim(zh(ig),zlev(ig,l+1))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
-               lalim(ig)=l
-            ELSE IF (zlev(ig,l)<=zh(ig)) THEN
-               alim_star(ig,l)=(falim(zh(ig),zh(ig))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
-               lalim(ig)=l
-            ELSE
-               alim_star(ig,l)=0.
-            ENDIF
-         ENDDO
-         alim_star_tot(:)=alim_star_tot(:)+alim_star(:,l)
-      ENDDO
-      IF (ngrid==1) print*,'NEW ALIM CALCUL DE ZI ',alim_star_tot,lalim,zi,zh
-      alim_star_tot(:)=1.
-
-   ENDIF
-
-
-RETURN
-END
+link ../phylmd/thermcell_alim.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_alp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_alp.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_alp.F90	(revision 3940)
@@ -1,475 +1,1 @@
-! $Id: thermcell_main.F90 2351 2015-08-25 15:14:59Z emillour $
-!
-      SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep  &
-     &                  ,pplay,pplev  &
-     &                  ,fm0,entr0,lmax  &
-     &                  ,ale_bl,alp_bl,lalim_conv,wght_th &
-     &                  ,zw2,fraca &
-!!! ncessaire en plus
-     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
-!!! nrlmd le 10/04/2012
-     &                  ,pbl_tke,pctsrf,omega,airephy &
-     &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
-     &                  ,n2,s2,ale_bl_stat &
-     &                  ,therm_tke_max,env_tke_max &
-     &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
-     &                  ,alp_bl_conv,alp_bl_stat &
-!!! fin nrlmd le 10/04/2012
-     &)
-
-      USE dimphy
-      USE indice_sol_mod
-      IMPLICIT NONE
-
-!=======================================================================
-!   Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
-!   Version du 09.02.07
-!   Calcul du transport vertical dans la couche limite en presence
-!   de "thermiques" explicitement representes avec processus nuageux
-!
-!   Reecriture a partir d'un listing papier a Habas, le 14/02/00
-!
-!   le thermique est suppose homogene et dissipe par melange avec
-!   son environnement. la longueur l_mix controle l'efficacite du
-!   melange
-!
-!   Le calcul du transport des differentes especes se fait en prenant
-!   en compte:
-!     1. un flux de masse montant
-!     2. un flux de masse descendant
-!     3. un entrainement
-!     4. un detrainement
-!
-! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
-!    Introduction of an implicit computation of vertical advection in
-!    the environment of thermal plumes in thermcell_dq
-!    impl =     0 : explicit, 1 : implicit, -1 : old version
-!    controled by iflag_thermals =
-!       15, 16 run with impl=-1 : numerical convergence with NPv3
-!       17, 18 run with impl=1  : more stable
-!    15 and 17 correspond to the activation of the stratocumulus "bidouille"
-!
-!=======================================================================
-!-----------------------------------------------------------------------
-!   declarations:
-!   -------------
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-
-!   arguments:
-!   ----------
-
-!IM 140508
-
-      INTEGER ngrid,nlay
-      real ptimestep
-      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
-
-!   local:
-!   ------
-
-
-      REAL susqr2pi, reuler
-
-      INTEGER ig,k,l
-      INTEGER lmax(klon),lalim(klon)
-      real zmax(klon),zw2(klon,klev+1)
-
-!on garde le zmax du pas de temps precedent
-
-
-      real fraca(klon,klev+1)
-      real wth3(klon,klev)
-! FH probleme de dimensionnement avec l'allocation dynamique
-!     common/comtherm/thetath2,wth2
-      real rhobarz(klon,klev)
-
-      real wmax_sec(klon)
-      real fm0(klon,klev+1),entr0(klon,klev)
-      real fm(klon,klev+1)
-
-!niveau de condensation
-      real pcon(klon)
-
-      real alim_star(klon,klev)
-
-!!! nrlmd le 10/04/2012
-
-!------Entrées
-      real pbl_tke(klon,klev+1,nbsrf)
-      real pctsrf(klon,nbsrf)
-      real omega(klon,klev)
-      real airephy(klon)
-!------Sorties
-      real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon)
-      real therm_tke_max0(klon),env_tke_max0(klon)
-      real n2(klon),s2(klon)
-      real ale_bl_stat(klon)
-      real therm_tke_max(klon,klev),env_tke_max(klon,klev)
-      real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
-!------Local
-      integer nsrf
-      real rhobarz0(klon)                    ! Densité au LCL
-      logical ok_lcl(klon)                   ! Existence du LCL des thermiques
-      integer klcl(klon)                     ! Niveau du LCL
-      real interp(klon)                      ! Coef d'interpolation pour le LCL
-!--Triggering
-      real Su                                ! Surface unité: celle d'un updraft élémentaire
-      parameter(Su=4e4)
-      real hcoef                             ! Coefficient directeur pour le calcul de s2
-      parameter(hcoef=1)
-      real hmincoef                          ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2 
-      parameter(hmincoef=0.3)
-      real eps1                              ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
-      parameter(eps1=0.3)
-      real hmin(ngrid)                       ! Ordonnée à l'origine pour le calcul de s2
-      real zmax_moy(ngrid)                   ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
-      real zmax_moy_coef
-      parameter(zmax_moy_coef=0.33)
-      real depth(klon)                       ! Epaisseur moyenne du cumulus
-      real w_max(klon)                       ! Vitesse max statistique 
-      real s_max(klon)
-!--Closure
-      real pbl_tke_max(klon,klev)            ! Profil de TKE moyenne 
-      real pbl_tke_max0(klon)                ! TKE moyenne au LCL
-      real w_ls(klon,klev)                   ! Vitesse verticale grande échelle (m/s)
-      real coef_m                            ! On considère un rendement pour alp_bl_fluct_m
-      parameter(coef_m=1.)
-      real coef_tke                          ! On considère un rendement pour alp_bl_fluct_tke
-      parameter(coef_tke=1.)
-
-!!! fin nrlmd le 10/04/2012
-
-!
-      !nouvelles variables pour la convection
-      real ale_bl(klon)
-      real alp_bl(klon)
-      real alp_int(klon),dp_int(klon),zdp
-      real fm_tot(klon)
-      real wght_th(klon,klev)
-      integer lalim_conv(klon)
-!v1d     logical therm
-!v1d     save therm
-
-
-!------------------------------------------------------------
-!  Initialize output arrays related to stochastic triggering
-!------------------------------------------------------------
-  DO ig = 1,klon
-     zlcl(ig) = 0.
-     fraca0(ig) = 0.
-     w0(ig) = 0.
-     w_conv(ig) = 0.
-     therm_tke_max0(ig) = 0.
-     env_tke_max0(ig) = 0.
-     n2(ig) = 0.
-     s2(ig) = 0.
-     ale_bl_stat(ig) = 0.
-     alp_bl_det(ig) = 0.
-     alp_bl_fluct_m(ig) = 0.
-     alp_bl_fluct_tke(ig) = 0.
-     alp_bl_conv(ig) = 0.
-     alp_bl_stat(ig) = 0.
-  ENDDO
-  DO l = 1,klev
-    DO ig = 1,klon
-     therm_tke_max(ig,l) = 0.
-     env_tke_max(ig,l) = 0.
-    ENDDO
-  ENDDO
-!------------------------------------------------------------
-
-
-!------------Test sur le LCL des thermiques
-    do ig=1,ngrid
-      ok_lcl(ig)=.false.
-      if ( (pcon(ig) .gt. pplay(ig,klev-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true.
-    enddo
-
-!------------Localisation des niveaux entourant le LCL et du coef d'interpolation
-    do l=1,nlay-1
-      do ig=1,ngrid
-        if (ok_lcl(ig)) then 
-!ATTENTION,zw2 calcule en pplev
-!          if ((pplay(ig,l) .ge. pcon(ig)) .and. (pplay(ig,l+1) .le. pcon(ig))) then
-!          klcl(ig)=l
-!          interp(ig)=(pcon(ig)-pplay(ig,klcl(ig)))/(pplay(ig,klcl(ig)+1)-pplay(ig,klcl(ig)))
-!          endif
-          if ((pplev(ig,l) .ge. pcon(ig)) .and. (pplev(ig,l+1) .le. pcon(ig))) then
-          klcl(ig)=l
-          interp(ig)=(pcon(ig)-pplev(ig,klcl(ig)))/(pplev(ig,klcl(ig)+1)-pplev(ig,klcl(ig)))
-          endif
-        endif
-      enddo
-    enddo
-
-!------------Hauteur des thermiques
-!!jyg le 27/04/2012
-!!    do ig =1,ngrid
-!!    rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
-!! &               -rhobarz(ig,klcl(ig)))*interp(ig)
-!!    zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)
-!!      if ( (.not.ok_lcl(ig)) .or. (zlcl(ig).gt.zmax(ig)) ) zlcl(ig)=zmax(ig) ! Si zclc > zmax alors on pose zlcl = zmax
-!!    enddo
-    do ig =1,ngrid
-!CR:REHABILITATION ZMAX CONTINU
-     if (ok_lcl(ig)) then 
-      rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
- &               -rhobarz(ig,klcl(ig)))*interp(ig)
-      zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)
-      zlcl(ig)=min(zlcl(ig),zmax(ig))   ! Si zlcl > zmax alors on pose zlcl = zmax
-     else
-      rhobarz0(ig)=0.
-      zlcl(ig)=zmax(ig)
-     endif
-    enddo
-!!jyg fin
-
-!------------Calcul des propriétés du thermique au LCL 
-  IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) THEN 
-
-  !-----Initialisation de la TKE moyenne 
-   do l=1,nlay
-    do ig=1,ngrid
-     pbl_tke_max(ig,l)=0.
-    enddo
-   enddo
-
-!-----Calcul de la TKE moyenne 
-   do nsrf=1,nbsrf
-    do l=1,nlay
-     do ig=1,ngrid
-     pbl_tke_max(ig,l)=pctsrf(ig,nsrf)*pbl_tke(ig,l,nsrf)+pbl_tke_max(ig,l)
-     enddo
-    enddo
-   enddo
-
-!-----Initialisations des TKE dans et hors des thermiques 
-   do l=1,nlay
-    do ig=1,ngrid
-    therm_tke_max(ig,l)=pbl_tke_max(ig,l)
-    env_tke_max(ig,l)=pbl_tke_max(ig,l)
-    enddo
-   enddo
-
-!-----Calcul de la TKE transportée par les thermiques : therm_tke_max
-   call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &
-  &           rg,pplev,therm_tke_max)
-!   print *,' thermcell_tke_transport -> '   !!jyg
-
-!-----Calcul des profils verticaux de TKE hors thermiques : env_tke_max, et de la vitesse verticale grande échelle : W_ls
-   do l=1,nlay
-    do ig=1,ngrid
-     pbl_tke_max(ig,l)=fraca(ig,l)*therm_tke_max(ig,l)+(1.-fraca(ig,l))*env_tke_max(ig,l)         !  Recalcul de TKE moyenne aprés transport de TKE_TH
-     env_tke_max(ig,l)=(pbl_tke_max(ig,l)-fraca(ig,l)*therm_tke_max(ig,l))/(1.-fraca(ig,l))       !  Recalcul de TKE dans  l'environnement aprés transport de TKE_TH
-     w_ls(ig,l)=-1.*omega(ig,l)/(RG*rhobarz(ig,l))                                                !  Vitesse verticale de grande échelle
-    enddo
-   enddo
-!    print *,' apres w_ls = '   !!jyg
-
-  do ig=1,ngrid
-   if (ok_lcl(ig)) then
-     fraca0(ig)=fraca(ig,klcl(ig))+(fraca(ig,klcl(ig)+1) &
- &             -fraca(ig,klcl(ig)))*interp(ig)
-     w0(ig)=zw2(ig,klcl(ig))+(zw2(ig,klcl(ig)+1) &
- &         -zw2(ig,klcl(ig)))*interp(ig)
-     w_conv(ig)=w_ls(ig,klcl(ig))+(w_ls(ig,klcl(ig)+1) &
- &             -w_ls(ig,klcl(ig)))*interp(ig)
-     therm_tke_max0(ig)=therm_tke_max(ig,klcl(ig)) &
- &                     +(therm_tke_max(ig,klcl(ig)+1)-therm_tke_max(ig,klcl(ig)))*interp(ig)
-     env_tke_max0(ig)=env_tke_max(ig,klcl(ig))+(env_tke_max(ig,klcl(ig)+1) &
- &                   -env_tke_max(ig,klcl(ig)))*interp(ig)
-     pbl_tke_max0(ig)=pbl_tke_max(ig,klcl(ig))+(pbl_tke_max(ig,klcl(ig)+1) &
- &                   -pbl_tke_max(ig,klcl(ig)))*interp(ig)
-     if (therm_tke_max0(ig).ge.20.) therm_tke_max0(ig)=20.
-     if (env_tke_max0(ig).ge.20.) env_tke_max0(ig)=20.
-     if (pbl_tke_max0(ig).ge.20.) pbl_tke_max0(ig)=20.
-   else 
-     fraca0(ig)=0.
-     w0(ig)=0.
-!!jyg le 27/04/2012
-!!     zlcl(ig)=0.
-!!
-   endif
-  enddo
-
-  ENDIF ! IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) )
-!  print *,'ENDIF  ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) '    !!jyg
-
-!------------Triggering------------------
-  IF (iflag_trig_bl.ge.1) THEN 
-
-!-----Initialisations
-   depth(:)=0.
-   n2(:)=0.
-   s2(:)=100. ! some low value, arbitrary
-   s_max(:)=0.
-
-!-----Epaisseur du nuage (depth) et détermination de la queue du spectre de panaches (n2,s2) et du panache le plus gros (s_max)
-   do ig=1,ngrid
-     zmax_moy(ig)=zlcl(ig)+zmax_moy_coef*(zmax(ig)-zlcl(ig))
-     depth(ig)=zmax_moy(ig)-zlcl(ig)
-     hmin(ig)=hmincoef*zlcl(ig)
-     if (depth(ig).ge.10.) then 
-       s2(ig)=(hcoef*depth(ig)+hmin(ig))**2
-       n2(ig)=(1.-eps1)*fraca0(ig)*airephy(ig)/s2(ig)
-!!
-!!jyg le 27/04/2012
-!!       s_max(ig)=s2(ig)*log(n2(ig))
-!!       if (n2(ig) .lt. 1) s_max(ig)=0.
-       s_max(ig)=s2(ig)*log(max(n2(ig),1.))
-!!fin jyg
-     else
-       n2(ig)=0.
-       s_max(ig)=0.
-     endif
-   enddo
-!   print *,'avant Calcul de Wmax '    !!jyg
-
-!-----Calcul de Wmax et ALE_BL_STAT associée
-!!jyg le 30/04/2012
-!!   do ig=1,ngrid
-!!     if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.1.) ) then
-!!     w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/su)-log(2.*3.14)-log(2.*log(s_max(ig)/su)-log(2.*3.14))))
-!!     ale_bl_stat(ig)=0.5*w_max(ig)**2
-!!     else
-!!     w_max(ig)=0.
-!!     ale_bl_stat(ig)=0.
-!!     endif
-!!   enddo
-   susqr2pi=su*sqrt(2.*Rpi)
-   reuler=exp(1.)
-   do ig=1,ngrid
-     if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.susqr2pi*reuler) ) then
-      w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/susqr2pi)-log(2.*log(s_max(ig)/susqr2pi))))
-      ale_bl_stat(ig)=0.5*w_max(ig)**2
-     else
-      w_max(ig)=0.
-      ale_bl_stat(ig)=0.
-     endif
-   enddo
-
-  ENDIF ! iflag_trig_bl
-!  print *,'ENDIF  iflag_trig_bl'    !!jyg
-
-!------------Closure------------------
-
-  IF (iflag_clos_bl.ge.2) THEN 
-
-!-----Calcul de ALP_BL_STAT
-  do ig=1,ngrid
-  alp_bl_det(ig)=0.5*coef_m*rhobarz0(ig)*(w0(ig)**3)*fraca0(ig)*(1.-2.*fraca0(ig))/((1.-fraca0(ig))**2)
-  alp_bl_fluct_m(ig)=1.5*rhobarz0(ig)*fraca0(ig)*(w_conv(ig)+coef_m*w0(ig))* &
- &                   (w0(ig)**2)
-  alp_bl_fluct_tke(ig)=3.*coef_m*rhobarz0(ig)*w0(ig)*fraca0(ig)*(therm_tke_max0(ig)-env_tke_max0(ig)) &
- &                    +3.*rhobarz0(ig)*w_conv(ig)*pbl_tke_max0(ig)
-    if (iflag_clos_bl.ge.2) then 
-    alp_bl_conv(ig)=1.5*coef_m*rhobarz0(ig)*fraca0(ig)*(fraca0(ig)/(1.-fraca0(ig)))*w_conv(ig)* &
- &                   (w0(ig)**2)
-    else
-    alp_bl_conv(ig)=0.
-    endif
-  alp_bl_stat(ig)=alp_bl_det(ig)+alp_bl_fluct_m(ig)+alp_bl_fluct_tke(ig)+alp_bl_conv(ig)
-  enddo
-
-!-----Sécurité ALP infinie
-  do ig=1,ngrid
-   if (fraca0(ig).gt.0.98) alp_bl_stat(ig)=2.
-  enddo
-
-  ENDIF ! (iflag_clos_bl.ge.2)
-
-!!! fin nrlmd le 10/04/2012
-
-!      print*,'avant calcul ale et alp' 
-!calcul de ALE et ALP pour la convection
-      alp_bl(:)=0.
-      ale_bl(:)=0.
-!          print*,'ALE,ALP ,l,zw2(ig,l),ale_bl(ig),alp_bl(ig)'
-      do l=1,nlay
-      do ig=1,ngrid
-           alp_bl(ig)=max(alp_bl(ig),0.5*rhobarz(ig,l)*wth3(ig,l) )
-           ale_bl(ig)=max(ale_bl(ig),0.5*zw2(ig,l)**2)
-!          print*,'ALE,ALP',l,zw2(ig,l),ale_bl(ig),alp_bl(ig)
-      enddo
-      enddo
-
-! ale sec (max de wmax/2 sous la zone d'inhibition) dans
-! le cas iflag_trig_bl=3
-      IF (iflag_trig_bl==3) ale_bl(:)=0.5*wmax_sec(:)**2
-
-!test:calcul de la ponderation des couches pour KE
-!initialisations
-
-      fm_tot(:)=0.
-      wght_th(:,:)=1.
-      lalim_conv(:)=lalim(:)
-
-      do k=1,klev
-         do ig=1,ngrid
-            if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k)
-         enddo
-      enddo
-
-! assez bizarre car, si on est dans la couche d'alim et que alim_star et
-! plus petit que 1.e-10, on prend wght_th=1.
-      do k=1,klev
-         do ig=1,ngrid
-            if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) then
-               wght_th(ig,k)=alim_star(ig,k)
-            endif
-         enddo
-      enddo
-
-!      print*,'apres wght_th'
-!test pour prolonger la convection
-      do ig=1,ngrid
-!v1d  if ((alim_star(ig,1).lt.1.e-10).and.(therm)) then
-      if ((alim_star(ig,1).lt.1.e-10)) then
-      lalim_conv(ig)=1
-      wght_th(ig,1)=1.
-!      print*,'lalim_conv ok',lalim_conv(ig),wght_th(ig,1)
-      endif
-      enddo
-
-!------------------------------------------------------------------------
-! Modif CR/FH 20110310 : alp integree sur la verticale.
-! Integrale verticale de ALP.
-! wth3 etant aux niveaux inter-couches, on utilise d play comme masse des
-! couches
-!------------------------------------------------------------------------
-
-      alp_int(:)=0.
-      dp_int(:)=0.
-      do l=2,nlay
-        do ig=1,ngrid
-           if(l.LE.lmax(ig)) THEN
-           zdp=pplay(ig,l-1)-pplay(ig,l)
-           alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l)*zdp
-           dp_int(ig)=dp_int(ig)+zdp
-           endif
-        enddo
-      enddo
-
-      if (iflag_coupl>=3 .and. iflag_coupl<=5) then
-      do ig=1,ngrid
-!valeur integree de alp_bl * 0.5:
-        if (dp_int(ig)>0.) then
-        alp_bl(ig)=alp_int(ig)/dp_int(ig)
-        endif
-      enddo!
-      endif
-
-
-! Facteur multiplicatif sur alp_bl
-      alp_bl(:)=alp_bl_k*alp_bl(:)
-
-!------------------------------------------------------------------------
-
-
-
-      return
-      end
+link ../phylmd/thermcell_alp.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_closure.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_closure.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_closure.F90	(revision 3940)
@@ -1,81 +1,1 @@
-!
-! $Header$
-!
-      SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
-     &   zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out)
-
-!-------------------------------------------------------------------------
-!thermcell_closure: fermeture, determination de f
-!
-! Modification 7 septembre 2009
-! 1. On enleve alim_star_tot des arguments pour le recalculer et etre ainis
-! coherent avec l'integrale au numerateur.
-! 2. On ne garde qu'une version des couples wmax,zmax et wmax_sec,zmax_sec
-! l'idee etant que le choix se fasse a l'appel de thermcell_closure
-! 3. Vectorisation en mettant les boucles en l l'exterieur avec des if
-!-------------------------------------------------------------------------
-      IMPLICIT NONE
-
-#include "thermcell.h"
-INTEGER ngrid,nlay
-INTEGER ig,k       
-REAL r_aspect,ptimestep
-integer lev_out                           ! niveau pour les print
-
-INTEGER lalim(ngrid)
-REAL alim_star(ngrid,nlay)
-REAL f_star(ngrid,nlay+1)
-REAL rho(ngrid,nlay)
-REAL zlev(ngrid,nlay)
-REAL zmax(ngrid)
-REAL wmax(ngrid)
-REAL zdenom(ngrid)
-REAL alim_star2(ngrid)
-REAL f(ngrid)
-
-REAL alim_star_tot(ngrid)
-INTEGER llmax
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!print*,'THERMCELL CLOSURE 26E'
-
-alim_star2(:)=0.
-alim_star_tot(:)=0.
-f(:)=0.
-
-! Indice vertical max (max de lalim) atteint par les thermiques sur le domaine
-llmax=1
-do ig=1,ngrid
-   if (lalim(ig)>llmax) llmax=lalim(ig)
-enddo
-
-
-! Calcul des integrales sur la verticale de alim_star et de
-!   alim_star^2/(rho dz)
-do k=1,llmax-1
-   do ig=1,ngrid
-      if (k<lalim(ig)) then
-         alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
-&                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
-         alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,k)
-      endif
-   enddo
-enddo
-
-
-do ig=1,ngrid
-   if (alim_star2(ig)>1.e-10) then
-      f(ig)=wmax(ig)*alim_star_tot(ig)/  &
-&     (max(500.,zmax(ig))*r_aspect*alim_star2(ig))
-   endif
-enddo
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! TESTS POUR UNE NOUVELLE FERMETURE DANS LAQUELLE ALIM_STAR NE SERAIT
-! PAS NORMALISE
-!           f(ig)=f(ig)*f_star(ig,2)/(f_star(ig,lalim(ig)))
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      return
-      end
+link ../phylmd/thermcell_closure.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_condens.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_condens.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_condens.F90	(revision 3940)
@@ -1,83 +1,1 @@
-subroutine thermcell_condens(klon,active,zpspsk,pplev,ztla,zqta,zqla)
-implicit none
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-
-
-!====================================================================
-! DECLARATIONS
-!====================================================================
-
-! Arguments
-INTEGER klon
-REAL zpspsk(klon),pplev(klon)
-REAL ztla(klon),zqta(klon),zqla(klon)
-LOGICAL active(klon)
-
-! Variables locales
-INTEGER ig,iter
-REAL Tbef(klon),DT(klon)
-REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
-logical Zsat
-REAL RLvCp
-REAL, SAVE :: DDT0=.01
-  !$OMP THREADPRIVATE(DDT0)
-
-LOGICAL afaire(klon),tout_converge
-
-!====================================================================
-! INITIALISATIONS
-!====================================================================
-
-RLvCp = RLVTT/RCPD
-tout_converge=.false.
-afaire(:)=.false.
-DT(:)=0.
-
-
-!====================================================================
-! Routine a vectoriser en copiant active dans converge et en mettant
-! la boucle sur les iterations a l'exterieur est en mettant
-! converge= false des que la convergence est atteinte.
-!====================================================================
-
-do ig=1,klon
-   if (active(ig)) then
-               Tbef(ig)=ztla(ig)*zpspsk(ig)
-               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-               qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
-               qsatbef=MIN(0.5,qsatbef)
-               zcor=1./(1.-retv*qsatbef)
-               qsatbef=qsatbef*zcor
-               qlbef=max(0.,zqta(ig)-qsatbef)
-               DT(ig) = 0.5*RLvCp*qlbef
-     endif
-enddo
-
-do iter=1,10
-    afaire(:)=abs(DT(:)).gt.DDT0
-    do ig=1,klon
-               if (afaire(ig)) then
-                 Tbef(ig)=Tbef(ig)+DT(ig)
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-                 qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
-                 qsatbef=MIN(0.5,qsatbef)
-                 zcor=1./(1.-retv*qsatbef)
-                 qsatbef=qsatbef*zcor
-                 qlbef=zqta(ig)-qsatbef
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-                 zcor=1./(1.-retv*qsatbef)
-                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor)
-                 num=-Tbef(ig)+ztla(ig)*zpspsk(ig)+RLvCp*qlbef
-                 denom=1.+RLvCp*dqsat_dT
-                 zqla(ig) = max(0.,zqta(ig)-qsatbef) 
-                 DT(ig)=num/denom
-               endif
-    enddo
-enddo
-
-return
-end
+link ../phylmd/thermcell_condens.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_dq.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_dq.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_dq.F90	(revision 3940)
@@ -1,323 +1,1 @@
-      subroutine thermcell_dq(ngrid,nlay,impl,ptimestep,fm,entr,  &
-     &           masse,q,dq,qa,lev_out)
-      USE print_control_mod, ONLY: prt_level
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
-!  Introduction of an implicit computation of vertical advection in
-!  the environment of thermal plumes in thermcell_dq
-!  impl =     0 : explicit, 1 : implicit, -1 : old version
-!
-!=======================================================================
-
-      integer ngrid,nlay,impl
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay)
-      real q(ngrid,nlay)
-      real dq(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
-
-      real zzm
-
-      integer ig,k
-      real cfl
-
-      real qold(ngrid,nlay),fqa(ngrid,nlay+1)
-      integer niter,iter
-      CHARACTER (LEN=20) :: modname='thermcell_dq'
-      CHARACTER (LEN=80) :: abort_message
-
-
-! Old explicite scheme
-      if (impl<=-1) then
-         call thermcell_dq_o(ngrid,nlay,impl,ptimestep,fm,entr,  &
-     &           masse,q,dq,qa,lev_out)
-         return
-      endif
-
-! Calcul du critere CFL pour l'advection dans la subsidence
-      cfl = 0.
-      do k=1,nlay
-         do ig=1,ngrid
-            zzm=masse(ig,k)/ptimestep
-            cfl=max(cfl,fm(ig,k)/zzm)
-            if (entr(ig,k).gt.zzm) then
-               print*,'entr*dt>m,1',k,entr(ig,k)*ptimestep,masse(ig,k)
-               abort_message = 'entr dt > m, 1st'
-               CALL abort_physic (modname,abort_message,1)
-            endif
-         enddo
-      enddo
-
-      qold=q
-
-
-      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
-
-!   calcul du detrainement
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-!           print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
-!test
-            if (detr(ig,k).lt.0.) then
-               entr(ig,k)=entr(ig,k)-detr(ig,k)
-               detr(ig,k)=0.
-!               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
-!     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
-            endif
-            if (fm(ig,k+1).lt.0.) then
-!               print*,'fm2<0!!!'
-            endif
-            if (entr(ig,k).lt.0.) then
-!               print*,'entr2<0!!!'
-            endif
-         enddo
-      enddo
-
-! Computation of tracer concentrations in the ascending plume
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
-     &         /(fm(ig,k+1)+detr(ig,k))
-            else
-               qa(ig,k)=q(ig,k)
-            endif
-            if (qa(ig,k).lt.0.) then
-!               print*,'qa<0!!!'
-            endif
-            if (q(ig,k).lt.0.) then
-!               print*,'q<0!!!'
-            endif
-         enddo
-      enddo
-
-! Plume vertical flux
-      do k=2,nlay-1
-         fqa(:,k)=fm(:,k)*qa(:,k-1)
-      enddo
-      fqa(:,1)=0. ; fqa(:,nlay)=0.
-
-
-! Trace species evolution
-   if (impl==0) then
-      do k=1,nlay-1
-         q(:,k)=q(:,k)+(fqa(:,k)-fqa(:,k+1)-fm(:,k)*q(:,k)+fm(:,k+1)*q(:,k+1)) &
-     &               *ptimestep/masse(:,k)
-      enddo
-   else
-      do k=nlay-1,1,-1
-! FH debut de modif : le calcul ci dessous modifiait numériquement
-! la concentration quand le flux de masse etait nul car on divisait
-! puis multipliait par masse/ptimestep.
-!        q(:,k)=(masse(:,k)*q(:,k)/ptimestep+fqa(:,k)-fqa(:,k+1)+fm(:,k+1)*q(:,k+1)) &
-!    &               /(fm(:,k)+masse(:,k)/ptimestep)
-         q(:,k)=(q(:,k)+ptimestep/masse(:,k)*(fqa(:,k)-fqa(:,k+1)+fm(:,k+1)*q(:,k+1))) &
-      &               /(1.+fm(:,k)*ptimestep/masse(:,k))
-! FH fin de modif.
-      enddo
-   endif
-
-! Tendencies
-      do k=1,nlay
-         do ig=1,ngrid
-            dq(ig,k)=(q(ig,k)-qold(ig,k))/ptimestep
-            q(ig,k)=qold(ig,k)
-         enddo
-      enddo
-
-return
-end
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Obsolete version kept for convergence with Cmip5 NPv3.1 simulations
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      subroutine thermcell_dq_o(ngrid,nlay,impl,ptimestep,fm,entr,  &
-     &           masse,q,dq,qa,lev_out)
-      USE print_control_mod, ONLY: prt_level
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-!=======================================================================
-
-      integer ngrid,nlay,impl
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay)
-      real q(ngrid,nlay)
-      real dq(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
-
-      real zzm
-
-      integer ig,k
-      real cfl
-
-      real qold(ngrid,nlay)
-      real ztimestep
-      integer niter,iter
-      CHARACTER (LEN=20) :: modname='thermcell_dq'
-      CHARACTER (LEN=80) :: abort_message
-
-
-
-! Calcul du critere CFL pour l'advection dans la subsidence
-      cfl = 0.
-      do k=1,nlay
-         do ig=1,ngrid
-            zzm=masse(ig,k)/ptimestep
-            cfl=max(cfl,fm(ig,k)/zzm)
-            if (entr(ig,k).gt.zzm) then
-               print*,'entr*dt>m,2',k,entr(ig,k)*ptimestep,masse(ig,k)
-               abort_message = 'entr dt > m, 2nd'
-               CALL abort_physic (modname,abort_message,1)
-            endif
-         enddo
-      enddo
-
-!IM 090508     print*,'CFL CFL CFL CFL ',cfl
-
-#undef CFL
-#ifdef CFL
-! On subdivise le calcul en niter pas de temps.
-      niter=int(cfl)+1
-#else
-      niter=1
-#endif
-
-      ztimestep=ptimestep/niter
-      qold=q
-
-
-do iter=1,niter
-      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
-
-!   calcul du detrainement
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-!           print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
-!test
-            if (detr(ig,k).lt.0.) then
-               entr(ig,k)=entr(ig,k)-detr(ig,k)
-               detr(ig,k)=0.
-!               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
-!     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
-            endif
-            if (fm(ig,k+1).lt.0.) then
-!               print*,'fm2<0!!!'
-            endif
-            if (entr(ig,k).lt.0.) then
-!               print*,'entr2<0!!!'
-            endif
-         enddo
-      enddo
-
-!   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ztimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
-     &         /(fm(ig,k+1)+detr(ig,k))
-            else
-               qa(ig,k)=q(ig,k)
-            endif
-            if (qa(ig,k).lt.0.) then
-!               print*,'qa<0!!!'
-            endif
-            if (q(ig,k).lt.0.) then
-!               print*,'q<0!!!'
-            endif
-         enddo
-      enddo
-
-! Calcul du flux subsident
-
-      do k=2,nlay
-         do ig=1,ngrid
-#undef centre
-#ifdef centre
-             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-#else
-
-#define plusqueun
-#ifdef plusqueun
-! Schema avec advection sur plus qu'une maille.
-            zzm=masse(ig,k)/ztimestep
-            if (fm(ig,k)>zzm) then
-               wqd(ig,k)=zzm*q(ig,k)+(fm(ig,k)-zzm)*q(ig,k+1)
-            else
-               wqd(ig,k)=fm(ig,k)*q(ig,k)
-            endif
-#else
-            wqd(ig,k)=fm(ig,k)*q(ig,k)
-#endif
-#endif
-
-            if (wqd(ig,k).lt.0.) then
-!               print*,'wqd<0!!!'
-            endif
-         enddo
-      enddo
-      do ig=1,ngrid
-         wqd(ig,1)=0.
-         wqd(ig,nlay+1)=0.
-      enddo
-     
-
-! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
-            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
-     &               -wqd(ig,k)+wqd(ig,k+1))  &
-     &               *ztimestep/masse(ig,k)
-!            if (dq(ig,k).lt.0.) then
-!               print*,'dq<0!!!'
-!            endif
-         enddo
-      enddo
-
-
-enddo
-
-
-! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
-            dq(ig,k)=(q(ig,k)-qold(ig,k))/ptimestep
-            q(ig,k)=qold(ig,k)
-         enddo
-      enddo
-
-      return
-      end
+link ../phylmd/thermcell_dq.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_dry.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_dry.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_dry.F90	(revision 3940)
@@ -1,173 +1,1 @@
-!
-! $Id: thermcell_dry.F90 2311 2015-06-25 07:45:24Z emillour $
-!
-       SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
-     &                            lalim,lmin,zmax,wmax,lev_out)
-
-!--------------------------------------------------------------------------
-!thermcell_dry: calcul de zmax et wmax du thermique sec
-! Calcul de la vitesse maximum et de la hauteur maximum pour un panache
-! ascendant avec une fonction d'alimentation alim_star et sans changement 
-! de phase.
-! Le calcul pourrait etre sans doute simplifier.
-! La temperature potentielle virtuelle dans la panache ascendant est
-! la temperature potentielle virtuelle pondÃ©rÃ©e par alim_star.
-!--------------------------------------------------------------------------
-
-       USE print_control_mod, ONLY: prt_level
-       IMPLICIT NONE
-#include "YOMCST.h"       
-       INTEGER l,ig
-
-       INTEGER ngrid,nlay
-       REAL zlev(ngrid,nlay+1)
-       REAL pphi(ngrid,nlay)
-       REAl ztv(ngrid,nlay)
-       REAL alim_star(ngrid,nlay)
-       INTEGER lalim(ngrid)
-      integer lev_out                           ! niveau pour les print
-
-       REAL zmax(ngrid)
-       REAL wmax(ngrid)
-
-!variables locales
-       REAL zw2(ngrid,nlay+1)
-       REAL f_star(ngrid,nlay+1)
-       REAL ztva(ngrid,nlay+1)
-       REAL wmaxa(ngrid)
-       REAL wa_moy(ngrid,nlay+1)
-       REAL linter(ngrid),zlevinter(ngrid)
-       INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid)
-      CHARACTER (LEN=20) :: modname='thermcell_dry'
-      CHARACTER (LEN=80) :: abort_message
-
-!initialisations
-       do ig=1,ngrid
-          do l=1,nlay+1
-             zw2(ig,l)=0.
-             wa_moy(ig,l)=0.
-          enddo
-       enddo
-       do ig=1,ngrid
-          do l=1,nlay
-             ztva(ig,l)=ztv(ig,l)
-          enddo
-       enddo
-       do ig=1,ngrid
-          wmax(ig)=0.
-          wmaxa(ig)=0.
-       enddo
-!calcul de la vitesse a partir de la CAPE en melangeant thetav
-
-
-! Calcul des F^*, integrale verticale de E^*
-       f_star(:,1)=0.
-       do l=1,nlay
-          f_star(:,l+1)=f_star(:,l)+alim_star(:,l)
-       enddo
-
-! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise
-       linter(:)=0.
-
-! couche la plus haute concernee par le thermique. 
-       lmax(:)=1
-
-! Le niveau linter est une variable continue qui se trouve dans la couche
-! lmax
-
-       do l=1,nlay-2
-         do ig=1,ngrid
-            if (l.eq.lmin(ig).and.lalim(ig).gt.1) then
-
-!------------------------------------------------------------------------
-!  Calcul de la vitesse en haut de la premiere couche instable.
-!  Premiere couche du panache thermique
-!------------------------------------------------------------------------
-
-               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
-     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
-
-!------------------------------------------------------------------------
-! Tant que la vitesse en bas de la couche et la somme du flux de masse
-! et de l'entrainement (c'est a dire le flux de masse en haut) sont
-! positifs, on calcul
-! 1. le flux de masse en haut  f_star(ig,l+1)
-! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l)
-! 3. la vitesse au carré en haut zw2(ig,l+1)
-!------------------------------------------------------------------------
-
-            else if (zw2(ig,l).ge.1e-10) then
-
-               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l)  &
-     &                    *ztv(ig,l))/f_star(ig,l+1)
-               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+  &
-     &                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))
-            endif
-! determination de zmax continu par interpolation lineaire
-!------------------------------------------------------------------------
-
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_dry'
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-                lmax(ig)=l
-            endif
-
-            if (zw2(ig,l+1).lt.0.) then
-               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-               zw2(ig,l+1)=0.
-               lmax(ig)=l
-!            endif
-!CR:zmax continu 06/05/12: calcul de linter quand le thermique est stoppe par le detrainement
-            elseif (f_star(ig,l+1).lt.0.) then
-               linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &           -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-               zw2(ig,l+1)=0.
-               lmax(ig)=l
-            endif
-!CRfin
-               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
-
-            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-               lmix(ig)=l+1
-               wmaxa(ig)=wa_moy(ig,l+1)
-            endif
-         enddo
-      enddo
-       if (prt_level.ge.1) print*,'fin calcul zw2'
-!
-! Determination de zw2 max
-      do ig=1,ngrid
-         wmax(ig)=0.
-      enddo
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-                zw2(ig,l)=sqrt(zw2(ig,l))
-                wmax(ig)=max(wmax(ig),zw2(ig,l))
-            else
-                 zw2(ig,l)=0.
-            endif
-          enddo
-      enddo
-
-!   Longueur caracteristique correspondant a la hauteur des thermiques.
-      do  ig=1,ngrid
-         zmax(ig)=0.
-         zlevinter(ig)=zlev(ig,1)
-      enddo
-      do  ig=1,ngrid
-! calcul de zlevinter
-          zlevinter(ig)=zlev(ig,lmax(ig)) + &
-     &    (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-           zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-      enddo
-
-      RETURN
-      END
+link ../phylmd/thermcell_dry.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_dtke.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_dtke.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_dtke.F90	(revision 3940)
@@ -1,123 +1,1 @@
-      subroutine thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0,  &
-     &           rg,pplev,tke)
-      USE print_control_mod, ONLY: prt_level
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-!=======================================================================
-
-      integer ngrid,nlay,nsrf
-
-      real ptimestep
-      real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
-      real entr0(ngrid,nlay),rg
-      real tke(ngrid,nlay,nsrf)
-      real detr0(ngrid,nlay)
-
-
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay)
-      real q(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
-
-      real zzm
-
-      integer ig,k
-      integer isrf
-
-
-      lev_out=0
-
-
-      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
-
-!   calcul du detrainement
-      do k=1,nlay
-         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
-         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
-      enddo
-
-
-! Decalage vertical des entrainements et detrainements.
-      masse(:,1)=0.5*masse0(:,1)
-      entr(:,1)=0.5*entr0(:,1)
-      detr(:,1)=0.5*detr0(:,1)
-      fm(:,1)=0.
-      do k=1,nlay-1
-         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
-         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
-         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
-         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
-      enddo
-      fm(:,nlay+1)=0.
-
-!   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-
-
-
-do isrf=1,nsrf
-
-   q(:,:)=tke(:,:,isrf)
-
-    if (1==1) then
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
-     &         /(fm(ig,k+1)+detr(ig,k))
-            else
-               qa(ig,k)=q(ig,k)
-            endif
-            if (qa(ig,k).lt.0.) then
-!               print*,'qa<0!!!'
-            endif
-            if (q(ig,k).lt.0.) then
-!               print*,'q<0!!!'
-            endif
-         enddo
-      enddo
-
-! Calcul du flux subsident
-
-      do k=2,nlay
-         do ig=1,ngrid
-            wqd(ig,k)=fm(ig,k)*q(ig,k)
-            if (wqd(ig,k).lt.0.) then
-!               print*,'wqd<0!!!'
-            endif
-         enddo
-      enddo
-      do ig=1,ngrid
-         wqd(ig,1)=0.
-         wqd(ig,nlay+1)=0.
-      enddo
-     
-
-! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
-            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
-     &               -wqd(ig,k)+wqd(ig,k+1))  &
-     &               *ptimestep/masse(ig,k)
-         enddo
-      enddo
-
- endif
-
-   tke(:,:,isrf)=q(:,:)
-
-enddo
-
-      return
-      end
+link ../phylmd/thermcell_dtke.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_dv2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_dv2.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_dv2.F90	(revision 3940)
@@ -1,193 +1,1 @@
-      subroutine thermcell_dv2(ngrid,nlay,ptimestep,fm,entr,masse  &
-     &    ,fraca,larga  &
-     &    ,u,v,du,dv,ua,va,lev_out)
-      USE print_control_mod, ONLY: prt_level,lunout
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-! Vectorisation, FH : 2010/03/08
-!
-!=======================================================================
-
-
-      integer ngrid,nlay
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real fraca(ngrid,nlay+1)
-      real larga(ngrid)
-      real entr(ngrid,nlay)
-      real u(ngrid,nlay)
-      real ua(ngrid,nlay)
-      real du(ngrid,nlay)
-      real v(ngrid,nlay)
-      real va(ngrid,nlay)
-      real dv(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
-      real wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
-      real gamma0(ngrid,nlay+1),gamma(ngrid,nlay+1)
-      real ue(ngrid,nlay),ve(ngrid,nlay)
-      LOGICAL ltherm(ngrid,nlay)
-      real dua(ngrid,nlay),dva(ngrid,nlay)
-      integer iter
-
-      integer ig,k,nlarga0
-
-!-------------------------------------------------------------------------
-
-!   calcul du detrainement
-!---------------------------
-
-!      print*,'THERMCELL DV2 OPTIMISE 3'
-
-      nlarga0=0.
-
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-         enddo
-      enddo
-
-!   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         ua(ig,1)=u(ig,1)
-         va(ig,1)=v(ig,1)
-         ue(ig,1)=u(ig,1)
-         ve(ig,1)=v(ig,1)
-      enddo
-
-      IF(prt_level>9)WRITE(lunout,*)                                    &
-     &      'WARNING on initialise gamma(1:ngrid,1)=0.'
-      gamma(1:ngrid,1)=0.
-      do k=2,nlay
-         do ig=1,ngrid
-            ltherm(ig,k)=(fm(ig,k+1)+detr(ig,k))*ptimestep > 1.e-5*masse(ig,k)
-            if(ltherm(ig,k).and.larga(ig)>0.) then
-               gamma0(ig,k)=masse(ig,k)  &
-     &         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )  &
-     &         *0.5/larga(ig)  &
-     &         *1.
-            else
-               gamma0(ig,k)=0.
-            endif
-            if (ltherm(ig,k).and.larga(ig)<=0.) nlarga0=nlarga0+1
-         enddo
-      enddo
-
-      gamma(:,:)=0.
-
-      do k=2,nlay
-
-         do ig=1,ngrid
-            if (ltherm(ig,k)) then
-               dua(ig,k)=ua(ig,k-1)-u(ig,k-1)
-               dva(ig,k)=va(ig,k-1)-v(ig,k-1)
-            else
-               ua(ig,k)=u(ig,k)
-               va(ig,k)=v(ig,k)
-               ue(ig,k)=u(ig,k)
-               ve(ig,k)=v(ig,k)
-            endif
-         enddo
-
-
-! Debut des iterations
-!----------------------
-do iter=1,5
-         do ig=1,ngrid
-! Pour memoire : calcul prenant en compte la fraction reelle
-!              zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
-!              zf2=1./(1.-zf)
-! Calcul avec fraction infiniement petite
-               zf=0.
-               zf2=1.
-
-!  la première fois on multiplie le coefficient de freinage
-!  par le module du vent dans la couche en dessous.
-!  Mais pourquoi donc ???
-               if (ltherm(ig,k)) then
-!   On choisit une relaxation lineaire.
-!                 gamma(ig,k)=gamma0(ig,k)
-!   On choisit une relaxation quadratique.
-                  gamma(ig,k)=gamma0(ig,k)*sqrt(dua(ig,k)**2+dva(ig,k)**2)
-                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)  &
-     &               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))  &
-     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
-     &                 +gamma(ig,k))
-                  va(ig,k)=(fm(ig,k)*va(ig,k-1)  &
-     &               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))  &
-     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
-     &                 +gamma(ig,k))
-!                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua(ig,k),dva(ig,k)
-                  dua(ig,k)=ua(ig,k)-u(ig,k)
-                  dva(ig,k)=va(ig,k)-v(ig,k)
-                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
-                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
-               endif
-         enddo
-! Fin des iterations
-!--------------------
-enddo
-
-      enddo ! k=2,nlay
-
-
-! Calcul du flux vertical de moment dans l'environnement.
-!---------------------------------------------------------
-      do k=2,nlay
-         do ig=1,ngrid
-            wud(ig,k)=fm(ig,k)*ue(ig,k)
-            wvd(ig,k)=fm(ig,k)*ve(ig,k)
-         enddo
-      enddo
-      do ig=1,ngrid
-         wud(ig,1)=0.
-         wud(ig,nlay+1)=0.
-         wvd(ig,1)=0.
-         wvd(ig,nlay+1)=0.
-      enddo
-
-! calcul des tendances.
-!-----------------------
-      do k=1,nlay
-         do ig=1,ngrid
-            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)  &
-     &               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)  &
-     &               -wud(ig,k)+wud(ig,k+1))  &
-     &               /masse(ig,k)
-            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)  &
-     &               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)  &
-     &               -wvd(ig,k)+wvd(ig,k+1))  &
-     &               /masse(ig,k)
-         enddo
-      enddo
-
-
-! Sorties eventuelles.
-!----------------------
-
-   if(prt_level.GE.10) then
-      do k=1,nlay
-         do ig=1,ngrid
-           print*,'th_dv2 ig k gamma entr detr ua ue va ve wud wvd masse',ig,k,gamma(ig,k), &
-     &   entr(ig,k),detr(ig,k),ua(ig,k),ue(ig,k),va(ig,k),ve(ig,k),wud(ig,k),wvd(ig,k),wud(ig,k+1),wvd(ig,k+1), &
-     &   masse(ig,k)
-         enddo
-      enddo
-   endif
-!
-     if (nlarga0>0) then
-          print*,'WARNING !!!!!! DANS THERMCELL_DV2 '
-          print*,nlarga0,' points pour lesquels laraga=0. dans un thermique'
-          print*,'Il faudrait decortiquer ces points'
-     endif
-
-      return
-      end
+link ../phylmd/thermcell_dv2.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_env.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_env.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_env.F90	(revision 3940)
@@ -1,196 +1,1 @@
-      SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
-     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out &
-#ifdef ISO
-     &            ,xtpo,xtzo,xtzl &
-#endif      
-     &   )
-
-!--------------------------------------------------------------
-!thermcell_env: calcule les caracteristiques de l environnement
-!necessaires au calcul des proprietes dans le thermique
-!--------------------------------------------------------------
-
-      USE print_control_mod, ONLY: prt_level
-#ifdef ISO
-  USE infotrac_phy, ONLY : ntraciso
-  USE isotopes_mod, ONLY: pxtice,pxtmelt,iso_eau,iso_HDO
-  USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
-#ifdef ISOVERIF
-  USE isotopes_verif_mod, ONLY: iso_verif_egalite, &
-        iso_verif_aberrant_encadre,iso_verif_noNaN
-#endif
-#ifdef ISOTRAC
-  USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
-#ifdef ISOVERIF
-  USE isotopes_verif_mod, ONLY: iso_verif_traceur
-#endif
-#endif
-#endif
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"      
-
-      INTEGER ngrid,nlay
-      REAL po(ngrid,nlay)
-      REAL pt(ngrid,nlay)
-      REAL pu(ngrid,nlay)
-      REAL pv(ngrid,nlay)
-      REAL pplay(ngrid,nlay)
-      REAL pplev(ngrid,nlay+1)
-      integer lev_out                           ! niveau pour les print
-
-      REAL zo(ngrid,nlay)
-      REAL zl(ngrid,nlay)
-      REAL zh(ngrid,nlay)
-      REAL ztv(ngrid,nlay)
-      REAL zthl(ngrid,nlay)
-      REAL zpspsk(ngrid,nlay)
-      REAL zu(ngrid,nlay)
-      REAL zv(ngrid,nlay)
-      REAL pqsat(ngrid,nlay)
-
-      INTEGER ig,ll
-
-      real dqsat_dT
-      real RLvCp
-
-logical mask(ngrid,nlay)
-
-#ifdef ISO
-      REAL xtpo(ntraciso,ngrid,nlay)
-      REAL xtzo(ntraciso,ngrid,nlay)
-      REAL xtzl(ntraciso,ngrid,nlay)
-      integer ixt
-      real zxtliq(ntraciso,ngrid),zxtice(ntraciso,ngrid)
-      real zfice(ngrid)
-      REAL zxtl(ntraciso,ngrid,nlay)
-#endif 
-
-
-!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-! Initialisations :
-!------------------
-
-mask(:,:)=.true.
-RLvCp = RLVTT/RCPD
-
-!
-! calcul des caracteristiques de l environnement
-       DO  ll=1,nlay
-         DO ig=1,ngrid
-            zo(ig,ll)=po(ig,ll)
-            zl(ig,ll)=0.
-            zh(ig,ll)=pt(ig,ll)
-#ifdef ISO
-            do ixt=1,ntraciso
-              xtzo(ixt,ig,ll)=xtpo(ixt,ig,ll)
-              xtzl(ixt,ig,ll)=0. 
-            enddo   !do ixt=1,ntraciso 
-#endif
-         EndDO
-       EndDO
-!
-!
-! Condensation :
-!---------------
-! Calcul de l'humidite a saturation et de la condensation
-
-call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
-DO ll=1,nlay
-   DO ig=1,ngrid
-      zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
-      zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
-      zo(ig,ll) = po(ig,ll)-zl(ig,ll)
-   ENDDO
-ENDDO
-
-
-
-#ifdef ISO
-#ifdef ISOVERIF
-   write(*,*) 'thermcell_env 94: avant condiso_liq_ice_vectall'
-   DO ll=1,nlay
-    do ig=1,ngrid 
-       call iso_verif_noNaN(po(ig,ll), &
-       & 'thermcell_env 99')
-       do ixt=1,ntraciso         
-         call iso_verif_noNaN(xtpo(ixt,ig,ll), &
-       &        'thermcell_env 103')
-       enddo !do ixt=1,ntraciso   
-       if (iso_eau.gt.0) then
-         call iso_verif_egalite(xtpo(iso_eau,ig,ll),po(ig,ll), &
-         & 'thermcell_env 100')
-       endif
-    enddo !do ig=1,ngrid 
-   enddo !DO ll=1,nlay
-#endif      
- DO ll=1,nlay
-  do ig=1,ngrid
-        zfice(ig)=1.0-(pt(ig,ll)-pxtice)/(pxtmelt-pxtice)
-        zfice(ig) = MIN(MAX(zfice(ig),0.0),1.0)
-  enddo  !do ig=1,ngrid 
-
-
-  call condiso_liq_ice_vectall(xtpo(1,1,ll),po(1,ll),zl(1,ll),pt(1,ll),zfice, &
-     &            zxtice,zxtliq,ngrid)
-#ifdef ISOTRAC
-  call condiso_liq_ice_vectall_trac(xtpo(1,1,ll),po(1,ll),zl(1,ll), &
-     &            pt(1,ll),zfice,zxtice,zxtliq,ngrid)
-#ifdef ISOVERIF
-  do ig=1,ngrid            
-      call iso_verif_traceur(xtpo(1,ig,ll),'thermcell_env 102')
-      call iso_verif_traceur(zxtliq(1,ig),'thermcell_env 103')
-      call iso_verif_traceur(zxtice(1,ig),'thermcell_env 104')
-  enddo !do ig=1,ngrid 
-#endif
-#endif
-  do ig=1,ngrid
-     do ixt=1,ntraciso                 
-       zxtl(ixt,ig,ll)=zxtice(ixt,ig)+zxtliq(ixt,ig)
-       xtzo(ixt,ig,ll) = xtpo(ixt,ig,ll)-zxtl(ixt,ig,ll)
-     enddo ! do ixt=1,ntraciso  
-#ifdef ISOVERIF
-     if (iso_eau.gt.0) then
-       call iso_verif_egalite(zxtl(iso_eau,ig,ll),zl(ig,ll), &
-       & 'thermcell_env 120')
-       call iso_verif_egalite(xtzo(iso_eau,ig,ll),zo(ig,ll), &
-       & 'thermcell_env 136')
-     endif
-      if (iso_HDO.gt.0) then
-      call iso_verif_aberrant_encadre( &
-       &          xtzo(iso_HDO,ig,ll)/zo(ig,ll), &
-       &          'thermcell_env 141')
-      endif     
-#endif     
-  enddo ! do ig=1,ngrid
-enddo !DO ll=1,nlay
-#endif
-
-!
-!
-!-----------------------------------------------------------------------
-
-      if (prt_level.ge.1) print*,'0 OK convect8'
-
-      DO ll=1,nlay
-         DO ig=1,ngrid
-             zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
-             zu(ig,ll)=pu(ig,ll)
-             zv(ig,ll)=pv(ig,ll)
-!attention zh est maintenant le profil de T et plus le profil de theta !
-! Quelle horreur ! A eviter.
-!
-!   T-> Theta
-            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
-!Theta_v
-            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
-!Thetal
-            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
-!            
-         ENDDO
-      ENDDO
- 
-      RETURN
-      END
+link ../phylmd/thermcell_env.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_flux.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_flux.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_flux.F90	(revision 3940)
@@ -1,519 +1,1 @@
-!
-! $Id: thermcell_flux.F90 2311 2015-06-25 07:45:24Z emillour $
-!
-
-
-      SUBROUTINE thermcell_flux(ngrid,klev,ptimestep,masse, &
-     &       lalim,lmax,alim_star,  &
-     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
-     &       detr,zqla,zmax,lev_out,lunout1,igout)
-
-
-!---------------------------------------------------------------------------
-!thermcell_flux: deduction des flux
-!---------------------------------------------------------------------------
-
-      USE print_control_mod, ONLY: prt_level,lunout
-      IMPLICIT NONE
-      
-      INTEGER ig,l
-      INTEGER ngrid,klev
-      
-      REAL alim_star(ngrid,klev),entr_star(ngrid,klev)
-      REAL detr_star(ngrid,klev)
-      REAL zw2(ngrid,klev+1)
-      REAL zlev(ngrid,klev+1)
-      REAL masse(ngrid,klev)
-      REAL ptimestep
-      REAL rhobarz(ngrid,klev)
-      REAL f(ngrid)
-      INTEGER lmax(ngrid)
-      INTEGER lalim(ngrid)
-      REAL zqla(ngrid,klev)
-      REAL zmax(ngrid)
-
-      integer ncorecfm1,ncorecfm2,ncorecfm3,ncorecalpha
-      integer ncorecfm4,ncorecfm5,ncorecfm6,ncorecfm7,ncorecfm8
-      
-
-      REAL entr(ngrid,klev),detr(ngrid,klev)
-      REAL fm(ngrid,klev+1)
-      REAL zfm
-
-      integer igout
-      integer lev_out
-      integer lunout1
-
-      REAL f_old,ddd0,eee0,ddd,eee,zzz
-
-      REAL fomass_max,alphamax
-      save fomass_max,alphamax
-!$OMP THREADPRIVATE(fomass_max,alphamax)
-
-      character (len=20) :: modname='thermcell_flux'
-      character (len=80) :: abort_message
-
-      fomass_max=0.5
-      alphamax=0.7
-
-      ncorecfm1=0
-      ncorecfm2=0
-      ncorecfm3=0
-      ncorecfm4=0
-      ncorecfm5=0
-      ncorecfm6=0
-      ncorecfm7=0
-      ncorecfm8=0
-      ncorecalpha=0
-
-!initialisation
-      fm(:,:)=0.
-      
-      if (prt_level.ge.10) then
-         write(lunout,*) 'Dans thermcell_flux 0'
-         write(lunout,*) 'flux base ',f(igout)
-         write(lunout,*) 'lmax ',lmax(igout)
-         write(lunout,*) 'lalim ',lalim(igout)
-         write(lunout,*) 'ig= ',igout
-         write(lunout,*) ' l E*    A*     D*  '
-         write(lunout,'(i4,3e15.5)') (l,entr_star(igout,l),alim_star(igout,l),detr_star(igout,l) &
-     &    ,l=1,lmax(igout))
-      endif
-
-
-!-------------------------------------------------------------------------
-! Verification de la nullite des entrainement et detrainement au dessus
-! de lmax(ig)
-!-------------------------------------------------------------------------
-     if ( prt_level > 1 ) THEN
-      do l=1,klev
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-               if (entr_star(ig,l).gt.1.) then
-                    print*,'WARNING thermcell_flux 1 ig,l,lmax(ig)',ig,l,lmax(ig)
-                    print*,'entr_star(ig,l)',entr_star(ig,l)
-                    print*,'alim_star(ig,l)',alim_star(ig,l)
-                    print*,'detr_star(ig,l)',detr_star(ig,l)
-               endif
-            else
-               if (abs(entr_star(ig,l))+abs(alim_star(ig,l))+abs(detr_star(ig,l)).gt.0.) then
-                    print*,'cas 1 : ig,l,lmax(ig)',ig,l,lmax(ig)
-                    print*,'entr_star(ig,l)',entr_star(ig,l)
-                    print*,'alim_star(ig,l)',alim_star(ig,l)
-                    print*,'detr_star(ig,l)',detr_star(ig,l)
-                    abort_message = ''
-                    CALL abort_physic (modname,abort_message,1)
-               endif
-            endif
-         enddo
-      enddo
-     endif  !( prt_level > 1 ) THEN
-!-------------------------------------------------------------------------
-! Multiplication par le flux de masse issu de la femreture
-!-------------------------------------------------------------------------
-
-      do l=1,klev
-         entr(:,l)=f(:)*(entr_star(:,l)+alim_star(:,l))
-         detr(:,l)=f(:)*detr_star(:,l)
-      enddo
-
-      if (prt_level.ge.10) then
-         write(lunout,*) 'Dans thermcell_flux 1'
-         write(lunout,*) 'flux base ',f(igout)
-         write(lunout,*) 'lmax ',lmax(igout)
-         write(lunout,*) 'lalim ',lalim(igout)
-         write(lunout,*) 'ig= ',igout
-         write(lunout,*) ' l   E    D     W2'
-         write(lunout,'(i4,3e15.5)') (l,entr(igout,l),detr(igout,l) &
-     &    ,zw2(igout,l+1),l=1,lmax(igout))
-      endif
-
-      fm(:,1)=0.
-      do l=1,klev
-         do ig=1,ngrid
-            if (l.lt.lmax(ig)) then
-               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
-            elseif(l.eq.lmax(ig)) then
-               fm(ig,l+1)=0.
-               detr(ig,l)=fm(ig,l)+entr(ig,l)
-            else
-               fm(ig,l+1)=0.
-            endif
-         enddo
-      enddo
-
-
-
-! Test provisoire : pour comprendre pourquoi on corrige plein de fois 
-! le cas fm6, on commence par regarder une premiere fois avant les
-! autres corrections.
-
-      do l=1,klev
-         do ig=1,ngrid
-            if (detr(ig,l).gt.fm(ig,l)) then
-               ncorecfm8=ncorecfm8+1
-!              igout=ig
-            endif
-         enddo
-      enddo
-
-      if (prt_level.ge.10) &
-    &    call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
-    &    ptimestep,masse,entr,detr,fm,'2  ')
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH Version en cours de test;
-! par rapport a thermcell_flux, on fait une grande boucle sur "l"
-! et on modifie le flux avec tous les contr�les appliques d'affilee
-! pour la meme couche
-! Momentanement, on duplique le calcule du flux pour pouvoir comparer
-! les flux avant et apres modif
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      do l=1,klev
-
-         do ig=1,ngrid
-            if (l.lt.lmax(ig)) then
-               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
-            elseif(l.eq.lmax(ig)) then
-               fm(ig,l+1)=0.
-               detr(ig,l)=fm(ig,l)+entr(ig,l)
-            else
-               fm(ig,l+1)=0.
-            endif
-         enddo
-
-
-!-------------------------------------------------------------------------
-! Verification de la positivite des flux de masse
-!-------------------------------------------------------------------------
-
-!     do l=1,klev
-         do ig=1,ngrid
-            if (fm(ig,l+1).lt.0.) then
-!              print*,'fm1<0',l+1,lmax(ig),fm(ig,l+1)
-                ncorecfm1=ncorecfm1+1
-               fm(ig,l+1)=fm(ig,l)
-               detr(ig,l)=entr(ig,l)
-            endif
-         enddo
-!     enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-------------------------------------------------------------------------
-!Test sur fraca croissant
-!-------------------------------------------------------------------------
-
-
-      if (1.eq.1) then
-!     do l=1,klev
-         do ig=1,ngrid
-          if (l.ge.lalim(ig).and.l.le.lmax(ig) &
-     &    .and.(zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10) ) then
-!  zzz est le flux en l+1 a frac constant
-             zzz=fm(ig,l)*rhobarz(ig,l+1)*zw2(ig,l+1)  &
-     &                          /(rhobarz(ig,l)*zw2(ig,l))
-             if (fm(ig,l+1).gt.zzz) then
-                detr(ig,l)=detr(ig,l)+fm(ig,l+1)-zzz
-                fm(ig,l+1)=zzz
-                ncorecfm4=ncorecfm4+1
-             endif
-          endif
-        enddo
-!     enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-      else
-       if (l.eq.1) then
-         print*,'Test sur les fractions croissantes inhibe dans thermcell_flux2'
-       endif
-      endif
-
-
-!-------------------------------------------------------------------------
-!test sur flux de masse croissant
-!-------------------------------------------------------------------------
-
-!     do l=1,klev
-         do ig=1,ngrid
-            if ((fm(ig,l+1).gt.fm(ig,l)).and.(l.gt.lalim(ig))) then
-              f_old=fm(ig,l+1)
-              fm(ig,l+1)=fm(ig,l)
-              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
-               ncorecfm5=ncorecfm5+1
-            endif
-         enddo
-!     enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-------------------------------------------------------------------------
-!detr ne peut pas etre superieur a fm
-!-------------------------------------------------------------------------
-
-      if(1.eq.1) then
-
-!     do l=1,klev
-         do ig=1,ngrid
-            if (entr(ig,l)<0.) then
-               print*,'N1 ig,l,entr',ig,l,entr(ig,l)
-               abort_message = 'entr negatif'
-               CALL abort_physic (modname,abort_message,1)
-            endif
-            if (detr(ig,l).gt.fm(ig,l)) then
-               ncorecfm6=ncorecfm6+1
-               detr(ig,l)=fm(ig,l)
-!              entr(ig,l)=fm(ig,l+1)
-
-! Dans le cas ou on est au dessus de la couche d'alimentation et que le
-! detrainement est plus fort que le flux de masse, on stope le thermique.
-               if (l.gt.lalim(ig)) then
-                  lmax(ig)=l
-                  fm(ig,l+1)=0.
-                  entr(ig,l)=0.
-               else
-                  ncorecfm7=ncorecfm7+1
-               endif
-            endif
-
-            if(l.gt.lmax(ig)) then
-               detr(ig,l)=0.
-               fm(ig,l+1)=0.
-               entr(ig,l)=0.
-            endif
-
-            if (entr(ig,l).lt.0.) then
-               print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
-               print*,'entr(ig,l)',entr(ig,l)
-               print*,'fm(ig,l)',fm(ig,l)
-               abort_message = 'probleme dans thermcell flux'
-               CALL abort_physic (modname,abort_message,1)
-            endif
-         enddo
-!     enddo
-      endif
-
-
-      if (prt_level.ge.10) &
-     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-------------------------------------------------------------------------
-!fm ne peut pas etre negatif
-!-------------------------------------------------------------------------
-
-!     do l=1,klev
-         do ig=1,ngrid
-            if (fm(ig,l+1).lt.0.) then
-               detr(ig,l)=detr(ig,l)+fm(ig,l+1)
-               fm(ig,l+1)=0.
-!              print*,'fm2<0',l+1,lmax(ig)
-               ncorecfm2=ncorecfm2+1
-            endif
-            if (detr(ig,l).lt.0.) then
-               print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig)
-               print*,'detr(ig,l)',detr(ig,l)
-               print*,'fm(ig,l)',fm(ig,l)
-               abort_message = 'probleme dans thermcell flux'
-               CALL abort_physic (modname,abort_message,1)
-            endif
-        enddo
-!    enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-----------------------------------------------------------------------
-!la fraction couverte ne peut pas etre superieure a 1            
-!-----------------------------------------------------------------------
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH Partie a revisiter.
-! Il semble qu'etaient codees ici deux optiques dans le cas
-! F/ (rho *w) > 1
-! soit limiter la hauteur du thermique en considerant que c'est 
-! la derniere chouche, soit limiter F a rho w.
-! Dans le second cas, il faut en fait limiter a un peu moins
-! que ca parce qu'on a des 1 / ( 1 -alpha) un peu plus loin
-! dans thermcell_main et qu'il semble de toutes facons deraisonable
-! d'avoir des fractions de 1..
-! Ci dessous, et dans l'etat actuel, le premier des  deux if est
-! sans doute inutile.
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!    do l=1,klev
-        do ig=1,ngrid
-           if (zw2(ig,l+1).gt.1.e-10) then
-           zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*alphamax
-           if ( fm(ig,l+1) .gt. zfm) then
-              f_old=fm(ig,l+1)
-              fm(ig,l+1)=zfm
-!             zw2(ig,l+1)=0.
-!             zqla(ig,l+1)=0.
-              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
-!             lmax(ig)=l+1
-!             zmax(ig)=zlev(ig,lmax(ig))
-!             print*,'alpha>1',l+1,lmax(ig)
-              ncorecalpha=ncorecalpha+1
-           endif
-           endif
-        enddo
-!    enddo
-!
-
-
-      if (prt_level.ge.10) &
-     &   write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-! Fin de la grande boucle sur les niveaux verticaux
-      enddo
-
-      if (prt_level.ge.10) &
-    &    call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
-    &    ptimestep,masse,entr,detr,fm,'8  ')
-
-
-!-----------------------------------------------------------------------
-! On fait en sorte que la quantite totale d'air entraine dans le 
-! panache ne soit pas trop grande comparee a la masse de la maille
-!-----------------------------------------------------------------------
-
-      if (1.eq.1) then
-      do l=1,klev-1
-         do ig=1,ngrid
-            eee0=entr(ig,l)
-            ddd0=detr(ig,l)
-            eee=entr(ig,l)-masse(ig,l)*fomass_max/ptimestep
-            ddd=detr(ig,l)-eee
-            if (eee.gt.0.) then
-                ncorecfm3=ncorecfm3+1
-                entr(ig,l)=entr(ig,l)-eee
-                if ( ddd.gt.0.) then
-!   l'entrainement est trop fort mais l'exces peut etre compense par une
-!   diminution du detrainement)
-                   detr(ig,l)=ddd
-                else
-!   l'entrainement est trop fort mais l'exces doit etre compense en partie
-!   par un entrainement plus fort dans la couche superieure
-                   if(l.eq.lmax(ig)) then
-                      detr(ig,l)=fm(ig,l)+entr(ig,l)
-                   else
-                      if(l.ge.lmax(ig).and.0.eq.1) then
-                         print*,'ig,l',ig,l
-                         print*,'eee0',eee0
-                         print*,'ddd0',ddd0
-                         print*,'eee',eee
-                         print*,'ddd',ddd
-                         print*,'entr',entr(ig,l)
-                         print*,'detr',detr(ig,l)
-                         print*,'masse',masse(ig,l)
-                         print*,'fomass_max',fomass_max
-                         print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*fomass_max/ptimestep
-                         print*,'ptimestep',ptimestep
-                         print*,'lmax(ig)',lmax(ig)
-                         print*,'fm(ig,l+1)',fm(ig,l+1)
-                         print*,'fm(ig,l)',fm(ig,l)
-                         abort_message = 'probleme dans thermcell_flux'
-                         CALL abort_physic (modname,abort_message,1)
-                      endif
-                      entr(ig,l+1)=entr(ig,l+1)-ddd
-                      detr(ig,l)=0.
-                      fm(ig,l+1)=fm(ig,l)+entr(ig,l)
-                      detr(ig,l)=0.
-                   endif
-                endif
-            endif
-         enddo
-      enddo
-      endif
-!                  
-!              ddd=detr(ig)-entre
-!on s assure que tout s annule bien en zmax
-      do ig=1,ngrid
-         fm(ig,lmax(ig)+1)=0.
-         entr(ig,lmax(ig))=0.
-         detr(ig,lmax(ig))=fm(ig,lmax(ig))+entr(ig,lmax(ig))
-      enddo
-
-!-----------------------------------------------------------------------
-! Impression du nombre de bidouilles qui ont ete necessaires
-!-----------------------------------------------------------------------
-
-      if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then
-       if (prt_level.ge.10) then
-          print*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',&
-    &     ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', &
-    &     ncorecfm4,'x fm4',ncorecfm5,'x fm5 et', &
-    &     ncorecfm6,'x fm6', &
-    &     ncorecfm7,'x fm7', &
-    &     ncorecfm8,'x fm8', &
-    &     ncorecalpha,'x alpha'
-       endif
-      endif
-
-      if (prt_level.ge.10) &
-    &    call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
-    &    ptimestep,masse,entr,detr,fm,'fin')
-
-
-      return
-      end
-
-      subroutine printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &
-    &    ptimestep,masse,entr,detr,fm,descr)
-
-     implicit none
-
-      integer ngrid,klev,lunout,igout,l,lm
-
-      integer lmax(klev),lalim(klev)
-      real ptimestep,masse(ngrid,klev),entr(ngrid,klev),detr(ngrid,klev)
-      real fm(ngrid,klev+1),f(ngrid)
-
-      character*3 descr
-
-      character (len=20) :: modname='thermcell_flux'
-      character (len=80) :: abort_message
-
-      lm=lmax(igout)+5
-      if(lm.gt.klev) lm=klev
-
-      print*,'Impression jusque lm=',lm
-
-         write(lunout,*) 'Dans thermcell_flux '//descr
-         write(lunout,*) 'flux base ',f(igout)
-         write(lunout,*) 'lmax ',lmax(igout)
-         write(lunout,*) 'lalim ',lalim(igout)
-         write(lunout,*) 'ig= ',igout
-         write(lunout,'(a3,4a14)') 'l','M','E','D','F'
-         write(lunout,'(i4,4e14.4)') (l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l) &
-     &    ,fm(igout,l+1),l=1,lm)
-
-
-      do l=lmax(igout)+1,klev
-          if (abs(entr(igout,l))+abs(detr(igout,l))+abs(fm(igout,l)).gt.0.) then
-          print*,'cas 1 : igout,l,lmax(igout)',igout,l,lmax(igout)
-          print*,'entr(igout,l)',entr(igout,l)
-          print*,'detr(igout,l)',detr(igout,l)
-          print*,'fm(igout,l)',fm(igout,l)
-          abort_message = ''
-          CALL abort_physic (modname,abort_message,1)
-          endif
-      enddo
-
-      return
-      end
-
+link ../phylmd/thermcell_flux.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_flux2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_flux2.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_flux2.F90	(revision 3940)
@@ -1,515 +1,1 @@
-!
-! $Id: thermcell_flux2.F90 3102 2017-12-03 20:27:42Z oboucher $
-!
-      SUBROUTINE thermcell_flux2(ngrid,klev,ptimestep,masse, &
-     &       lalim,lmax,alim_star,  &
-     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
-     &       detr,zqla,lev_out,lunout1,igout)
-!IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
-
-
-!---------------------------------------------------------------------------
-!thermcell_flux: deduction des flux
-!---------------------------------------------------------------------------
-
-      USE print_control_mod, ONLY: prt_level
-      IMPLICIT NONE
-#include "thermcell.h"
-      
-      INTEGER ig,l
-      INTEGER ngrid,klev
-      
-      REAL alim_star(ngrid,klev),entr_star(ngrid,klev)
-      REAL detr_star(ngrid,klev)
-      REAL zw2(ngrid,klev+1)
-      REAL zlev(ngrid,klev+1)
-      REAL masse(ngrid,klev)
-      REAL ptimestep
-      REAL rhobarz(ngrid,klev)
-      REAL f(ngrid)
-      INTEGER lmax(ngrid)
-      INTEGER lalim(ngrid)
-      REAL zqla(ngrid,klev)
-      REAL zmax(ngrid)
-
-      integer ncorecfm1,ncorecfm2,ncorecfm3,ncorecalpha
-      integer ncorecfm4,ncorecfm5,ncorecfm6,ncorecfm7,ncorecfm8
-      
-
-      REAL entr(ngrid,klev),detr(ngrid,klev)
-      REAL fm(ngrid,klev+1)
-      REAL zfm
-
-      integer igout,lout
-      integer lev_out
-      integer lunout1
-
-      REAL f_old,ddd0,eee0,ddd,eee,zzz
-
-      REAL,SAVE :: fomass_max=0.5
-      REAL,SAVE :: alphamax=0.7
-!$OMP THREADPRIVATE(fomass_max,alphamax)
-
-      logical check_debug,labort_physic
-
-      character (len=20) :: modname='thermcell_flux2'
-      character (len=80) :: abort_message
-
-
-      ncorecfm1=0
-      ncorecfm2=0
-      ncorecfm3=0
-      ncorecfm4=0
-      ncorecfm5=0
-      ncorecfm6=0
-      ncorecfm7=0
-      ncorecfm8=0
-      ncorecalpha=0
-
-!initialisation
-      fm(:,:)=0.
-      
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_flux 0'
-         write(lunout1,*) 'flux base ',f(igout)
-         write(lunout1,*) 'lmax ',lmax(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) 'ig= ',igout
-         write(lunout1,*) ' l E*    A*     D*  '
-         write(lunout1,'(i4,3e15.5)') (l,entr_star(igout,l),alim_star(igout,l),detr_star(igout,l) &
-     &    ,l=1,lmax(igout))
-      endif
-
-
-!-------------------------------------------------------------------------
-! Verification de la nullite des entrainement et detrainement au dessus
-! de lmax(ig)
-! Active uniquement si check_debug=.true. ou prt_level>=10
-!-------------------------------------------------------------------------
-
-      check_debug=.false..or.prt_level>=10
-
-      if (check_debug) then
-      do l=1,klev
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-               if (entr_star(ig,l).gt.1.) then
-                    print*,'WARNING thermcell_flux 1 ig,l,lmax(ig)',ig,l,lmax(ig)
-                    print*,'entr_star(ig,l)',entr_star(ig,l)
-                    print*,'alim_star(ig,l)',alim_star(ig,l)
-                    print*,'detr_star(ig,l)',detr_star(ig,l)
-               endif
-            else
-               if (abs(entr_star(ig,l))+abs(alim_star(ig,l))+abs(detr_star(ig,l)).gt.0.) then
-                    print*,'cas 1 : ig,l,lmax(ig)',ig,l,lmax(ig)
-                    print*,'entr_star(ig,l)',entr_star(ig,l)
-                    print*,'alim_star(ig,l)',alim_star(ig,l)
-                    print*,'detr_star(ig,l)',detr_star(ig,l)
-                    abort_message = ''
-                    labort_physic=.true.
-                    CALL abort_physic (modname,abort_message,1)
-               endif
-            endif
-         enddo
-      enddo
-      endif
-
-!-------------------------------------------------------------------------
-! Multiplication par le flux de masse issu de la femreture
-!-------------------------------------------------------------------------
-
-      do l=1,klev
-         entr(:,l)=f(:)*(entr_star(:,l)+alim_star(:,l))
-         detr(:,l)=f(:)*detr_star(:,l)
-      enddo
-
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_flux 1'
-         write(lunout1,*) 'flux base ',f(igout)
-         write(lunout1,*) 'lmax ',lmax(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) 'ig= ',igout
-         write(lunout1,*) ' l   E    D     W2'
-         write(lunout1,'(i4,3e15.5)') (l,entr(igout,l),detr(igout,l) &
-     &    ,zw2(igout,l+1),l=1,lmax(igout))
-      endif
-
-      fm(:,1)=0.
-      do l=1,klev
-         do ig=1,ngrid
-            if (l.lt.lmax(ig)) then
-               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
-            elseif(l.eq.lmax(ig)) then
-               fm(ig,l+1)=0.
-               detr(ig,l)=fm(ig,l)+entr(ig,l)
-            else
-               fm(ig,l+1)=0.
-            endif
-         enddo
-      enddo
-
-
-
-! Test provisoire : pour comprendre pourquoi on corrige plein de fois 
-! le cas fm6, on commence par regarder une premiere fois avant les
-! autres corrections.
-
-      do l=1,klev
-         do ig=1,ngrid
-            if (detr(ig,l).gt.fm(ig,l)) then
-               ncorecfm8=ncorecfm8+1
-!              igout=ig
-            endif
-         enddo
-      enddo
-
-!      if (prt_level.ge.10) &
-!    &    call printflux(ngrid,klev,lunout1,igout,f,lmax,lalim, &
-!    &    ptimestep,masse,entr,detr,fm,'2  ')
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH Version en cours de test;
-! par rapport a thermcell_flux, on fait une grande boucle sur "l"
-! et on modifie le flux avec tous les contr�les appliques d'affilee
-! pour la meme couche
-! Momentanement, on duplique le calcule du flux pour pouvoir comparer
-! les flux avant et apres modif
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      do l=1,klev
-
-         do ig=1,ngrid
-            if (l.lt.lmax(ig)) then
-               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
-            elseif(l.eq.lmax(ig)) then
-               fm(ig,l+1)=0.
-               detr(ig,l)=fm(ig,l)+entr(ig,l)
-            else
-               fm(ig,l+1)=0.
-            endif
-         enddo
-
-
-!-------------------------------------------------------------------------
-! Verification de la positivite des flux de masse
-!-------------------------------------------------------------------------
-
-!     do l=1,klev
-         do ig=1,ngrid
-            if (fm(ig,l+1).lt.0.) then
-!              print*,'fm1<0',l+1,lmax(ig),fm(ig,l+1)
-                ncorecfm1=ncorecfm1+1
-               fm(ig,l+1)=fm(ig,l)
-               detr(ig,l)=entr(ig,l)
-            endif
-         enddo
-!     enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-------------------------------------------------------------------------
-!Test sur fraca croissant
-!-------------------------------------------------------------------------
-      if (iflag_thermals_optflux==0) then 
-!     do l=1,klev
-         do ig=1,ngrid
-          if (l.ge.lalim(ig).and.l.le.lmax(ig) &
-     &    .and.(zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10) ) then
-!  zzz est le flux en l+1 a frac constant
-             zzz=fm(ig,l)*rhobarz(ig,l+1)*zw2(ig,l+1)  &
-     &                          /(rhobarz(ig,l)*zw2(ig,l))
-             if (fm(ig,l+1).gt.zzz) then
-                detr(ig,l)=detr(ig,l)+fm(ig,l+1)-zzz
-                fm(ig,l+1)=zzz
-                ncorecfm4=ncorecfm4+1
-             endif
-          endif
-        enddo
-!     enddo
-      endif
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-
-!-------------------------------------------------------------------------
-!test sur flux de masse croissant
-!-------------------------------------------------------------------------
-      if (iflag_thermals_optflux==0) then
-!     do l=1,klev
-         do ig=1,ngrid
-            if ((fm(ig,l+1).gt.fm(ig,l)).and.(l.gt.lalim(ig))) then
-              f_old=fm(ig,l+1)
-              fm(ig,l+1)=fm(ig,l)
-              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
-               ncorecfm5=ncorecfm5+1
-            endif
-         enddo
-!     enddo
-      endif
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!fin 1.eq.0
-!-------------------------------------------------------------------------
-!detr ne peut pas etre superieur a fm
-!-------------------------------------------------------------------------
-
-      if(1.eq.1) then
-
-!     do l=1,klev
-
-
-
-         labort_physic=.false.
-         do ig=1,ngrid
-            if (entr(ig,l)<0.) then
-               labort_physic=.true.
-               igout=ig
-               lout=l
-            endif
-         enddo
-
-         if (labort_physic) then
-            print*,'N1 ig,l,entr',igout,lout,entr(igout,lout)
-            abort_message = 'entr negatif'
-            CALL abort_physic (modname,abort_message,1)
-         endif
-
-         do ig=1,ngrid
-            if (detr(ig,l).gt.fm(ig,l)) then
-               ncorecfm6=ncorecfm6+1
-               detr(ig,l)=fm(ig,l)
-               entr(ig,l)=fm(ig,l+1)
-
-! Dans le cas ou on est au dessus de la couche d'alimentation et que le
-! detrainement est plus fort que le flux de masse, on stope le thermique.
-!test:on commente
-!               if (l.gt.lalim(ig)) then
-!                  lmax(ig)=l
-!                  fm(ig,l+1)=0.
-!                  entr(ig,l)=0.
-!               else
-!                  ncorecfm7=ncorecfm7+1
-!               endif
-            endif
-
-            if(l.gt.lmax(ig)) then
-               detr(ig,l)=0.
-               fm(ig,l+1)=0.
-               entr(ig,l)=0.
-            endif
-         enddo
-
-         labort_physic=.false.
-         do ig=1,ngrid
-            if (entr(ig,l).lt.0.) then
-               labort_physic=.true.
-               igout=ig
-            endif
-         enddo
-         if (labort_physic) then
-            ig=igout
-            print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
-            print*,'entr(ig,l)',entr(ig,l)
-            print*,'fm(ig,l)',fm(ig,l)
-            abort_message = 'probleme dans thermcell flux'
-            CALL abort_physic (modname,abort_message,1)
-         endif
-
-
-!     enddo
-      endif
-
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-------------------------------------------------------------------------
-!fm ne peut pas etre negatif
-!-------------------------------------------------------------------------
-
-!     do l=1,klev
-         do ig=1,ngrid
-            if (fm(ig,l+1).lt.0.) then
-               detr(ig,l)=detr(ig,l)+fm(ig,l+1)
-               fm(ig,l+1)=0.
-               ncorecfm2=ncorecfm2+1
-            endif
-         enddo
-
-         labort_physic=.false.
-         do ig=1,ngrid
-            if (detr(ig,l).lt.0.) then
-               labort_physic=.true.
-               igout=ig
-            endif
-        enddo
-        if (labort_physic) then
-               ig=igout
-               print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig)
-               print*,'detr(ig,l)',detr(ig,l)
-               print*,'fm(ig,l)',fm(ig,l)
-               abort_message = 'probleme dans thermcell flux'
-               CALL abort_physic (modname,abort_message,1)
-        endif
-!    enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-----------------------------------------------------------------------
-!la fraction couverte ne peut pas etre superieure a 1            
-!-----------------------------------------------------------------------
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH Partie a revisiter.
-! Il semble qu'etaient codees ici deux optiques dans le cas
-! F/ (rho *w) > 1
-! soit limiter la hauteur du thermique en considerant que c'est 
-! la derniere chouche, soit limiter F a rho w.
-! Dans le second cas, il faut en fait limiter a un peu moins
-! que ca parce qu'on a des 1 / ( 1 -alpha) un peu plus loin
-! dans thermcell_main et qu'il semble de toutes facons deraisonable
-! d'avoir des fractions de 1..
-! Ci dessous, et dans l'etat actuel, le premier des  deux if est
-! sans doute inutile.
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!    do l=1,klev
-        do ig=1,ngrid
-           if (zw2(ig,l+1).gt.1.e-10) then
-           zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*alphamax
-           if ( fm(ig,l+1) .gt. zfm) then
-              f_old=fm(ig,l+1)
-              fm(ig,l+1)=zfm
-!             zw2(ig,l+1)=0.
-!             zqla(ig,l+1)=0.
-              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
-!             lmax(ig)=l+1
-!             zmax(ig)=zlev(ig,lmax(ig))
-!             print*,'alpha>1',l+1,lmax(ig)
-              ncorecalpha=ncorecalpha+1
-           endif
-           endif
-        enddo
-!    enddo
-!
-
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-! Fin de la grande boucle sur les niveaux verticaux
-      enddo
-
-!      if (prt_level.ge.10) &
-!    &    call printflux(ngrid,klev,lunout1,igout,f,lmax,lalim, &
-!    &    ptimestep,masse,entr,detr,fm,'8  ')
-
-
-!-----------------------------------------------------------------------
-! On fait en sorte que la quantite totale d'air entraine dans le 
-! panache ne soit pas trop grande comparee a la masse de la maille
-!-----------------------------------------------------------------------
-
-      if (1.eq.1) then
-      labort_physic=.false.
-      do l=1,klev-1
-         do ig=1,ngrid
-            eee0=entr(ig,l)
-            ddd0=detr(ig,l)
-            eee=entr(ig,l)-masse(ig,l)*fomass_max/ptimestep
-            ddd=detr(ig,l)-eee
-            if (eee.gt.0.) then
-                ncorecfm3=ncorecfm3+1
-                entr(ig,l)=entr(ig,l)-eee
-                if ( ddd.gt.0.) then
-!   l'entrainement est trop fort mais l'exces peut etre compense par une
-!   diminution du detrainement)
-                   detr(ig,l)=ddd
-                else
-!   l'entrainement est trop fort mais l'exces doit etre compense en partie
-!   par un entrainement plus fort dans la couche superieure
-                   if(l.eq.lmax(ig)) then
-                      detr(ig,l)=fm(ig,l)+entr(ig,l)
-                   else
-                      if(l.ge.lmax(ig).and.0.eq.1) then
-                         igout=ig
-                         lout=l
-                         labort_physic=.true.
-                      endif
-                      entr(ig,l+1)=entr(ig,l+1)-ddd
-                      detr(ig,l)=0.
-                      fm(ig,l+1)=fm(ig,l)+entr(ig,l)
-                      detr(ig,l)=0.
-                   endif
-                endif
-            endif
-         enddo
-      enddo
-      if (labort_physic) then
-                         ig=igout
-                         l=lout
-                         print*,'ig,l',ig,l
-                         print*,'eee0',eee0
-                         print*,'ddd0',ddd0
-                         print*,'eee',eee
-                         print*,'ddd',ddd
-                         print*,'entr',entr(ig,l)
-                         print*,'detr',detr(ig,l)
-                         print*,'masse',masse(ig,l)
-                         print*,'fomass_max',fomass_max
-                         print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*fomass_max/ptimestep
-                         print*,'ptimestep',ptimestep
-                         print*,'lmax(ig)',lmax(ig)
-                         print*,'fm(ig,l+1)',fm(ig,l+1)
-                         print*,'fm(ig,l)',fm(ig,l)
-                         abort_message = 'probleme dans thermcell_flux'
-                         CALL abort_physic (modname,abort_message,1)
-      endif
-      endif
-!                  
-!              ddd=detr(ig)-entre
-!on s assure que tout s annule bien en zmax
-      do ig=1,ngrid
-         fm(ig,lmax(ig)+1)=0.
-         entr(ig,lmax(ig))=0.
-         detr(ig,lmax(ig))=fm(ig,lmax(ig))+entr(ig,lmax(ig))
-      enddo
-
-!-----------------------------------------------------------------------
-! Impression du nombre de bidouilles qui ont ete necessaires
-!-----------------------------------------------------------------------
-
-!IM 090508 beg
-!     if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then
-!
-!         print*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',&
-!   &     ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', &
-!   &     ncorecfm4,'x fm4',ncorecfm5,'x fm5 et', &
-!   &     ncorecfm6,'x fm6', &
-!   &     ncorecfm7,'x fm7', &
-!   &     ncorecfm8,'x fm8', &
-!   &     ncorecalpha,'x alpha'
-!     endif
-!IM 090508 end
-
-!      if (prt_level.ge.10) &
-!    &    call printflux(ngrid,klev,lunout1,igout,f,lmax,lalim, &
-!    &    ptimestep,masse,entr,detr,fm,'fin')
-
-
-      return
-      end
+link ../phylmd/thermcell_flux2.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_height.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_height.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_height.F90	(revision 3940)
@@ -1,163 +1,1 @@
-      SUBROUTINE thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,  &
-     &           zw2,zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)                            
-
-!-----------------------------------------------------------------------------
-!thermcell_height: calcul des caracteristiques du thermique: zmax,wmax,zmix
-!-----------------------------------------------------------------------------
-      IMPLICIT NONE
-#include "thermcell.h"
-
-      INTEGER ig,l
-      INTEGER ngrid,nlay
-      INTEGER lalim(ngrid),lmin(ngrid)
-      INTEGER lmix(ngrid)
-      REAL linter(ngrid)
-      integer lev_out                           ! niveau pour les print
-
-      REAL zw2(ngrid,nlay+1)
-      REAL zlev(ngrid,nlay+1)
-
-      REAL wmax(ngrid)
-      INTEGER lmax(ngrid)
-      REAL zmax(ngrid)
-      REAL zmax0(ngrid)
-      REAL zmix(ngrid)
-      REAL num(ngrid)
-      REAL denom(ngrid)
-
-      REAL zlevinter(ngrid)
-
-!calcul de la hauteur max du thermique
-      do ig=1,ngrid
-         lmax(ig)=lalim(ig)
-      enddo
-      do ig=1,ngrid
-         do l=nlay,lalim(ig)+1,-1
-            if (zw2(ig,l).le.1.e-10) then
-               lmax(ig)=l-1
-            endif
-         enddo
-      enddo
-
-! On traite le cas particulier qu'il faudrait éviter ou le thermique
-! atteind le haut du modele ...
-      do ig=1,ngrid
-      if ( zw2(ig,nlay) > 1.e-10 ) then
-          print*,'WARNING !!!!! W2 thermiques non nul derniere couche '
-          lmax(ig)=nlay
-      endif
-      enddo
-
-! pas de thermique si couche 1 stable
-      do ig=1,ngrid
-         if (lmin(ig).gt.1) then
-             lmax(ig)=1
-             lmin(ig)=1
-             lalim(ig)=1
-         endif
-      enddo 
-!    
-! Determination de zw2 max
-      do ig=1,ngrid
-         wmax(ig)=0.
-      enddo
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-                if (zw2(ig,l).lt.0.)then
-                  print*,'pb2 zw2<0'
-                endif
-                zw2(ig,l)=sqrt(zw2(ig,l))
-                wmax(ig)=max(wmax(ig),zw2(ig,l))
-            else
-                 zw2(ig,l)=0.
-            endif
-          enddo
-      enddo
-
-!   Longueur caracteristique correspondant a la hauteur des thermiques.
-      do  ig=1,ngrid
-         zmax(ig)=0.
-         zlevinter(ig)=zlev(ig,1)
-      enddo
-
-!     if (iflag_thermals_ed.ge.1) then
-      if (1==0) then
-!CR:date de quand le calcul du zmax continu etait buggue 
-         num(:)=0.
-         denom(:)=0.
-         do ig=1,ngrid
-          do l=1,nlay
-             num(ig)=num(ig)+zw2(ig,l)*zlev(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-             denom(ig)=denom(ig)+zw2(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-          enddo
-       enddo
-       do ig=1,ngrid
-       if (denom(ig).gt.1.e-10) then
-          zmax(ig)=2.*num(ig)/denom(ig)
-          zmax0(ig)=zmax(ig)
-       endif 
-       enddo
- 
-      else
-!CR:Calcul de zmax continu via le linter      
-      do  ig=1,ngrid
-! calcul de zlevinter
-          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*  &
-     &    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)  &
-     &    -zlev(ig,lmax(ig)))
-!pour le cas ou on prend tjs lmin=1
-!       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,1))
-       zmax0(ig)=zmax(ig)
-      enddo
-
-
-      endif
-!endif iflag_thermals_ed
-!
-! def de  zmix continu (profil parabolique des vitesses)
-      do ig=1,ngrid
-           if (lmix(ig).gt.1) then
-! test 
-              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
-     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
-     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
-     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)  &
-     &        then
-!             
-            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
-     &        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)  &
-     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
-     &        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))  &
-     &        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
-     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
-     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
-     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-              else
-              zmix(ig)=zlev(ig,lmix(ig))
-              print*,'pb zmix'
-              endif
-          else 
-              zmix(ig)=0.
-          endif
-!test
-         if ((zmax(ig)-zmix(ig)).le.0.) then
-            zmix(ig)=0.9*zmax(ig)
-!            print*,'pb zmix>zmax'
-         endif
-      enddo
-!
-! calcul du nouveau lmix correspondant
-      do ig=1,ngrid
-         do l=1,nlay
-            if (zmix(ig).ge.zlev(ig,l).and.  &
-     &          zmix(ig).lt.zlev(ig,l+1)) then
-              lmix(ig)=l
-             endif
-          enddo
-      enddo
-!
-      return 
-      end
+link ../phylmd/thermcell_height.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_init.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_init.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_init.F90	(revision 3940)
@@ -1,59 +1,1 @@
-!
-! $Header$
-!
-      SUBROUTINE thermcell_init(ngrid,nlay,ztv,zlay,zlev,  &
-     &                  lalim,lmin,alim_star,alim_star_tot,lev_out)
-
-!----------------------------------------------------------------------
-!thermcell_init: calcul du profil d alimentation du thermique
-!----------------------------------------------------------------------
-      USE print_control_mod, ONLY: lunout
-      IMPLICIT NONE
-#include "thermcell.h"
-
-      INTEGER l,ig
-!arguments d entree
-      INTEGER ngrid,nlay
-      REAL ztv(ngrid,nlay)
-      REAL zlay(ngrid,nlay)
-      REAL zlev(ngrid,nlay+1)
-!arguments de sortie
-      INTEGER lalim(ngrid)
-      INTEGER lmin(ngrid)
-      REAL alim_star(ngrid,nlay)
-      REAL alim_star_tot(ngrid)
-      integer lev_out                           ! niveau pour les print
-      
-      REAL zzalim(ngrid)
-!CR: ponderation entrainement des couches instables
-!def des alim_star tels que alim=f*alim_star      
-
-
-      write(lunout,*)'THERM INIT V20C '
-
-      alim_star_tot(:)=0.
-      alim_star(:,:)=0.
-      lmin(:)=1
-      lalim(:)=1
-
-      do l=1,nlay-1
-         do ig=1,ngrid
-            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
-               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
-     &                       *sqrt(zlev(ig,l+1)) 
-               lalim(:)=l+1
-               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-            endif
-         enddo
-      enddo
-      do l=1,nlay
-         do ig=1,ngrid 
-            if (alim_star_tot(ig) > 1.e-10 ) then
-               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
-            endif
-         enddo
-      enddo
-      alim_star_tot(:)=1.
-
-      return
-      end  
+link ../phylmd/thermcell_init.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_main.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_main.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_main.F90	(revision 3940)
@@ -267,5 +267,4 @@
       REAL xtzo_tmp(klon,klev)
       integer ixt
-      real xtzl(ntraciso,klon,klev) ! Rq: n'est pas utilisé? Juste diagnostiqué dans thermcell_env. A supprimer?
 #endif
 !
@@ -329,9 +328,5 @@
 !
       CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
-     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out &
-#ifdef ISO
-     &            ,xtpo,xtzo,xtzl &
-#endif      
-     &   )
+     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
        
       if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env'
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_old.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_old.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_old.F90	(revision 3940)
@@ -1,5341 +1,1 @@
-SUBROUTINE thermcell_2002(ngrid, nlay, ptimestep, iflag_thermals, pplay, &
-    pplev, pphi, pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, &
-    fraca, wa_moy, r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  USE write_field_phy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di, iflag_thermals
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-  REAL fraca(ngrid, nlay+1), zw2(ngrid, nlay+1)
-
-  INTEGER, SAVE :: idetr = 3, lev_out = 1
-  !$OMP THREADPRIVATE(idetr,lev_out)
-
-  ! local:
-  ! ------
-
-  INTEGER, SAVE :: dvdq = 0, flagdq = 0, dqimpl = 1
-  LOGICAL, SAVE :: debut = .TRUE.
-  !$OMP THREADPRIVATE(dvdq,flagdq,debut,dqimpl)
-
-  INTEGER ig, k, l, lmax(klon, klev+1), lmaxa(klon), lmix(klon)
-  REAL zmax(klon), zw, zz, ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  REAL wmax(klon, klev), wmaxa(klon)
-
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  CHARACTER (LEN=2) :: str2
-  CHARACTER (LEN=10) :: str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell2002'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  IF (debut) THEN
-    flagdq = (iflag_thermals-1000)/100
-    dvdq = (iflag_thermals-(1000+flagdq*100))/10
-    IF (flagdq==2) dqimpl = -1
-    IF (flagdq==3) dqimpl = 1
-    debut = .FALSE.
-  END IF
-  PRINT *, 'TH flag th ', iflag_thermals, flagdq, dvdq, dqimpl
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      wa(ig, k, k) = 0.
-      wa(ig, k, k+1) = 2.*rg*(ztv(ig,k)-ztv(ig,k+1))/ztv(ig, k+1)* &
-        (zlev(ig,k+1)-zlev(ig,k))
-    END DO
-    DO l = k + 1, nlay - 1
-      DO ig = 1, ngrid
-        wa(ig, k, l+1) = wa(ig, k, l) + 2.*rg*(ztv(ig,k)-ztv(ig,l))/ztv(ig, l &
-          )*(zlev(ig,l+1)-zlev(ig,l))
-      END DO
-    END DO
-    DO ig = 1, ngrid
-      wa(ig, k, nlay+1) = 0.
-    END DO
-  END DO
-
-  ! print*,'4 OK convect8'
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      lmax(ig, k) = k
-    END DO
-    DO l = nlay, k + 1, -1
-      DO ig = 1, ngrid
-        IF (wa(ig,k,l)<=1.E-10) lmax(ig, k) = l - 1
-      END DO
-    END DO
-  END DO
-
-  ! print*,'5 OK convect8'
-  ! Calcule du w max du thermique
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      wmax(ig, k) = 0.
-    END DO
-  END DO
-
-  DO k = 1, nlay - 1
-    DO l = k, nlay
-      DO ig = 1, ngrid
-        IF (l<=lmax(ig,k)) THEN
-          wa(ig, k, l) = sqrt(wa(ig,k,l))
-          wmax(ig, k) = max(wmax(ig,k), wa(ig,k,l))
-        ELSE
-          wa(ig, k, l) = 0.
-        END IF
-      END DO
-    END DO
-  END DO
-
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      pu_therm(ig, k) = sqrt(wmax(ig,k))
-      pv_therm(ig, k) = sqrt(wmax(ig,k))
-    END DO
-  END DO
-
-  ! print*,'6 OK convect8'
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 500.
-  END DO
-  ! print*,'LMAX LMAX LMAX '
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      zmax(ig) = max(zmax(ig), zlev(ig,lmax(ig,k))-zlev(ig,k))
-    END DO
-    ! print*,k,lmax(1,k)
-  END DO
-  ! print*,'ZMAX ZMAX ZMAX ',zmax
-  ! call dump2d(iim,jjm-1,zmax(2:ngrid-1),'ZMAX      ')
-
-  ! print*,'OKl336'
-  ! Calcul de l'entrainement.
-  ! Le rapport d'aspect relie la largeur de l'ascendance a l'epaisseur
-  ! de la couche d'alimentation en partant du principe que la vitesse
-  ! maximum dans l'ascendance est la vitesse d'entrainement horizontale.
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      zzz = rho(ig, k)*wmax(ig, k)*(zlev(ig,k+1)-zlev(ig,k))/ &
-        (zmax(ig)*r_aspect)
-      IF (w2di==2) THEN
-        entr(ig, k) = entr(ig, k) + ptimestep*(zzz-entr(ig,k))/tho
-      ELSE
-        entr(ig, k) = zzz
-      END IF
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-
-
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-
-  ! print*,'OKl372'
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      ! if (zw2(ig,l).lt.1.e-10.and.ztv(ig,l).gt.ztv(ig,l+1)) then
-      ! print*,'COUCOU ',l,zw2(ig,l),ztv(ig,l),ztv(ig,l+1)
-      IF (zw2(ig,l)<1.E-10 .AND. ztv(ig,l)>ztv(ig,l+1) .AND. &
-          entr(ig,l)>1.E-10) THEN
-        ! print*,'COUCOU cas 1'
-        ! Initialisation de l'ascendance
-        ! lmix(ig)=1
-        ztva(ig, l) = ztv(ig, l)
-        fmc(ig, l) = 0.
-        fmc(ig, l+1) = entr(ig, l)
-        zw2(ig, l) = 0.
-        ! if (.not.ztv(ig,l+1).gt.150.) then
-        ! print*,'ig,l+1,ztv(ig,l+1)'
-        ! print*, ig,l+1,ztv(ig,l+1)
-        ! endif
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF (zw2(ig,l)>=1.E-10 .AND. fmc(ig,l)+entr(ig,l)>1.E-10) THEN
-        ! Incrementation...
-        fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-        ! if (.not.fmc(ig,l+1).gt.1.e-15) then
-        ! print*,'ig,l+1,fmc(ig,l+1)'
-        ! print*, ig,l+1,fmc(ig,l+1)
-        ! print*,'Fmc ',(fmc(ig,ll),ll=1,klev+1)
-        ! print*,'W2 ',(zw2(ig,ll),ll=1,klev+1)
-        ! print*,'Tv ',(ztv(ig,ll),ll=1,klev)
-        ! print*,'Entr ',(entr(ig,ll),ll=1,klev)
-        ! endif
-        ztva(ig, l) = (fmc(ig,l)*ztva(ig,l-1)+entr(ig,l)*ztv(ig,l))/ &
-          fmc(ig, l+1)
-        ! mise a jour de la vitesse ascendante (l'air entraine de la couche
-        ! consideree commence avec une vitesse nulle).
-        zw2(ig, l+1) = zw2(ig, l)*(fmc(ig,l)/fmc(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      IF (zw2(ig,l+1)<0.) THEN
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-      ! print*,'COUCOU cas 2 LMIX=',lmix(ig),wa_moy(ig,l+1),wmaxa(ig)
-    END DO
-  END DO
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  ! print*,'OKl439'
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        IF (l>lmix(ig)) THEN
-          xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          IF (idetr==0) THEN
-            fraca(ig, l) = fraca(ig, lmix(ig))
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fraca(ig, lmix(ig))*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fraca(ig, lmix(ig))*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fraca(ig, lmix(ig))*xxx(ig, l)**2
-          END IF
-        END IF
-        ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-  ! print*,'OK 444 '
-
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (flagdq==0) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-    PRINT *, 'THERMALS OPT 1'
-  ELSE IF (flagdq==1) THEN
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-    PRINT *, 'THERMALS OPT 2'
-  ELSE
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zh, &
-      zdhadj, zha, lev_out)
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zo, &
-      pdoadj, zoa, lev_out)
-    PRINT *, 'THERMALS OPT 3', dqimpl
-  END IF
-
-  PRINT *, 'TH VENT ', dvdq
-  IF (dvdq==0) THEN
-    ! print*,'TH VENT OK ',dvdq
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  ELSE IF (dvdq==1) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE IF (dvdq==2) THEN
-    CALL thermcell_dv2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, &
-      zmax, zu, zv, pduadj, pdvadj, zua, zva, lev_out)
-  ELSE IF (dvdq==3) THEN
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zu, &
-      pduadj, zua, lev_out)
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zv, &
-      pdvadj, zva, lev_out)
-  END IF
-
-  ! CALL writefield_phy('duadj',pduadj,klev)
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-        IF (detr(ig,l)<0.) THEN
-          entr(ig, l) = entr(ig, l) - detr(ig, l)
-          detr(ig, l) = 0.
-          ! print*,'WARNING !!! detrainement negatif ',ig,l
-        END IF
-      END DO
-    END DO
-  END IF
-
-  ! print*,'15 OK convect8'
-
-
-  ! if(wa_moy(1,4).gt.1.e-10) stop
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE thermcell_2002
-
-SUBROUTINE thermcell_cld(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, &
-    debut, pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, zqla, &
-    lmax, zmax_sec, wmax_sec, zw_sec, lmix_sec, ratqscth, ratqsdiff & ! s
-                                                                      ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  REAL alpha
-  SAVE alpha
-  DATA alpha/1./
-  !$OMP THREADPRIVATE(alpha)
-
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-  REAL zmax_sec(klon)
-  REAL zmax_sec2(klon)
-  REAL zw_sec(klon, klev+1)
-  INTEGER lmix_sec(klon)
-  REAL w_est(klon, klev+1)
-  ! on garde le zmax du pas de temps precedent
-  ! real zmax0(klon)
-  ! save zmax0
-  ! real zmix0(klon)
-  ! save zmix0
-  REAL, SAVE, ALLOCATABLE :: zmax0(:), zmix0(:)
-  !$OMP THREADPRIVATE(zmax0, zmix0)
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL deltaz(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL zthl(klon, klev), zdthladj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL zl(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zta(klon, klev)
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev), wth3(klon, klev)
-  REAL q2(klon, klev)
-  REAL dtheta(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL ratqscth(klon, klev)
-  REAL sum
-  REAL sumdiff
-  REAL ratqsdiff(klon, klev)
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wmax_sec(klon)
-  REAL wmax_sec2(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL massetot(klon, klev)
-  REAL detr0(klon, klev)
-  REAL alim0(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  REAL zcor, zdelta, zcvm5, qlbef
-  REAL tbef(klon), qsatbef(klon)
-  REAL dqsat_dt, dt, num, denom
-  REAL reps, rlvcp, ddt0
-  REAL ztla(klon, klev), zqla(klon, klev), zqta(klon, klev)
-  ! CR niveau de condensation
-  REAL nivcon(klon)
-  REAL zcon(klon)
-  REAL zqsat(klon, klev)
-  REAL zqsatth(klon, klev)
-  PARAMETER (ddt0=.01)
-
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL detr_star(klon, klev)
-  REAL alim_star_tot(klon), alim_star2(klon)
-  REAL entr_star_tot(klon)
-  REAL detr_star_tot(klon)
-  REAL alim_star(klon, klev)
-  REAL alim(klon, klev)
-  REAL nu(klon, klev)
-  REAL nu_e(klon, klev)
-  REAL nu_min
-  REAL nu_max
-  REAL nu_r
-  REAL f(klon)
-  ! real f(klon), f0(klon)
-  ! save f0
-  REAL, SAVE, ALLOCATABLE :: f0(:)
-  !$OMP THREADPRIVATE(f0)
-
-  REAL f_old
-  REAL zlevinter(klon)
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-  ! data first /.false./
-  ! save first
-  LOGICAL nuage
-  ! save nuage
-  LOGICAL boucle
-  LOGICAL therm
-  LOGICAL debut
-  LOGICAL rale
-  INTEGER test(klon)
-  INTEGER signe_zw2
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell_cld'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-  LOGICAL zsat(klon)
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  IF (first) THEN
-    ALLOCATE (zmix0(klon))
-    ALLOCATE (zmax0(klon))
-    ALLOCATE (f0(klon))
-    first = .FALSE.
-  END IF
-
-  sorties = .FALSE.
-  ! print*,'NOUVEAU DETR PLUIE '
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! Initialisation
-  rlvcp = rlvtt/rcpd
-  reps = rd/rv
-  ! initialisations de zqsat
-  DO ll = 1, nlay
-    DO ig = 1, ngrid
-      zqsat(ig, ll) = 0.
-      zqsatth(ig, ll) = 0.
-    END DO
-  END DO
-
-  ! on met le first a true pour le premier passage de la journée
-  DO ig = 1, klon
-    test(ig) = 0
-  END DO
-  IF (debut) THEN
-    DO ig = 1, klon
-      test(ig) = 1
-      f0(ig) = 0.
-      zmax0(ig) = 0.
-    END DO
-  END IF
-  DO ig = 1, klon
-    IF ((.NOT. debut) .AND. (f0(ig)<1.E-10)) THEN
-      test(ig) = 1
-    END IF
-  END DO
-  ! do ig=1,klon
-  ! print*,'test(ig)',test(ig),zmax0(ig)
-  ! enddo
-  nuage = .FALSE.
-  ! -----------------------------------------------------------------------
-  ! AM Calcul de T,q,ql a partir de Tl et qT
-  ! ---------------------------------------------------
-
-  ! Pr Tprec=Tl calcul de qsat
-  ! Si qsat>qT T=Tl, q=qT
-  ! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt)
-  ! On cherche DDT < DDT0
-
-  ! defaut
-  DO ll = 1, nlay
-    DO ig = 1, ngrid
-      zo(ig, ll) = po(ig, ll)
-      zl(ig, ll) = 0.
-      zh(ig, ll) = pt(ig, ll)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zsat(ig) = .FALSE.
-  END DO
-
-
-  DO ll = 1, nlay
-    ! les points insatures sont definitifs
-    DO ig = 1, ngrid
-      tbef(ig) = pt(ig, ll)
-      zdelta = max(0., sign(1.,rtt-tbef(ig)))
-      qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-      qsatbef(ig) = min(0.5, qsatbef(ig))
-      zcor = 1./(1.-retv*qsatbef(ig))
-      qsatbef(ig) = qsatbef(ig)*zcor
-      zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig))>1.E-10)
-    END DO
-
-    DO ig = 1, ngrid
-      IF (zsat(ig) .AND. (1==1)) THEN
-        qlbef = max(0., po(ig,ll)-qsatbef(ig))
-        ! si sature: ql est surestime, d'ou la sous-relax
-        dt = 0.5*rlvcp*qlbef
-        ! write(18,*),'DT0=',DT
-        ! on pourra enchainer 2 ou 3 calculs sans Do while
-        DO WHILE (abs(dt)>ddt0)
-          ! il faut verifier si c,a conserve quand on repasse en insature ...
-          tbef(ig) = tbef(ig) + dt
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          ! on veut le signe de qlbef
-          qlbef = po(ig, ll) - qsatbef(ig)
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-          zcor = 1./(1.-retv*qsatbef(ig))
-          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-          num = -tbef(ig) + pt(ig, ll) + rlvcp*qlbef
-          denom = 1. + rlvcp*dqsat_dt
-          IF (denom<1.E-10) THEN
-            PRINT *, 'pb denom'
-          END IF
-          dt = num/denom
-        END DO
-        ! on ecrit de maniere conservative (sat ou non)
-        zl(ig, ll) = max(0., qlbef)
-        ! T = Tl +Lv/Cp ql
-        zh(ig, ll) = pt(ig, ll) + rlvcp*zl(ig, ll)
-        zo(ig, ll) = po(ig, ll) - zl(ig, ll)
-      END IF
-      ! on ecrit zqsat
-      zqsat(ig, ll) = qsatbef(ig)
-    END DO
-  END DO
-  ! AM fin
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/100000.)**rkappa
-      ! zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
-      ! zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      ! zo(ig,l)=po(ig,l)
-      ! ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
-      ! AM attention zh est maintenant le profil de T et plus le profil de
-      ! theta !
-
-      ! T-> Theta
-      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
-      ! AM Theta_v
-      ztv(ig, l) = ztv(ig, l)*(1.+retv*(zo(ig,l))-zl(ig,l))
-      ! AM Thetal
-      zthl(ig, l) = pt(ig, l)/zpspsk(ig, l)
-
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-  ! calcul de deltaz
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      deltaz(ig, l) = zlev(ig, l+1) - zlev(ig, l)
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*ztv(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-  ! Cr:ajout:calcul de la masse
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des alim_star tels que alim=f*alim_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      alim_star(ig, l) = 0.
-      alim(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  therm = .FALSE.
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k + 1
-        therm = .TRUE.
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<lentr(ig)) THEN
-        ! def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
-        alim_star(ig, l) = max((ztv(ig,l)-ztv(ig,l+1)), 0.) & ! s
-                                                              ! *(zlev(ig,l+1)-zlev(ig,l))
-          *sqrt(zlev(ig,l+1))
-        ! alim_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
-        ! s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
-      END IF
-    END DO
-  END DO
-
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    ! if (lmin(ig).gt.1) then
-    ! CRnouveau test
-    IF (alim_star(ig,1)<1.E-10) THEN
-      DO l = 1, klev
-        alim_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    alim_star_tot(ig) = 0.
-    entr_star_tot(ig) = 0.
-    detr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      alim_star_tot(ig) = alim_star_tot(ig) + alim_star(ig, k)
-    END DO
-  END DO
-
-  ! Calcul entrainement normalise
-  DO ig = 1, ngrid
-    IF (alim_star_tot(ig)>1.E-10) THEN
-      ! do l=1,lentr(ig)
-      DO l = 1, klev
-        ! def possibles pour entr_star: zdthetadz, dthetadz, zdtheta
-        alim_star(ig, l) = alim_star(ig, l)/alim_star_tot(ig)
-      END DO
-    END IF
-  END DO
-
-  ! print*,'fin calcul alim_star'
-
-  ! AM:initialisations
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-      ztla(ig, k) = zthl(ig, k)
-      zqla(ig, k) = 0.
-      zqta(ig, k) = po(ig, k)
-      zsat(ig) = .FALSE.
-    END DO
-  END DO
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      detr_star(ig, k) = 0.
-      entr_star(ig, k) = 0.
-      detr(ig, k) = 0.
-      entr(ig, k) = 0.
-    END DO
-  END DO
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! n     print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  nu_min = l_mix
-  nu_max = 1000.
-  ! do ig=1,ngrid
-  ! nu_max=wmax_sec(ig)
-  ! enddo
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      nu(ig, k) = 0.
-      nu_e(ig, k) = 0.
-    END DO
-  END DO
-  ! Calcul de l'excès de température du à la diffusion turbulente
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      dtheta(ig, l) = 0.
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    DO l = 1, lentr(ig) - 1
-      dtheta(ig, l) = sqrt(10.*0.4*zlev(ig,l+1)**2*1.*((ztv(ig,l+1)- &
-        ztv(ig,l))/(zlev(ig,l+1)-zlev(ig,l)))**2)
-    END DO
-  END DO
-  ! do l=1,nlay-2
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. alim_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        ! AM
-        ! test:on rajoute un excès de T dans couche alim
-        ! ztla(ig,l)=zthl(ig,l)+dtheta(ig,l)
-        ztla(ig, l) = zthl(ig, l)
-        ! test: on rajoute un excès de q dans la couche alim
-        ! zqta(ig,l)=po(ig,l)+0.001
-        zqta(ig, l) = po(ig, l)
-        zqla(ig, l) = zl(ig, l)
-        ! AM
-        f_star(ig, l+1) = alim_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        w_est(ig, l+1) = zw2(ig, l+1)
-        larg_detr(ig, l) = 0.
-        ! print*,'coucou boucle 1'
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+alim_star(ig, &
-          l))>1.E-10) THEN
-        ! print*,'coucou boucle 2'
-        ! estimation du detrainement a partir de la geometrie du pas
-        ! precedent
-        IF ((test(ig)==1) .OR. ((.NOT. debut) .AND. (f0(ig)<1.E-10))) THEN
-          detr_star(ig, l) = 0.
-          entr_star(ig, l) = 0.
-          ! print*,'coucou test(ig)',test(ig),f0(ig),zmax0(ig)
-        ELSE
-          ! print*,'coucou debut detr'
-          ! tests sur la definition du detr
-          IF (zqla(ig,l-1)>1.E-10) THEN
-            nuage = .TRUE.
-          END IF
-
-          w_est(ig, l+1) = zw2(ig, l)*((f_star(ig,l))**2)/(f_star(ig,l)+ &
-            alim_star(ig,l))**2 + 2.*rg*(ztva(ig,l-1)-ztv(ig,l))/ztv(ig, l)*( &
-            zlev(ig,l+1)-zlev(ig,l))
-          IF (w_est(ig,l+1)<0.) THEN
-            w_est(ig, l+1) = zw2(ig, l)
-          END IF
-          IF (l>2) THEN
-            IF ((w_est(ig,l+1)>w_est(ig,l)) .AND. (zlev(ig, &
-                l+1)<zmax_sec(ig)) .AND. (zqla(ig,l-1)<1.E-10)) THEN
-              detr_star(ig, l) = max(0., (rhobarz(ig, &
-                l+1)*sqrt(w_est(ig,l+1))*sqrt(nu(ig,l)* &
-                zlev(ig,l+1))-rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(nu(ig,l)* &
-                zlev(ig,l)))/(r_aspect*zmax_sec(ig)))
-            ELSE IF ((zlev(ig,l+1)<zmax_sec(ig)) .AND. (zqla(ig, &
-                l-1)<1.E-10)) THEN
-              detr_star(ig, l) = -f0(ig)*f_star(ig, lmix(ig))/(rhobarz(ig, &
-                lmix(ig))*wmaxa(ig))*(rhobarz(ig,l+1)*sqrt(w_est(ig, &
-                l+1))*((zmax_sec(ig)-zlev(ig,l+1))/((zmax_sec(ig)-zlev(ig, &
-                lmix(ig)))))**2.-rhobarz(ig,l)*sqrt(w_est(ig, &
-                l))*((zmax_sec(ig)-zlev(ig,l))/((zmax_sec(ig)-zlev(ig,lmix(ig &
-                )))))**2.)
-            ELSE
-              detr_star(ig, l) = 0.002*f0(ig)*f_star(ig, l)* &
-                (zlev(ig,l+1)-zlev(ig,l))
-
-            END IF
-          ELSE
-            detr_star(ig, l) = 0.
-          END IF
-
-          detr_star(ig, l) = detr_star(ig, l)/f0(ig)
-          IF (nuage) THEN
-            entr_star(ig, l) = 0.4*detr_star(ig, l)
-          ELSE
-            entr_star(ig, l) = 0.4*detr_star(ig, l)
-          END IF
-
-          IF ((detr_star(ig,l))>f_star(ig,l)) THEN
-            detr_star(ig, l) = f_star(ig, l)
-            ! entr_star(ig,l)=0.
-          END IF
-
-          IF ((l<lentr(ig))) THEN
-            entr_star(ig, l) = 0.
-            ! detr_star(ig,l)=0.
-          END IF
-
-          ! print*,'ok detr_star'
-        END IF
-        ! prise en compte du detrainement dans le calcul du flux
-        f_star(ig, l+1) = f_star(ig, l) + alim_star(ig, l) + &
-          entr_star(ig, l) - detr_star(ig, l)
-        ! test
-        ! if (f_star(ig,l+1).lt.0.) then
-        ! f_star(ig,l+1)=0.
-        ! entr_star(ig,l)=0.
-        ! detr_star(ig,l)=f_star(ig,l)+alim_star(ig,l)
-        ! endif
-        ! test sur le signe de f_star
-        IF (f_star(ig,l+1)>1.E-10) THEN
-          ! then
-          ! test
-          ! if (((f_star(ig,l+1)+detr_star(ig,l)).gt.1.e-10)) then
-          ! AM on melange Tl et qt du thermique
-          ! on rajoute un excès de T dans la couche alim
-          ! if (l.lt.lentr(ig)) then
-          ! ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+
-          ! s
-          ! (alim_star(ig,l)+entr_star(ig,l))*(zthl(ig,l)+dtheta(ig,l)))
-          ! s     /(f_star(ig,l+1)+detr_star(ig,l))
-          ! else
-          ztla(ig, l) = (f_star(ig,l)*ztla(ig,l-1)+(alim_star(ig, &
-            l)+entr_star(ig,l))*zthl(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
-          ! s                    /(f_star(ig,l+1))
-          ! endif
-          ! on rajoute un excès de q dans la couche alim
-          ! if (l.lt.lentr(ig)) then
-          ! zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+
-          ! s           (alim_star(ig,l)+entr_star(ig,l))*(po(ig,l)+0.001))
-          ! s                 /(f_star(ig,l+1)+detr_star(ig,l))
-          ! else
-          zqta(ig, l) = (f_star(ig,l)*zqta(ig,l-1)+(alim_star(ig, &
-            l)+entr_star(ig,l))*po(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
-          ! s                   /(f_star(ig,l+1))
-          ! endif
-          ! AM on en deduit thetav et ql du thermique
-          ! CR test
-          ! Tbef(ig)=ztla(ig,l)*zpspsk(ig,l)
-          tbef(ig) = ztla(ig, l)*zpspsk(ig, l)
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig))>1.E-10)
-
-          IF (zsat(ig) .AND. (1==1)) THEN
-            qlbef = max(0., zqta(ig,l)-qsatbef(ig))
-            dt = 0.5*rlvcp*qlbef
-            ! write(17,*)'DT0=',DT
-            DO WHILE (abs(dt)>ddt0)
-              ! print*,'aie'
-              tbef(ig) = tbef(ig) + dt
-              zdelta = max(0., sign(1.,rtt-tbef(ig)))
-              qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-              qsatbef(ig) = min(0.5, qsatbef(ig))
-              zcor = 1./(1.-retv*qsatbef(ig))
-              qsatbef(ig) = qsatbef(ig)*zcor
-              qlbef = zqta(ig, l) - qsatbef(ig)
-
-              zdelta = max(0., sign(1.,rtt-tbef(ig)))
-              zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-              zcor = 1./(1.-retv*qsatbef(ig))
-              dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-              num = -tbef(ig) + ztla(ig, l)*zpspsk(ig, l) + rlvcp*qlbef
-              denom = 1. + rlvcp*dqsat_dt
-              IF (denom<1.E-10) THEN
-                PRINT *, 'pb denom'
-              END IF
-              dt = num/denom
-              ! write(17,*)'DT=',DT
-            END DO
-            zqla(ig, l) = max(0., zqta(ig,l)-qsatbef(ig))
-            zqla(ig, l) = max(0., qlbef)
-            ! zqla(ig,l)=0.
-          END IF
-          ! zqla(ig,l) = max(0.,zqta(ig,l)-qsatbef(ig))
-
-          ! on ecrit de maniere conservative (sat ou non)
-          ! T = Tl +Lv/Cp ql
-          ! CR rq utilisation de humidite specifique ou rapport de melange?
-          ztva(ig, l) = ztla(ig, l)*zpspsk(ig, l) + rlvcp*zqla(ig, l)
-          ztva(ig, l) = ztva(ig, l)/zpspsk(ig, l)
-          ! on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-          zha(ig, l) = ztva(ig, l)
-          ! if (l.lt.lentr(ig)) then
-          ! ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
-          ! s              -zqla(ig,l))-zqla(ig,l)) + 0.1
-          ! else
-          ztva(ig, l) = ztva(ig, l)*(1.+retv*(zqta(ig,l)-zqla(ig, &
-            l))-zqla(ig,l))
-          ! endif
-          ! ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-          ! s                 /(1.-retv*zqla(ig,l))
-          ! ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-          ! ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
-          ! s                 /(1.-retv*zqta(ig,l))
-          ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
-          ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
-          ! write(13,*)zqla(ig,l),zqla(ig,l)/(1.-retv*zqla(ig,l))
-          ! on ecrit zqsat
-          zqsatth(ig, l) = qsatbef(ig)
-          ! enddo
-          ! DO ig=1,ngrid
-          ! if (zw2(ig,l).ge.1.e-10.and.
-          ! s               f_star(ig,l)+entr_star(ig,l).gt.1.e-10) then
-          ! mise a jour de la vitesse ascendante (l'air entraine de la couche
-          ! consideree commence avec une vitesse nulle).
-
-          ! if (f_star(ig,l+1).gt.1.e-10) then
-          zw2(ig, l+1) = zw2(ig, l)* & ! s
-                                       ! ((f_star(ig,l)-detr_star(ig,l))**2)
-          ! s                  /f_star(ig,l+1)**2+
-            ((f_star(ig,l))**2)/(f_star(ig,l+1)+detr_star(ig,l))**2 + & ! s
-                                                                        ! /(f_star(ig,l+1))**2+
-            2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-          ! s                   *(f_star(ig,l)/f_star(ig,l+1))**2
-
-        END IF
-      END IF
-
-      IF (zw2(ig,l+1)<0.) THEN
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        ! print*,'linter=',linter(ig)
-        ! else if ((zw2(ig,l+1).lt.1.e-10).and.(zw2(ig,l+1).ge.0.)) then
-        ! linter(ig)=l+1
-        ! print*,'linter=l',zw2(ig,l),zw2(ig,l+1)
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-        ! wa_moy(ig,l+1)=zw2(ig,l+1)
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  PRINT *, 'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-      lentr(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          PRINT *, 'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    ! pour le cas ou on prend tjs lmin=1
-    ! zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,1))
-    zmax0(ig) = zmax(ig)
-    WRITE (11, *) 'ig,lmax,linter', ig, lmax(ig), linter(ig)
-    WRITE (12, *) 'ig,zlevinter,zmax', ig, zmax(ig), zlevinter(ig)
-  END DO
-
-  ! Calcul de zmax_sec et wmax_sec
-  CALL fermeture_seche(ngrid, nlay, pplay, pplev, pphi, zlev, rhobarz, f0, &
-    zpspsk, alim, zh, zo, lentr, lmin, nu_min, nu_max, r_aspect, zmax_sec2, &
-    wmax_sec2)
-
-  PRINT *, 'avant fermeture'
-  ! Fermeture,determination de f
-  ! en lmax f=d-e
-  DO ig = 1, ngrid
-    ! entr_star(ig,lmax(ig))=0.
-    ! f_star(ig,lmax(ig)+1)=0.
-    ! detr_star(ig,lmax(ig))=f_star(ig,lmax(ig))+entr_star(ig,lmax(ig))
-    ! s                       +alim_star(ig,lmax(ig))
-  END DO
-
-  DO ig = 1, ngrid
-    alim_star2(ig) = 0.
-  END DO
-  ! calcul de entr_star_tot
-  DO ig = 1, ngrid
-    DO k = 1, lmix(ig)
-      entr_star_tot(ig) = entr_star_tot(ig) & ! s
-                                              ! +entr_star(ig,k)
-        +alim_star(ig, k)
-      ! s                        -detr_star(ig,k)
-      detr_star_tot(ig) = detr_star_tot(ig) & ! s
-                                              ! +alim_star(ig,k)
-        -detr_star(ig, k) + entr_star(ig, k)
-    END DO
-  END DO
-
-  DO ig = 1, ngrid
-    IF (alim_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      ! do k=lmin(ig),lentr(ig)
-      DO k = 1, lentr(ig)
-        alim_star2(ig) = alim_star2(ig) + alim_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      IF ((zmax_sec(ig)>1.E-10) .AND. (1==1)) THEN
-        f(ig) = wmax_sec(ig)/(max(500.,zmax_sec(ig))*r_aspect*alim_star2(ig))
-        f(ig) = f(ig) + (f0(ig)-f(ig))*exp((-ptimestep/zmax_sec(ig))*wmax_sec &
-          (ig))
-      ELSE
-        f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*alim_star2(ig))
-        f(ig) = f(ig) + (f0(ig)-f(ig))*exp((-ptimestep/zmax(ig))*wmax(ig))
-      END IF
-    END IF
-    f0(ig) = f(ig)
-  END DO
-  PRINT *, 'apres fermeture'
-  ! Calcul de l'entrainement
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      alim(ig, k) = f(ig)*alim_star(ig, k)
-    END DO
-  END DO
-  ! CR:test pour entrainer moins que la masse
-  ! do ig=1,ngrid
-  ! do l=1,lentr(ig)
-  ! if ((alim(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
-  ! alim(ig,l+1)=alim(ig,l+1)+alim(ig,l)
-  ! s                       -0.9*masse(ig,l)/ptimestep
-  ! alim(ig,l)=0.9*masse(ig,l)/ptimestep
-  ! endif
-  ! enddo
-  ! enddo
-  ! calcul du détrainement
-  DO ig = 1, klon
-    DO k = 1, klev
-      detr(ig, k) = f(ig)*detr_star(ig, k)
-      IF (detr(ig,k)<0.) THEN
-        ! print*,'detr1<0!!!'
-      END IF
-    END DO
-    DO k = 1, klev
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-      IF (entr(ig,k)<0.) THEN
-        ! print*,'entr1<0!!!'
-      END IF
-    END DO
-  END DO
-
-  ! do ig=1,ngrid
-  ! do l=1,klev
-  ! if (((detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep).gt.
-  ! s          (masse(ig,l))) then
-  ! print*,'d2+e2+a2>m2','ig=',ig,'l=',l,'lmax(ig)=',lmax(ig),'d+e+a='
-  ! s,(detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep,'m=',masse(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-  ! Calcul des flux
-
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig)
-      ! do l=1,klev
-      ! fmc(ig,l+1)=f(ig)*f_star(ig,l+1)
-      fmc(ig, l+1) = fmc(ig, l) + alim(ig, l) + entr(ig, l) - detr(ig, l)
-      ! print*,'??!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
-      ! s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
-      ! s  'f+1=',fmc(ig,l+1)
-      IF (fmc(ig,l+1)<0.) THEN
-        PRINT *, 'fmc1<0', l + 1, lmax(ig), fmc(ig, l+1)
-        fmc(ig, l+1) = fmc(ig, l)
-        detr(ig, l) = alim(ig, l) + entr(ig, l)
-        ! fmc(ig,l+1)=0.
-        ! print*,'fmc1<0',l+1,lmax(ig),fmc(ig,l+1)
-      END IF
-      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
-      ! f_old=fmc(ig,l+1)
-      ! fmc(ig,l+1)=fmc(ig,l)
-      ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1)
-      ! endif
-
-      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
-      ! f_old=fmc(ig,l+1)
-      ! fmc(ig,l+1)=fmc(ig,l)
-      ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l)
-      ! endif
-      ! rajout du test sur alpha croissant
-      ! if test
-      ! if (1.eq.0) then
-
-      IF (l==klev) THEN
-        PRINT *, 'THERMCELL PB ig=', ig, '   l=', l
-        abort_message = 'THERMCELL PB'
-        CALL abort_physic(modname, abort_message, 1)
-      END IF
-      ! if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and.
-      ! s     (l.ge.lentr(ig)).and.
-      IF ((zw2(ig,l+1)>1.E-10) .AND. (zw2(ig,l)>1.E-10) .AND. (l>=lentr(ig))) &
-          THEN
-        IF (((fmc(ig,l+1)/(rhobarz(ig,l+1)*zw2(ig,l+1)))>(fmc(ig,l)/ &
-            (rhobarz(ig,l)*zw2(ig,l))))) THEN
-          f_old = fmc(ig, l+1)
-          fmc(ig, l+1) = fmc(ig, l)*rhobarz(ig, l+1)*zw2(ig, l+1)/ &
-            (rhobarz(ig,l)*zw2(ig,l))
-          detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
-          ! detr(ig,l)=(fmc(ig,l+1)-fmc(ig,l))/(0.4-1.)
-          ! entr(ig,l)=0.4*detr(ig,l)
-          ! entr(ig,l)=fmc(ig,l+1)-fmc(ig,l)+detr(ig,l)
-        END IF
-      END IF
-      IF ((fmc(ig,l+1)>fmc(ig,l)) .AND. (l>lentr(ig))) THEN
-        f_old = fmc(ig, l+1)
-        fmc(ig, l+1) = fmc(ig, l)
-        detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
-      END IF
-      IF (detr(ig,l)>fmc(ig,l)) THEN
-        detr(ig, l) = fmc(ig, l)
-        entr(ig, l) = fmc(ig, l+1) - alim(ig, l)
-      END IF
-      IF (fmc(ig,l+1)<0.) THEN
-        detr(ig, l) = detr(ig, l) + fmc(ig, l+1)
-        fmc(ig, l+1) = 0.
-        PRINT *, 'fmc2<0', l + 1, lmax(ig)
-      END IF
-
-      ! test pour ne pas avoir f=0 et d=e/=0
-      ! if (fmc(ig,l+1).lt.1.e-10) then
-      ! detr(ig,l+1)=0.
-      ! entr(ig,l+1)=0.
-      ! zqla(ig,l+1)=0.
-      ! zw2(ig,l+1)=0.
-      ! lmax(ig)=l+1
-      ! zmax(ig)=zlev(ig,lmax(ig))
-      ! endif
-      IF (zw2(ig,l+1)>1.E-10) THEN
-        IF ((((fmc(ig,l+1))/(rhobarz(ig,l+1)*zw2(ig,l+1)))>1.)) THEN
-          f_old = fmc(ig, l+1)
-          fmc(ig, l+1) = rhobarz(ig, l+1)*zw2(ig, l+1)
-          zw2(ig, l+1) = 0.
-          zqla(ig, l+1) = 0.
-          detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
-          lmax(ig) = l + 1
-          zmax(ig) = zlev(ig, lmax(ig))
-          PRINT *, 'alpha>1', l + 1, lmax(ig)
-        END IF
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! endif test
-      ! endif
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    ! if (fmc(ig,lmax(ig)+1).ne.0.) then
-    fmc(ig, lmax(ig)+1) = 0.
-    entr(ig, lmax(ig)) = 0.
-    detr(ig, lmax(ig)) = fmc(ig, lmax(ig)) + entr(ig, lmax(ig)) + &
-      alim(ig, lmax(ig))
-    ! endif
-  END DO
-  ! test sur le signe de fmc
-  DO ig = 1, ngrid
-    DO l = 1, klev + 1
-      IF (fmc(ig,l)<0.) THEN
-        PRINT *, 'fm1<0!!!', 'ig=', ig, 'l=', l, 'a=', alim(ig, l-1), 'e=', &
-          entr(ig, l-1), 'f=', fmc(ig, l-1), 'd=', detr(ig, l-1), 'f+1=', &
-          fmc(ig, l)
-      END IF
-    END DO
-  END DO
-  ! test de verification
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig)
-      IF ((abs(fmc(ig,l+1)-fmc(ig,l)-alim(ig,l)-entr(ig,l)+ &
-          detr(ig,l)))>1.E-4) THEN
-        ! print*,'pbcm!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
-        ! s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
-        ! s  'f+1=',fmc(ig,l+1)
-      END IF
-      IF (detr(ig,l)<0.) THEN
-        PRINT *, 'detrdemi<0!!!'
-      END IF
-    END DO
-  END DO
-
-  ! RC
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        PRINT *, 'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<=0.) THEN
-      zmix(ig) = 0.9*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-  DO ig = 1, klon
-    zmix0(ig) = zmix(ig)
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  ! ne devrait pas arriver!!!!!
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (detr(ig,l)>(fmc(ig,l)+alim(ig,l))+entr(ig,l)) THEN
-        PRINT *, 'detr2>fmc2!!!', 'ig=', ig, 'l=', l, 'd=', detr(ig, l), &
-          'f=', fmc(ig, l), 'lmax=', lmax(ig)
-        ! detr(ig,l)=fmc(ig,l)+alim(ig,l)+entr(ig,l)
-        ! entr(ig,l)=0.
-        ! fmc(ig,l+1)=0.
-        ! zw2(ig,l+1)=0.
-        ! zqla(ig,l+1)=0.
-        PRINT *, 'pb!fm=0 et f_star>0', l, lmax(ig)
-        ! lmax(ig)=l
-      END IF
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    DO l = lmax(ig) + 1, klev + 1
-      ! fmc(ig,l)=0.
-      ! detr(ig,l)=0.
-      ! entr(ig,l)=0.
-      ! zw2(ig,l)=0.
-      ! zqla(ig,l)=0.
-    END DO
-  END DO
-
-  ! Calcul du detrainement lors du premier passage
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig) .AND. (test(ig)==1)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig) .AND. (test(ig)==1)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          PRINT *, 'pb l_mix*zlev<0'
-        END IF
-        ! CR: test: nouvelle def de lambda
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        IF (zw2(ig,l)>1.E-10) THEN
-          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
-        ELSE
-          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        END IF
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! cal1cul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1. .AND. (test(ig)==1)) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    IF (test(ig)==1) THEN
-      fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-        (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-        fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca( &
-        ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-    END IF
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1. .AND. (test(ig)==1)) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmax(ig)+1.-l)/(lmax(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  PRINT *, 'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (test(ig)==1) THEN
-        fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-        ! CR:test
-        IF (alim(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) &
-            THEN
-          fm(ig, l) = fm(ig, l-1)
-          ! write(1,*)'ajustement fm, l',l
-        END IF
-        ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-        ! RC
-      END IF
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1 .AND. (test(ig)==1)) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay + 1
-    DO ig = 1, ngrid
-      IF (test(ig)==0) THEN
-        fm(ig, l) = fmc(ig, l)
-      END IF
-    END DO
-  END DO
-
-  ! fin du first
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        PRINT *, 'WARN!!! FM>M ig=', ig, ' l=', l, '  FM=', &
-          fm(ig, l+1)*ptimestep, '   M=', masse(ig, l), masse(ig, l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF ((alim(ig,l)+entr(ig,l))*ptimestep>masse(ig,l)) THEN
-        PRINT *, 'WARN!!! E>M ig=', ig, ' l=', l, '  E==', &
-          (entr(ig,l)+alim(ig,l))*ptimestep, '   M=', masse(ig, l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. alim(ig,l)>=0. .OR. .NOT. alim(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  ! CR:test:on ne change pas la def du entr mais la def du fm
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (test(ig)==1) THEN
-        detr(ig, l) = fm(ig, l) + alim(ig, l) - fm(ig, l+1)
-        IF (detr(ig,l)<0.) THEN
-          ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-          fm(ig, l+1) = fm(ig, l) + alim(ig, l)
-          detr(ig, l) = 0.
-          ! write(11,*)'l,ig,entr',l,ig,entr(ig,l)
-          ! print*,'WARNING !!! detrainement negatif ',ig,l
-        END IF
-      END IF
-    END DO
-  END DO
-  ! RC
-
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(alim+entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = alim + entr
-    detr0 = detr
-    alim0 = alim
-    ! zoa=zqta
-    ! entr0=alim
-  END IF
-
-  IF (1==1) THEN
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zh,zdhadj,zha)
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zo,pdoadj,zoa)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zthl, &
-      zdthladj, zta)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, po, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  ! Calcul des moments
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
-  ! zf2=zf/(1.-zf)
-  ! thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
-  ! wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-  ! enddo
-  ! enddo
-
-
-
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
-      pdtadj(ig, l) = zdthladj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-  ! calcul de fraca pour les sorties
-  DO l = 2, klev
-    DO ig = 1, klon
-      IF (zw2(ig,l)>1.E-10) THEN
-        fraca(ig, l) = fm(ig, l)/(rhobarz(ig,l)*zw2(ig,l))
-      ELSE
-        fraca(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-    ! CR calcul du niveau de condensation
-    ! initialisation
-    DO ig = 1, ngrid
-      nivcon(ig) = 0.
-      zcon(ig) = 0.
-    END DO
-    DO k = nlay, 1, -1
-      DO ig = 1, ngrid
-        IF (zqla(ig,k)>1E-10) THEN
-          nivcon(ig) = k
-          zcon(ig) = zlev(ig, k)
-        END IF
-        ! if (zcon(ig).gt.1.e-10) then
-        ! nuage=.true.
-        ! else
-        ! nuage=.false.
-        ! endif
-      END DO
-    END DO
-
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zf = fraca(ig, l)
-        zf2 = zf/(1.-zf)
-        thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
-        wth2(ig, l) = zf2*(zw2(ig,l))**2
-        ! print*,'wth2=',wth2(ig,l)
-        wth3(ig, l) = zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))*zw2(ig, l)* &
-          zw2(ig, l)*zw2(ig, l)
-        q2(ig, l) = zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-        ! test: on calcul q2/po=ratqsc
-        ! if (nuage) then
-        ratqscth(ig, l) = sqrt(q2(ig,l))/(po(ig,l)*1000.)
-        ! else
-        ! ratqscth(ig,l)=0.
-        ! endif
-      END DO
-    END DO
-    ! calcul du ratqscdiff
-    sum = 0.
-    sumdiff = 0.
-    ratqsdiff(:, :) = 0.
-    DO ig = 1, ngrid
-      DO l = 1, lentr(ig)
-        sum = sum + alim_star(ig, l)*zqta(ig, l)*1000.
-      END DO
-    END DO
-    DO ig = 1, ngrid
-      DO l = 1, lentr(ig)
-        zf = fraca(ig, l)
-        zf2 = zf/(1.-zf)
-        sumdiff = sumdiff + alim_star(ig, l)*(zqta(ig,l)*1000.-sum)**2
-        ! ratqsdiff=ratqsdiff+alim_star(ig,l)*
-        ! s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-      END DO
-    END DO
-    DO l = 1, klev
-      DO ig = 1, ngrid
-        ratqsdiff(ig, l) = sqrt(sumdiff)/(po(ig,l)*1000.)
-        ! write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
-      END DO
-    END DO
-
-  END IF
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE thermcell_cld
-
-SUBROUTINE thermcell_eau(ngrid, nlay, ptimestep, pplay, pplev, pphi, pu, pv, &
-    pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
-                                                         ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL zthl(klon, klev), zdthladj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL zl(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zta(klon, klev)
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  REAL zcor, zdelta, zcvm5, qlbef
-  REAL tbef(klon), qsatbef(klon)
-  REAL dqsat_dt, dt, num, denom
-  REAL reps, rlvcp, ddt0
-  REAL ztla(klon, klev), zqla(klon, klev), zqta(klon, klev)
-
-  PARAMETER (ddt0=.01)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell_eau'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-  LOGICAL zsat(klon)
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! Initialisation
-  rlvcp = rlvtt/rcpd
-  reps = rd/rv
-
-  ! -----------------------------------------------------------------------
-  ! AM Calcul de T,q,ql a partir de Tl et qT
-  ! ---------------------------------------------------
-
-  ! Pr Tprec=Tl calcul de qsat
-  ! Si qsat>qT T=Tl, q=qT
-  ! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt)
-  ! On cherche DDT < DDT0
-
-  ! defaut
-  DO ll = 1, nlay
-    DO ig = 1, ngrid
-      zo(ig, ll) = po(ig, ll)
-      zl(ig, ll) = 0.
-      zh(ig, ll) = pt(ig, ll)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zsat(ig) = .FALSE.
-  END DO
-
-
-  DO ll = 1, nlay
-    ! les points insatures sont definitifs
-    DO ig = 1, ngrid
-      tbef(ig) = pt(ig, ll)
-      zdelta = max(0., sign(1.,rtt-tbef(ig)))
-      qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-      qsatbef(ig) = min(0.5, qsatbef(ig))
-      zcor = 1./(1.-retv*qsatbef(ig))
-      qsatbef(ig) = qsatbef(ig)*zcor
-      zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig))>0.00001)
-    END DO
-
-    DO ig = 1, ngrid
-      IF (zsat(ig)) THEN
-        qlbef = max(0., po(ig,ll)-qsatbef(ig))
-        ! si sature: ql est surestime, d'ou la sous-relax
-        dt = 0.5*rlvcp*qlbef
-        ! on pourra enchainer 2 ou 3 calculs sans Do while
-        DO WHILE (dt>ddt0)
-          ! il faut verifier si c,a conserve quand on repasse en insature ...
-          tbef(ig) = tbef(ig) + dt
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          ! on veut le signe de qlbef
-          qlbef = po(ig, ll) - qsatbef(ig)
-          ! dqsat_dT
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-          zcor = 1./(1.-retv*qsatbef(ig))
-          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-          num = -tbef(ig) + pt(ig, ll) + rlvcp*qlbef
-          denom = 1. + rlvcp*dqsat_dt
-          dt = num/denom
-        END DO
-        ! on ecrit de maniere conservative (sat ou non)
-        zl(ig, ll) = max(0., qlbef)
-        ! T = Tl +Lv/Cp ql
-        zh(ig, ll) = pt(ig, ll) + rlvcp*zl(ig, ll)
-        zo(ig, ll) = po(ig, ll) - zl(ig, ll)
-      END IF
-    END DO
-  END DO
-  ! AM fin
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      ! zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      ! zo(ig,l)=po(ig,l)
-      ! ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
-      ! AM attention zh est maintenant le profil de T et plus le profil de
-      ! theta !
-
-      ! T-> Theta
-      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
-      ! AM Theta_v
-      ztv(ig, l) = ztv(ig, l)*(1.+retv*(zo(ig,l))-zl(ig,l))
-      ! AM Thetal
-      zthl(ig, l) = pt(ig, l)/zpspsk(ig, l)
-
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*ztv(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  DO k = nlay - 1, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<ztv(ig,k+2)) THEN
-        lentr(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
-        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! AM:initialisations
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-      ztla(ig, k) = zthl(ig, k)
-      zqla(ig, k) = 0.
-      zqta(ig, k) = po(ig, k)
-      zsat(ig) = .FALSE.
-    END DO
-  END DO
-
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        ! AM
-        ztla(ig, l) = zthl(ig, l)
-        zqta(ig, l) = po(ig, l)
-        zqla(ig, l) = zl(ig, l)
-        ! AM
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-
-        ! AM on melange Tl et qt du thermique
-        ztla(ig, l) = (f_star(ig,l)*ztla(ig,l-1)+entr_star(ig,l)*zthl(ig,l))/ &
-          f_star(ig, l+1)
-        zqta(ig, l) = (f_star(ig,l)*zqta(ig,l-1)+entr_star(ig,l)*po(ig,l))/ &
-          f_star(ig, l+1)
-
-        ! ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)
-        ! s                    *ztv(ig,l))/f_star(ig,l+1)
-
-        ! AM on en deduit thetav et ql du thermique
-        tbef(ig) = ztla(ig, l)*zpspsk(ig, l)
-        zdelta = max(0., sign(1.,rtt-tbef(ig)))
-        qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-        qsatbef(ig) = min(0.5, qsatbef(ig))
-        zcor = 1./(1.-retv*qsatbef(ig))
-        qsatbef(ig) = qsatbef(ig)*zcor
-        zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig))>0.00001)
-      END IF
-    END DO
-    DO ig = 1, ngrid
-      IF (zsat(ig)) THEN
-        qlbef = max(0., zqta(ig,l)-qsatbef(ig))
-        dt = 0.5*rlvcp*qlbef
-        DO WHILE (dt>ddt0)
-          tbef(ig) = tbef(ig) + dt
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          qlbef = zqta(ig, l) - qsatbef(ig)
-
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-          zcor = 1./(1.-retv*qsatbef(ig))
-          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-          num = -tbef(ig) + ztla(ig, l)*zpspsk(ig, l) + rlvcp*qlbef
-          denom = 1. + rlvcp*dqsat_dt
-          dt = num/denom
-        END DO
-        zqla(ig, l) = max(0., zqta(ig,l)-qsatbef(ig))
-      END IF
-      ! on ecrit de maniere conservative (sat ou non)
-      ! T = Tl +Lv/Cp ql
-      ztva(ig, l) = ztla(ig, l)*zpspsk(ig, l) + rlvcp*zqla(ig, l)
-      ztva(ig, l) = ztva(ig, l)/zpspsk(ig, l)
-      ztva(ig, l) = ztva(ig, l)*(1.+retv*(zqta(ig,l)-zqla(ig,l))-zqla(ig,l))
-
-    END DO
-    DO ig = 1, ngrid
-      IF (zw2(ig,l)>=1.E-10 .AND. f_star(ig,l)+entr_star(ig,l)>1.E-10) THEN
-        ! mise a jour de la vitesse ascendante (l'air entraine de la couche
-        ! consideree commence avec une vitesse nulle).
-
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 500.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-
-  ! Fermeture,determination de f
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(zmax(ig)*r_aspect*entr_star2(ig))*entr_star_tot(ig)
-      ! test
-      IF (first) THEN
-        f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
-      END IF
-    END IF
-    f0(ig) = f(ig)
-    first = .TRUE.
-  END DO
-
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig))) &
-        **2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-        lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-        (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-        (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))*((zlev( &
-        ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-    ELSE
-      zmix(ig) = 0.
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zh,zdhadj,zha)
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zo,pdoadj,zoa)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zthl, &
-      zdthladj, zta)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, po, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
-      pdtadj(ig, l) = zdthladj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE thermcell_eau
-
-SUBROUTINE thermcell(ngrid, nlay, ptimestep, pplay, pplev, pphi, pu, pv, pt, &
-    po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
-                                                     ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
-        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couches 1->5 stables
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-
-  PRINT *, 'fin calcul entr_star'
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
-          f_star(ig, l+1)
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        ! test
-        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
-          PRINT *, 'pb linter'
-        END IF
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        IF (zw2(ig,l+1)<0.) THEN
-          PRINT *, 'pb1 zw2<0'
-        END IF
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  PRINT *, 'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couches 1->5 stables
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          PRINT *, 'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-
-  PRINT *, 'avant fermeture'
-  ! Fermeture,determination de f
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))* &
-        entr_star_tot(ig)
-      ! test
-      ! if (first) then
-      ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
-      ! s             *wmax(ig))
-      ! endif
-    END IF
-    ! f0(ig)=f(ig)
-    ! first=.true.
-  END DO
-  PRINT *, 'apres fermeture'
-
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          PRINT *, 'pb l_mix*zlev<0'
-        END IF
-        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        PRINT *, 'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<0.) THEN
-      zmix(ig) = 0.99*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  PRINT *, 'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-      IF (detr(ig,l)<0.) THEN
-        entr(ig, l) = entr(ig, l) - detr(ig, l)
-        detr(ig, l) = 0.
-        ! print*,'WARNING !!! detrainement negatif ',ig,l
-      END IF
-    END DO
-  END DO
-  ! RC
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-
-    ! deja fait
-    ! do l=1,nlay
-    ! do ig=1,ngrid
-    ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
-    ! if (detr(ig,l).lt.0.) then
-    ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-    ! detr(ig,l)=0.
-    ! print*,'WARNING !!! detrainement negatif ',ig,l
-    ! endif
-    ! enddo
-    ! enddo
-
-    ! print*,'15 OK convect8'
-
-
-    ! #define und
-    GO TO 123
-#ifdef und
-    CALL writeg1d(1, nlay, wd, 'wd      ', 'wd      ')
-    CALL writeg1d(1, nlay, zwa, 'wa      ', 'wa      ')
-    CALL writeg1d(1, nlay, fracd, 'fracd      ', 'fracd      ')
-    CALL writeg1d(1, nlay, fraca, 'fraca      ', 'fraca      ')
-    CALL writeg1d(1, nlay, wa_moy, 'wam         ', 'wam         ')
-    CALL writeg1d(1, nlay, zla, 'la      ', 'la      ')
-    CALL writeg1d(1, nlay, zld, 'ld      ', 'ld      ')
-    CALL writeg1d(1, nlay, pt, 'pt      ', 'pt      ')
-    CALL writeg1d(1, nlay, zh, 'zh      ', 'zh      ')
-    CALL writeg1d(1, nlay, zha, 'zha      ', 'zha      ')
-    CALL writeg1d(1, nlay, zu, 'zu      ', 'zu      ')
-    CALL writeg1d(1, nlay, zv, 'zv      ', 'zv      ')
-    CALL writeg1d(1, nlay, zo, 'zo      ', 'zo      ')
-    CALL writeg1d(1, nlay, wh, 'wh      ', 'wh      ')
-    CALL writeg1d(1, nlay, wu, 'wu      ', 'wu      ')
-    CALL writeg1d(1, nlay, wv, 'wv      ', 'wv      ')
-    CALL writeg1d(1, nlay, wo, 'w15uo     ', 'wXo     ')
-    CALL writeg1d(1, nlay, zdhadj, 'zdhadj      ', 'zdhadj      ')
-    CALL writeg1d(1, nlay, pduadj, 'pduadj      ', 'pduadj      ')
-    CALL writeg1d(1, nlay, pdvadj, 'pdvadj      ', 'pdvadj      ')
-    CALL writeg1d(1, nlay, pdoadj, 'pdoadj      ', 'pdoadj      ')
-    CALL writeg1d(1, nlay, entr, 'entr        ', 'entr        ')
-    CALL writeg1d(1, nlay, detr, 'detr        ', 'detr        ')
-    CALL writeg1d(1, nlay, fm, 'fm          ', 'fm          ')
-
-    CALL writeg1d(1, nlay, pdtadj, 'pdtadj    ', 'pdtadj    ')
-    CALL writeg1d(1, nlay, pplay, 'pplay     ', 'pplay     ')
-    CALL writeg1d(1, nlay, pplev, 'pplev     ', 'pplev     ')
-
-    ! recalcul des flux en diagnostique...
-    ! print*,'PAS DE TEMPS ',ptimestep
-    CALL dt2f(pplev, pplay, pt, pdtadj, wh)
-    CALL writeg1d(1, nlay, wh, 'wh2     ', 'wh2     ')
-#endif
-123 CONTINUE
-
-  END IF
-
-  ! if(wa_moy(1,4).gt.1.e-10) stop
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE thermcell
-
-SUBROUTINE dqthermcell(ngrid, nlay, ptimestep, fm, entr, masse, q, dq, qa)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL entr(ngrid, nlay)
-  REAL q(ngrid, nlay)
-  REAL dq(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev), wqd(klon, klev+1)
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-      ! test
-      IF (detr(ig,k)<0.) THEN
-        entr(ig, k) = entr(ig, k) - detr(ig, k)
-        detr(ig, k) = 0.
-        ! print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
-        ! s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
-      END IF
-      IF (fm(ig,k+1)<0.) THEN
-        ! print*,'fm2<0!!!'
-      END IF
-      IF (entr(ig,k)<0.) THEN
-        ! print*,'entr2<0!!!'
-      END IF
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    qa(ig, 1) = q(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        qa(ig, k) = (fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))/ &
-          (fm(ig,k+1)+detr(ig,k))
-      ELSE
-        qa(ig, k) = q(ig, k)
-      END IF
-      IF (qa(ig,k)<0.) THEN
-        ! print*,'qa<0!!!'
-      END IF
-      IF (q(ig,k)<0.) THEN
-        ! print*,'q<0!!!'
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      ! wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-      wqd(ig, k) = fm(ig, k)*q(ig, k)
-      IF (wqd(ig,k)<0.) THEN
-        ! print*,'wqd<0!!!'
-      END IF
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wqd(ig, 1) = 0.
-    wqd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      dq(ig, k) = (detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)-wqd(ig,k)+wqd(ig,k+ &
-        1))/masse(ig, k)
-      ! if (dq(ig,k).lt.0.) then
-      ! print*,'dq<0!!!'
-      ! endif
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dqthermcell
-SUBROUTINE dvthermcell(ngrid, nlay, ptimestep, fm, entr, masse, fraca, larga, &
-    u, v, du, dv, ua, va)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL fraca(ngrid, nlay+1)
-  REAL larga(ngrid)
-  REAL entr(ngrid, nlay)
-  REAL u(ngrid, nlay)
-  REAL ua(ngrid, nlay)
-  REAL du(ngrid, nlay)
-  REAL v(ngrid, nlay)
-  REAL va(ngrid, nlay)
-  REAL dv(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev)
-  REAL wvd(klon, klev+1), wud(klon, klev+1)
-  REAL gamma0, gamma(klon, klev+1)
-  REAL dua, dva
-  INTEGER iter
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    ua(ig, 1) = u(ig, 1)
-    va(ig, 1) = v(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        ! On itère sur la valeur du coeff de freinage.
-        ! gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
-        gamma0 = masse(ig, k)*sqrt(0.5*(fraca(ig,k+1)+fraca(ig, &
-          k)))*0.5/larga(ig)
-        ! gamma0=0.
-        ! la première fois on multiplie le coefficient de freinage
-        ! par le module du vent dans la couche en dessous.
-        dua = ua(ig, k-1) - u(ig, k-1)
-        dva = va(ig, k-1) - v(ig, k-1)
-        DO iter = 1, 5
-          gamma(ig, k) = gamma0*sqrt(dua**2+dva**2)
-          ua(ig, k) = (fm(ig,k)*ua(ig,k-1)+(entr(ig,k)+gamma(ig, &
-            k))*u(ig,k))/(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
-          va(ig, k) = (fm(ig,k)*va(ig,k-1)+(entr(ig,k)+gamma(ig, &
-            k))*v(ig,k))/(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
-          ! print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
-          dua = ua(ig, k) - u(ig, k)
-          dva = va(ig, k) - v(ig, k)
-        END DO
-      ELSE
-        ua(ig, k) = u(ig, k)
-        va(ig, k) = v(ig, k)
-        gamma(ig, k) = 0.
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      wud(ig, k) = fm(ig, k)*u(ig, k)
-      wvd(ig, k) = fm(ig, k)*v(ig, k)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wud(ig, 1) = 0.
-    wud(ig, nlay+1) = 0.
-    wvd(ig, 1) = 0.
-    wvd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      du(ig, k) = ((detr(ig,k)+gamma(ig,k))*ua(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*u(ig,k)-wud(ig,k)+wud(ig,k+1))/masse(ig, k)
-      dv(ig, k) = ((detr(ig,k)+gamma(ig,k))*va(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*v(ig,k)-wvd(ig,k)+wvd(ig,k+1))/masse(ig, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dvthermcell
-SUBROUTINE dqthermcell2(ngrid, nlay, ptimestep, fm, entr, masse, frac, q, dq, &
-    qa)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL entr(ngrid, nlay), frac(ngrid, nlay)
-  REAL q(ngrid, nlay)
-  REAL dq(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev), wqd(klon, klev+1)
-  REAL qe(klon, klev), zf, zf2
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    qa(ig, 1) = q(ig, 1)
-    qe(ig, 1) = q(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        zf = 0.5*(frac(ig,k)+frac(ig,k+1))
-        zf2 = 1./(1.-zf)
-        qa(ig, k) = (fm(ig,k)*qa(ig,k-1)+zf2*entr(ig,k)*q(ig,k))/ &
-          (fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2)
-        qe(ig, k) = (q(ig,k)-zf*qa(ig,k))*zf2
-      ELSE
-        qa(ig, k) = q(ig, k)
-        qe(ig, k) = q(ig, k)
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      ! wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-      wqd(ig, k) = fm(ig, k)*qe(ig, k)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wqd(ig, 1) = 0.
-    wqd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      dq(ig, k) = (detr(ig,k)*qa(ig,k)-entr(ig,k)*qe(ig,k)-wqd(ig,k)+wqd(ig,k &
-        +1))/masse(ig, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dqthermcell2
-SUBROUTINE dvthermcell2(ngrid, nlay, ptimestep, fm, entr, masse, fraca, &
-    larga, u, v, du, dv, ua, va)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL fraca(ngrid, nlay+1)
-  REAL larga(ngrid)
-  REAL entr(ngrid, nlay)
-  REAL u(ngrid, nlay)
-  REAL ua(ngrid, nlay)
-  REAL du(ngrid, nlay)
-  REAL v(ngrid, nlay)
-  REAL va(ngrid, nlay)
-  REAL dv(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev), zf, zf2
-  REAL wvd(klon, klev+1), wud(klon, klev+1)
-  REAL gamma0, gamma(klon, klev+1)
-  REAL ue(klon, klev), ve(klon, klev)
-  REAL dua, dva
-  INTEGER iter
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    ua(ig, 1) = u(ig, 1)
-    va(ig, 1) = v(ig, 1)
-    ue(ig, 1) = u(ig, 1)
-    ve(ig, 1) = v(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        ! On itère sur la valeur du coeff de freinage.
-        ! gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
-        gamma0 = masse(ig, k)*sqrt(0.5*(fraca(ig,k+1)+fraca(ig, &
-          k)))*0.5/larga(ig)*1.
-        ! s         *0.5
-        ! gamma0=0.
-        zf = 0.5*(fraca(ig,k)+fraca(ig,k+1))
-        zf = 0.
-        zf2 = 1./(1.-zf)
-        ! la première fois on multiplie le coefficient de freinage
-        ! par le module du vent dans la couche en dessous.
-        dua = ua(ig, k-1) - u(ig, k-1)
-        dva = va(ig, k-1) - v(ig, k-1)
-        DO iter = 1, 5
-          ! On choisit une relaxation lineaire.
-          gamma(ig, k) = gamma0
-          ! On choisit une relaxation quadratique.
-          gamma(ig, k) = gamma0*sqrt(dua**2+dva**2)
-          ua(ig, k) = (fm(ig,k)*ua(ig,k-1)+(zf2*entr(ig,k)+gamma(ig, &
-            k))*u(ig,k))/(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2+gamma(ig,k) &
-            )
-          va(ig, k) = (fm(ig,k)*va(ig,k-1)+(zf2*entr(ig,k)+gamma(ig, &
-            k))*v(ig,k))/(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2+gamma(ig,k) &
-            )
-          ! print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
-          dua = ua(ig, k) - u(ig, k)
-          dva = va(ig, k) - v(ig, k)
-          ue(ig, k) = (u(ig,k)-zf*ua(ig,k))*zf2
-          ve(ig, k) = (v(ig,k)-zf*va(ig,k))*zf2
-        END DO
-      ELSE
-        ua(ig, k) = u(ig, k)
-        va(ig, k) = v(ig, k)
-        ue(ig, k) = u(ig, k)
-        ve(ig, k) = v(ig, k)
-        gamma(ig, k) = 0.
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      wud(ig, k) = fm(ig, k)*ue(ig, k)
-      wvd(ig, k) = fm(ig, k)*ve(ig, k)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wud(ig, 1) = 0.
-    wud(ig, nlay+1) = 0.
-    wvd(ig, 1) = 0.
-    wvd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      du(ig, k) = ((detr(ig,k)+gamma(ig,k))*ua(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*ue(ig,k)-wud(ig,k)+wud(ig,k+1))/masse(ig, k)
-      dv(ig, k) = ((detr(ig,k)+gamma(ig,k))*va(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*ve(ig,k)-wvd(ig,k)+wvd(ig,k+1))/masse(ig, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dvthermcell2
-SUBROUTINE thermcell_sec(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, &
-    pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
-                                                                 ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell_sec'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
-        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))** & ! s
-                                                       ! (zlev(ig,l+1)-zlev(ig,l))
-          sqrt(zlev(ig,l+1))
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-
-  ! print*,'fin calcul entr_star'
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
-          f_star(ig, l+1)
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        ! test
-        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
-          ! print*,'pb linter'
-        END IF
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        IF (zw2(ig,l+1)<0.) THEN
-          ! print*,'pb1 zw2<0'
-        END IF
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  ! print*,'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          ! print*,'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-
-  ! print*,'avant fermeture'
-  ! Fermeture,determination de f
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))* &
-        entr_star_tot(ig)
-      ! test
-      ! if (first) then
-      ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
-      ! s             *wmax(ig))
-      ! endif
-    END IF
-    ! f0(ig)=f(ig)
-    ! first=.true.
-  END DO
-  ! print*,'apres fermeture'
-
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! CR:test pour entrainer moins que la masse
-  DO ig = 1, ngrid
-    DO l = 1, lentr(ig)
-      IF ((entr(ig,l)*ptimestep)>(0.9*masse(ig,l))) THEN
-        entr(ig, l+1) = entr(ig, l+1) + entr(ig, l) - &
-          0.9*masse(ig, l)/ptimestep
-        entr(ig, l) = 0.9*masse(ig, l)/ptimestep
-      END IF
-    END DO
-  END DO
-  ! CR: fin test
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          ! print*,'pb l_mix*zlev<0'
-        END IF
-        ! CR: test: nouvelle def de lambda
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        IF (zw2(ig,l)>1.E-10) THEN
-          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
-        ELSE
-          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        END IF
-        ! RC
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        ! print*,'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<0.) THEN
-      zmix(ig) = 0.99*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! print*,'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-      IF (detr(ig,l)<0.) THEN
-        entr(ig, l) = entr(ig, l) - detr(ig, l)
-        detr(ig, l) = 0.
-        ! print*,'WARNING !!! detrainement negatif ',ig,l
-      END IF
-    END DO
-  END DO
-  ! RC
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE thermcell_sec
-
+link ../phylmd/thermcell_old.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_plume.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_plume.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_plume.F90	(revision 3940)
@@ -1,495 +1,1 @@
-!
-! $Id: thermcell_plume.F90 3074 2017-11-15 13:31:44Z fhourdin $
-!
-      SUBROUTINE thermcell_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-     &           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-    &           ,lev_out,lunout1,igout)
-!     &           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
-!--------------------------------------------------------------------------
-! Auhtors : Catherine Rio, Frédéric Hourdin, Arnaud Jam
-!
-!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
-!   This versions starts from a cleaning of thermcell_plume_6A (2019/01/20)
-!   thermcell_plume_6A is activate for flag_thermas_ed < 10
-!   thermcell_plume_5B for flag_thermas_ed < 20
-!   thermcell_plume for flag_thermals_ed>= 20
-!   Various options are controled by the flag_thermals_ed parameter
-!   = 20 : equivalent to thermcell_plume_6A with flag_thermals_ed=8
-!   = 21 : the Jam strato-cumulus modif is not activated in detrainment
-!   = 29 : an other way to compute the modified buoyancy (to be tested)
-!--------------------------------------------------------------------------
-USE IOIPSL, ONLY : getin
-USE ioipsl_getin_p_mod, ONLY : getin_p
-
-       USE print_control_mod, ONLY: prt_level
-       IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-
-      INTEGER itap
-      INTEGER lunout1,igout
-      INTEGER ngrid,klev
-      REAL ptimestep
-      REAL ztv(ngrid,klev)
-      REAL zthl(ngrid,klev)
-      REAL po(ngrid,klev)
-      REAL zl(ngrid,klev)
-      REAL rhobarz(ngrid,klev)
-      REAL zlev(ngrid,klev+1)
-      REAL pplev(ngrid,klev+1)
-      REAL pphi(ngrid,klev)
-      REAL zpspsk(ngrid,klev)
-      REAL alim_star(ngrid,klev)
-      REAL f0(ngrid)
-      INTEGER lalim(ngrid)
-      integer lev_out                           ! niveau pour les print
-      integer nbpb
-    
-      real alim_star_tot(ngrid)
-
-      REAL ztva(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zqla(ngrid,klev)
-      REAL zqta(ngrid,klev)
-      REAL zha(ngrid,klev)
-
-      REAL detr_star(ngrid,klev)
-      REAL coefc
-      REAL entr_star(ngrid,klev)
-      REAL detr(ngrid,klev)
-      REAL entr(ngrid,klev)
-
-      REAL csc(ngrid,klev)
-
-      REAL zw2(ngrid,klev+1)
-      REAL w_est(ngrid,klev+1)
-      REAL f_star(ngrid,klev+1)
-      REAL wa_moy(ngrid,klev+1)
-
-      REAL ztva_est(ngrid,klev)
-      REAL ztv_est(ngrid,klev)
-      REAL zqla_est(ngrid,klev)
-      REAL zqsatth(ngrid,klev)
-      REAL zta_est(ngrid,klev)
-      REAL ztemp(ngrid),zqsat(ngrid)
-      REAL zdw2,zdw2bis
-      REAL zw2modif
-      REAL zw2fact,zw2factbis
-      REAL zeps(ngrid,klev)
-
-      REAL linter(ngrid)
-      INTEGER lmix(ngrid)
-      INTEGER lmix_bis(ngrid)
-      REAL    wmaxa(ngrid)
-
-      INTEGER ig,l,k,lt,it,lm
-
-      real zdz,zbuoy(ngrid,klev),zalpha,gamma(ngrid,klev),zdqt(ngrid,klev),zw2m
-      real zbuoyjam(ngrid,klev),zdqtjam(ngrid,klev)
-      real zdz2,zdz3,lmel,entrbis,zdzbis
-      real d_temp(ngrid)
-      real ztv1,ztv2,factinv,zinv,zlmel
-      real zlmelup,zlmeldwn,zlt,zltdwn,zltup
-      real atv1,atv2,btv1,btv2
-      real ztv_est1,ztv_est2
-      real zcor,zdelta,zcvm5,qlbef
-      real zbetalpha, coefzlmel
-      real eps
-      REAL REPS,RLvCp,DDT0
-      PARAMETER (DDT0=.01)
-      logical Zsat
-      LOGICAL active(ngrid),activetmp(ngrid)
-      REAL fact_gamma,fact_gamma2,fact_epsilon2
-
-      REAL, SAVE :: fact_epsilon=0.002
-      REAL, SAVE :: betalpha=0.9
-      REAL, SAVE :: afact=2./3.
-      REAL, SAVE :: fact_shell=1.
-      REAL,SAVE :: detr_min=1.e-5
-      REAL,SAVE :: entr_min=1.e-5
-      REAL,SAVE :: detr_q_coef=0.012
-      REAL,SAVE :: detr_q_power=0.5
-      REAL,SAVE :: mix0=0.
-      INTEGER,SAVE :: thermals_flag_alim=0
-
-!$OMP THREADPRIVATE(fact_epsilon, betalpha, afact, fact_shell)
-!$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power)
-!$OMP THREADPRIVATE( mix0, thermals_flag_alim)
-
-      LOGICAL, SAVE :: first=.true.
-  !$OMP THREADPRIVATE(first)
-
-
-      REAL c2(ngrid,klev)
-
-      if (ngrid==1) print*,'THERMCELL PLUME MODIFIE 2014/07/11'
-      Zsat=.false.
-! Initialisation
-
-      RLvCp = RLVTT/RCPD
-      IF (first) THEN
-
-     CALL getin_p('thermals_fact_epsilon',fact_epsilon)
-     CALL getin_p('thermals_betalpha',betalpha)
-     CALL getin_p('thermals_afact',afact)
-     CALL getin_p('thermals_fact_shell',fact_shell)
-     CALL getin_p('thermals_detr_min',detr_min)
-     CALL getin_p('thermals_entr_min',entr_min)
-     CALL getin_p('thermals_detr_q_coef',detr_q_coef)
-     CALL getin_p('thermals_detr_q_power',detr_q_power)
-     CALL getin_p('thermals_mix0',mix0)
-     CALL getin_p('thermals_flag_alim',thermals_flag_alim)
-
-
-      first=.false.
-      ENDIF
-
-      zbetalpha=betalpha/(1.+betalpha)
-
-
-! Initialisations des variables r?elles
-if (1==1) then
-      ztva(:,:)=ztv(:,:)
-      ztva_est(:,:)=ztva(:,:)
-      ztv_est(:,:)=ztv(:,:)
-      ztla(:,:)=zthl(:,:)
-      zqta(:,:)=po(:,:)
-      zqla(:,:)=0.
-      zha(:,:) = ztva(:,:)
-else
-      ztva(:,:)=0.
-      ztv_est(:,:)=0.
-      ztva_est(:,:)=0.
-      ztla(:,:)=0.
-      zqta(:,:)=0.
-      zha(:,:) =0.
-endif
-
-      zqla_est(:,:)=0.
-      zqsatth(:,:)=0.
-      zqla(:,:)=0.
-      detr_star(:,:)=0.
-      entr_star(:,:)=0.
-      alim_star(:,:)=0.
-      alim_star_tot(:)=0.
-      csc(:,:)=0.
-      detr(:,:)=0.
-      entr(:,:)=0.
-      zw2(:,:)=0.
-      zbuoy(:,:)=0.
-      zbuoyjam(:,:)=0.
-      gamma(:,:)=0.
-      zeps(:,:)=0.
-      w_est(:,:)=0.
-      f_star(:,:)=0.
-      wa_moy(:,:)=0.
-      linter(:)=1.
-!     linter(:)=1.
-! Initialisation des variables entieres
-      lmix(:)=1
-      lmix_bis(:)=2
-      wmaxa(:)=0.
-
-
-!-------------------------------------------------------------------------
-! On ne considere comme actif que les colonnes dont les deux premieres
-! couches sont instables.
-!-------------------------------------------------------------------------
-
-      active(:)=ztv(:,1)>ztv(:,2)
-      d_temp(:)=0. ! Pour activer un contraste de temperature a la base
-                   ! du panache
-!  Cet appel pourrait être fait avant thermcell_plume dans thermcell_main
-      CALL thermcell_alim(thermals_flag_alim,ngrid,klev,ztv,d_temp,zlev,alim_star,lalim)
-
-!------------------------------------------------------------------------------
-! Calcul dans la premiere couche
-! On decide dans cette version que le thermique n'est actif que si la premiere
-! couche est instable.
-! Pourrait etre change si on veut que le thermiques puisse se d??clencher
-! dans une couche l>1
-!------------------------------------------------------------------------------
-do ig=1,ngrid
-! Le panache va prendre au debut les caracteristiques de l'air contenu
-! dans cette couche.
-    if (active(ig)) then
-    ztla(ig,1)=zthl(ig,1) 
-    zqta(ig,1)=po(ig,1)
-    zqla(ig,1)=zl(ig,1)
-!cr: attention, prise en compte de f*(1)=1
-    f_star(ig,2)=alim_star(ig,1)
-    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-&                     *(zlev(ig,2)-zlev(ig,1))  &
-&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
-    w_est(ig,2)=zw2(ig,2)
-    endif
-enddo
-!
-
-!==============================================================================
-!boucle de calcul de la vitesse verticale dans le thermique
-!==============================================================================
-do l=2,klev-1
-!==============================================================================
-
-
-! On decide si le thermique est encore actif ou non
-! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-    do ig=1,ngrid
-       active(ig)=active(ig) &
-&                 .and. zw2(ig,l)>1.e-10 &
-&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
-    enddo
-
-
-
-!---------------------------------------------------------------------------
-! calcul des proprietes thermodynamiques et de la vitesse de la couche l
-! sans tenir compte du detrainement et de l'entrainement dans cette
-! couche
-! C'est a dire qu'on suppose 
-! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
-! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
-! avant) a l'alimentation pour avoir un calcul plus propre
-!---------------------------------------------------------------------------
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
-   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
-    do ig=1,ngrid 
-!       print*,'active',active(ig),ig,l
-        if(active(ig)) then 
-        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
-        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
-     &      -zqla_est(ig,l))-zqla_est(ig,l))
- 
-
-!Modif AJAM
-
-        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 
-        zdz=zlev(ig,l+1)-zlev(ig,l)         
-        lmel=fact_thermals_ed_dz*zlev(ig,l)
-!        lmel=0.09*zlev(ig,l)
-        zlmel=zlev(ig,l)+lmel
-        zlmelup=zlmel+(zdz/2)
-        zlmeldwn=zlmel-(zdz/2)
-
-        lt=l+1
-        zlt=zlev(ig,lt)
-        zdz3=zlev(ig,lt+1)-zlt
-        zltdwn=zlt-zdz3/2
-        zltup=zlt+zdz3/2
-         
-!=========================================================================
-! 3. Calcul de la flotabilite modifie par melange avec l'air au dessus
-!=========================================================================
-
-!--------------------------------------------------
-        lt=l+1
-        zlt=zlev(ig,lt)
-        zdz2=zlev(ig,lt)-zlev(ig,l)
-
-        do while (lmel.gt.zdz2)
-           lt=lt+1
-           zlt=zlev(ig,lt)
-           zdz2=zlt-zlev(ig,l)
-        enddo
-        zdz3=zlev(ig,lt+1)-zlt
-        zltdwn=zlev(ig,lt)-zdz3/2
-        zlmelup=zlmel+(zdz/2)
-        coefzlmel=Min(1.,(zlmelup-zltdwn)/zdz)
-        zbuoyjam(ig,l)=1.*RG*(coefzlmel*(ztva_est(ig,l)- & 
-    &   ztv(ig,lt))/ztv(ig,lt)+(1.-coefzlmel)*(ztva_est(ig,l)- &
-    &   ztv(ig,lt-1))/ztv(ig,lt-1))+0.*zbuoy(ig,l)
-
-!------------------------------------------------
-!AJAM:nouveau calcul de w?  
-!------------------------------------------------
-        zdz=zlev(ig,l+1)-zlev(ig,l)
-        zdzbis=zlev(ig,l)-zlev(ig,l-1)
-        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-        zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-        zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-        zdw2=afact*zbuoy(ig,l)/fact_epsilon
-        zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
-        lm=Max(1,l-2)
-        w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
-       endif
-    enddo
-
-
-!-------------------------------------------------
-!calcul des taux d'entrainement et de detrainement
-!-------------------------------------------------
-
-     do ig=1,ngrid
-        if (active(ig)) then
-
-!          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
-          zw2m=w_est(ig,l+1)
-          zdz=zlev(ig,l+1)-zlev(ig,l)
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
-
-!=========================================================================
-! 4. Calcul de l'entrainement et du detrainement
-!=========================================================================
-
-          detr_star(ig,l)=f_star(ig,l)*zdz             &
-    &     *( mix0 * 0.1 / (zalpha+0.001)               &
-    &     + MAX(detr_min, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m   &
-    &     + detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
-
-          if ( iflag_thermals_ed == 20 ) then
-             entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-    &          mix0 * 0.1 / (zalpha+0.001)               &
-    &        + zbetalpha*MAX(entr_min,                   &
-    &        afact*zbuoyjam(ig,l)/zw2m - fact_epsilon))
-          else
-             entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-    &          mix0 * 0.1 / (zalpha+0.001)               &
-    &        + zbetalpha*MAX(entr_min,                   &
-    &        afact*zbuoy(ig,l)/zw2m - fact_epsilon))
-          endif
-          
-! En dessous de lalim, on prend le max de alim_star et entr_star pour
-! alim_star et 0 sinon
-        if (l.lt.lalim(ig)) then
-          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
-          entr_star(ig,l)=0.
-        endif
-        f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
-     &              -detr_star(ig,l)
-
-      endif
-   enddo
-
-
-!============================================================================
-! 5. calcul de la vitesse verticale en melangeant Tl et qt du thermique
-!===========================================================================
-
-   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
-   do ig=1,ngrid
-       if (activetmp(ig)) then 
-           Zsat=.false.
-           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-
-        endif
-    enddo
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l)
-   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
-   do ig=1,ngrid
-      if (activetmp(ig)) then
-! on ecrit de maniere conservative (sat ou non)
-!          T = Tl +Lv/Cp ql
-           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
-           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-           zha(ig,l) = ztva(ig,l)
-           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
-     &              -zqla(ig,l))-zqla(ig,l))
-           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
-           zdz=zlev(ig,l+1)-zlev(ig,l)
-           zdzbis=zlev(ig,l)-zlev(ig,l-1)
-           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
-           zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-           zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-           zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
-           zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
-           zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2)
-      endif
-   enddo
-
-   if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
-!
-!===========================================================================
-! 6. initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-!===========================================================================
-
-   nbpb=0
-   do ig=1,ngrid
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_plume'
-                nbpb=nbpb+1
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-            endif
-
-        if (zw2(ig,l+1).lt.0.) then 
-           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-           zw2(ig,l+1)=0.
-!+CR:04/05/12:correction calcul linter pour calcul de zmax continu
-        elseif (f_star(ig,l+1).lt.0.) then
-           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-           zw2(ig,l+1)=0.
-!fin CR:04/05/12
-        endif
-
-           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
-
-        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-!on rajoute le calcul de lmix_bis
-            if (zqla(ig,l).lt.1.e-10) then
-               lmix_bis(ig)=l+1
-            endif
-            lmix(ig)=l+1
-            wmaxa(ig)=wa_moy(ig,l+1)
-        endif
-   enddo
-
-   if (nbpb>0) then
-   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
-   endif
-
-!=========================================================================
-! FIN DE LA BOUCLE VERTICALE
-      enddo
-!=========================================================================
-
-!on recalcule alim_star_tot
-       do ig=1,ngrid
-          alim_star_tot(ig)=0.
-       enddo
-       do ig=1,ngrid
-          do l=1,lalim(ig)-1
-          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-          enddo
-       enddo
-       
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
-
-#undef wrgrads_thermcell
-#ifdef wrgrads_thermcell
-         call wrgradsfi(1,klev,entr_star(igout,1:klev),'esta      ','esta      ')
-         call wrgradsfi(1,klev,detr_star(igout,1:klev),'dsta      ','dsta      ')
-         call wrgradsfi(1,klev,zbuoy(igout,1:klev),'buoy      ','buoy      ')
-         call wrgradsfi(1,klev,zdqt(igout,1:klev),'dqt      ','dqt      ')
-         call wrgradsfi(1,klev,w_est(igout,1:klev),'w_est     ','w_est     ')
-         call wrgradsfi(1,klev,w_est(igout,2:klev+1),'w_es2     ','w_es2     ')
-         call wrgradsfi(1,klev,zw2(igout,1:klev),'zw2A      ','zw2A      ')
-#endif
-
-
-     return 
-     end
+link ../phylmd/thermcell_plume.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_plume_6A.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_plume_6A.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_plume_6A.F90	(revision 3940)
@@ -1,1186 +1,1 @@
-!
-! $Id: thermcell_plume_6A.F90 3451 2019-01-27 11:07:30Z fhourdin $
-!
-      SUBROUTINE thermcell_plume_6A(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-     &           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-    &           ,lev_out,lunout1,igout)
-!     &           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
-!--------------------------------------------------------------------------
-!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
-!--------------------------------------------------------------------------
-USE IOIPSL, ONLY : getin
-USE ioipsl_getin_p_mod, ONLY : getin_p
-
-       USE print_control_mod, ONLY: prt_level
-       IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-
-      INTEGER itap
-      INTEGER lunout1,igout
-      INTEGER ngrid,klev
-      REAL ptimestep
-      REAL ztv(ngrid,klev)
-      REAL zthl(ngrid,klev)
-      REAL po(ngrid,klev)
-      REAL zl(ngrid,klev)
-      REAL rhobarz(ngrid,klev)
-      REAL zlev(ngrid,klev+1)
-      REAL pplev(ngrid,klev+1)
-      REAL pphi(ngrid,klev)
-      REAL zpspsk(ngrid,klev)
-      REAL alim_star(ngrid,klev)
-      REAL f0(ngrid)
-      INTEGER lalim(ngrid)
-      integer lev_out                           ! niveau pour les print
-      integer nbpb
-    
-      real alim_star_tot(ngrid)
-
-      REAL ztva(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zqla(ngrid,klev)
-      REAL zqta(ngrid,klev)
-      REAL zha(ngrid,klev)
-
-      REAL detr_star(ngrid,klev)
-      REAL coefc
-      REAL entr_star(ngrid,klev)
-      REAL detr(ngrid,klev)
-      REAL entr(ngrid,klev)
-
-      REAL csc(ngrid,klev)
-
-      REAL zw2(ngrid,klev+1)
-      REAL w_est(ngrid,klev+1)
-      REAL f_star(ngrid,klev+1)
-      REAL wa_moy(ngrid,klev+1)
-
-      REAL ztva_est(ngrid,klev)
-      REAL ztv_est(ngrid,klev)
-      REAL zqla_est(ngrid,klev)
-      REAL zqsatth(ngrid,klev)
-      REAL zta_est(ngrid,klev)
-      REAL ztemp(ngrid),zqsat(ngrid)
-      REAL zdw2,zdw2bis
-      REAL zw2modif
-      REAL zw2fact,zw2factbis
-      REAL zeps(ngrid,klev)
-
-      REAL linter(ngrid)
-      INTEGER lmix(ngrid)
-      INTEGER lmix_bis(ngrid)
-      REAL    wmaxa(ngrid)
-
-      INTEGER ig,l,k,lt,it,lm
-
-      real zdz,zbuoy(ngrid,klev),zalpha,gamma(ngrid,klev),zdqt(ngrid,klev),zw2m
-      real zbuoyjam(ngrid,klev),zdqtjam(ngrid,klev)
-      real zbuoybis,zdz2,zdz3,lmel,entrbis,zdzbis
-      real d_temp(ngrid)
-      real ztv1,ztv2,factinv,zinv,zlmel
-      real zlmelup,zlmeldwn,zlt,zltdwn,zltup
-      real atv1,atv2,btv1,btv2
-      real ztv_est1,ztv_est2
-      real zcor,zdelta,zcvm5,qlbef
-      real zbetalpha, coefzlmel
-      real eps
-      REAL REPS,RLvCp,DDT0
-      PARAMETER (DDT0=.01)
-      logical Zsat
-      LOGICAL active(ngrid),activetmp(ngrid)
-      REAL fact_gamma,fact_gamma2,fact_epsilon2
-
-      REAL, SAVE :: fact_epsilon=0.002
-      REAL, SAVE :: betalpha=0.9
-      REAL, SAVE :: afact=2./3.
-      REAL, SAVE :: fact_shell=1.
-      REAL,SAVE :: detr_min=1.e-5
-      REAL,SAVE :: entr_min=1.e-5
-      REAL,SAVE :: detr_q_coef=0.012
-      REAL,SAVE :: detr_q_power=0.5
-      REAL,SAVE :: mix0=0.
-      INTEGER,SAVE :: thermals_flag_alim=0
-
-!$OMP THREADPRIVATE(fact_epsilon, betalpha, afact, fact_shell)
-!$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power)
-!$OMP THREADPRIVATE( mix0, thermals_flag_alim)
-
-      LOGICAL, SAVE :: first=.true.
-  !$OMP THREADPRIVATE(first)
-
-
-      REAL c2(ngrid,klev)
-
-      if (ngrid==1) print*,'THERMCELL PLUME MODIFIE 2014/07/11'
-      Zsat=.false.
-! Initialisation
-
-      RLvCp = RLVTT/RCPD
-      IF (first) THEN
-
-     CALL getin_p('thermals_fact_epsilon',fact_epsilon)
-     CALL getin_p('thermals_betalpha',betalpha)
-     CALL getin_p('thermals_afact',afact)
-     CALL getin_p('thermals_fact_shell',fact_shell)
-     CALL getin_p('thermals_detr_min',detr_min)
-     CALL getin_p('thermals_entr_min',entr_min)
-     CALL getin_p('thermals_detr_q_coef',detr_q_coef)
-     CALL getin_p('thermals_detr_q_power',detr_q_power)
-     CALL getin_p('thermals_mix0',mix0)
-     CALL getin_p('thermals_flag_alim',thermals_flag_alim)
-
-
-      first=.false.
-      ENDIF
-
-      zbetalpha=betalpha/(1.+betalpha)
-
-
-! Initialisations des variables r?elles
-if (1==1) then
-      ztva(:,:)=ztv(:,:)
-      ztva_est(:,:)=ztva(:,:)
-      ztv_est(:,:)=ztv(:,:)
-      ztla(:,:)=zthl(:,:)
-      zqta(:,:)=po(:,:)
-      zqla(:,:)=0.
-      zha(:,:) = ztva(:,:)
-else
-      ztva(:,:)=0.
-      ztv_est(:,:)=0.
-      ztva_est(:,:)=0.
-      ztla(:,:)=0.
-      zqta(:,:)=0.
-      zha(:,:) =0.
-endif
-
-      zqla_est(:,:)=0.
-      zqsatth(:,:)=0.
-      zqla(:,:)=0.
-      detr_star(:,:)=0.
-      entr_star(:,:)=0.
-      alim_star(:,:)=0.
-      alim_star_tot(:)=0.
-      csc(:,:)=0.
-      detr(:,:)=0.
-      entr(:,:)=0.
-      zw2(:,:)=0.
-      zbuoy(:,:)=0.
-      zbuoyjam(:,:)=0.
-      gamma(:,:)=0.
-      zeps(:,:)=0.
-      w_est(:,:)=0.
-      f_star(:,:)=0.
-      wa_moy(:,:)=0.
-      linter(:)=1.
-!     linter(:)=1.
-! Initialisation des variables entieres
-      lmix(:)=1
-      lmix_bis(:)=2
-      wmaxa(:)=0.
-
-
-!-------------------------------------------------------------------------
-! On ne considere comme actif que les colonnes dont les deux premieres
-! couches sont instables.
-!-------------------------------------------------------------------------
-
-      active(:)=ztv(:,1)>ztv(:,2)
-      d_temp(:)=0. ! Pour activer un contraste de temperature a la base
-                   ! du panache
-!  Cet appel pourrait être fait avant thermcell_plume dans thermcell_main
-      CALL thermcell_alim(thermals_flag_alim,ngrid,klev,ztv,d_temp,zlev,alim_star,lalim)
-
-!------------------------------------------------------------------------------
-! Calcul dans la premiere couche
-! On decide dans cette version que le thermique n'est actif que si la premiere
-! couche est instable.
-! Pourrait etre change si on veut que le thermiques puisse se d??clencher
-! dans une couche l>1
-!------------------------------------------------------------------------------
-do ig=1,ngrid
-! Le panache va prendre au debut les caracteristiques de l'air contenu
-! dans cette couche.
-    if (active(ig)) then
-    ztla(ig,1)=zthl(ig,1) 
-    zqta(ig,1)=po(ig,1)
-    zqla(ig,1)=zl(ig,1)
-!cr: attention, prise en compte de f*(1)=1
-    f_star(ig,2)=alim_star(ig,1)
-    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-&                     *(zlev(ig,2)-zlev(ig,1))  &
-&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
-    w_est(ig,2)=zw2(ig,2)
-    endif
-enddo
-!
-
-!==============================================================================
-!boucle de calcul de la vitesse verticale dans le thermique
-!==============================================================================
-do l=2,klev-1
-!==============================================================================
-
-
-! On decide si le thermique est encore actif ou non
-! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-    do ig=1,ngrid
-       active(ig)=active(ig) &
-&                 .and. zw2(ig,l)>1.e-10 &
-&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
-    enddo
-
-
-
-!---------------------------------------------------------------------------
-! calcul des proprietes thermodynamiques et de la vitesse de la couche l
-! sans tenir compte du detrainement et de l'entrainement dans cette
-! couche
-! C'est a dire qu'on suppose 
-! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
-! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
-! avant) a l'alimentation pour avoir un calcul plus propre
-!---------------------------------------------------------------------------
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
-   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
-    do ig=1,ngrid 
-!       print*,'active',active(ig),ig,l
-        if(active(ig)) then 
-        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
-        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
-     &      -zqla_est(ig,l))-zqla_est(ig,l))
- 
-
-!Modif AJAM
-
-        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 
-        zdz=zlev(ig,l+1)-zlev(ig,l)         
-        lmel=fact_thermals_ed_dz*zlev(ig,l)
-!        lmel=0.09*zlev(ig,l)
-        zlmel=zlev(ig,l)+lmel
-        zlmelup=zlmel+(zdz/2)
-        zlmeldwn=zlmel-(zdz/2)
-
-        lt=l+1
-        zlt=zlev(ig,lt)
-        zdz3=zlev(ig,lt+1)-zlt
-        zltdwn=zlt-zdz3/2
-        zltup=zlt+zdz3/2
-         
-!=========================================================================
-! 3. Calcul de la flotabilite modifie par melange avec l'air au dessus
-!=========================================================================
-
-!--------------------------------------------------
-        if (iflag_thermals_ed.lt.8) then
-!--------------------------------------------------
-!AJ052014: J'ai remplac?? la boucle do par un do while
-! afin de faire moins de calcul dans la boucle
-!--------------------------------------------------
-            do while (zlmelup.gt.zltup)
-               lt=lt+1
-               zlt=zlev(ig,lt)
-               zdz3=zlev(ig,lt+1)-zlt
-               zltdwn=zlt-zdz3/2
-               zltup=zlt+zdz3/2        
-            enddo
-!--------------------------------------------------
-!AJ052014: Si iflag_thermals_ed<8 (par ex 6), alors
-! on cherche o?? se trouve l'altitude d'inversion 
-! en calculant ztv1 (interpolation de la valeur de 
-! theta au niveau lt en utilisant les niveaux lt-1 et
-! lt-2) et ztv2 (interpolation avec les niveaux lt+1
-! et lt+2). Si theta r??ellement calcul??e au niveau lt
-! comprise entre ztv1 et ztv2, alors il y a inversion
-! et on calcule son altitude zinv en supposant que ztv(lt)
-! est une combinaison lineaire de ztv1 et ztv2.
-! Ensuite, on calcule la flottabilite en comparant 
-! la temperature de la couche l a celle de l'air situe 
-! l+lmel plus haut, ce qui necessite de savoir quel fraction 
-! de cet air est au-dessus ou en-dessous de l'inversion   
-!--------------------------------------------------
-            atv1=(ztv(ig,lt-1)-ztv(ig,lt-2))/(zlev(ig,lt-1)-zlev(ig,lt-2))
-            btv1=(ztv(ig,lt-2)*zlev(ig,lt-1)-ztv(ig,lt-1)*zlev(ig,lt-2)) &
-    &          /(zlev(ig,lt-1)-zlev(ig,lt-2))
-            atv2=(ztv(ig,lt+2)-ztv(ig,lt+1))/(zlev(ig,lt+2)-zlev(ig,lt+1))
-            btv2=(ztv(ig,lt+1)*zlev(ig,lt+2)-ztv(ig,lt+2)*zlev(ig,lt+1)) &
-    &          /(zlev(ig,lt+2)-zlev(ig,lt+1))
-
-             ztv1=atv1*zlt+btv1
-             ztv2=atv2*zlt+btv2
-
-             if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then  
-
-!--------------------------------------------------
-!AJ052014: D??calage de zinv qui est entre le haut
-!          et le bas de la couche lt
-!--------------------------------------------------
-                factinv=(ztv2-ztv(ig,lt))/(ztv2-ztv1)
-                zinv=zltdwn+zdz3*factinv
-
-          
-                if (zlmeldwn.ge.zinv) then
-                   ztv_est(ig,l)=atv2*zlmel+btv2
-                   zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l) &
-    &                    +(1.-fact_shell)*zbuoy(ig,l)
-                elseif (zlmelup.ge.zinv) then
-                 ztv_est2=atv2*0.5*(zlmelup+zinv)+btv2
-                   ztv_est1=atv1*0.5*(zinv+zlmeldwn)+btv1
-                   ztv_est(ig,l)=((zlmelup-zinv)/zdz)*ztv_est2+((zinv-zlmeldwn)/zdz)*ztv_est1
-
-                   zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zinv)/zdz)*(ztva_est(ig,l)- & 
-    &            ztv_est2)/ztv_est2+((zinv-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
-    &            ztv_est1)/ztv_est1)+(1.-fact_shell)*zbuoy(ig,l)
-
-                else 
-                   ztv_est(ig,l)=atv1*zlmel+btv1
-                   zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l) & 
-    &                           +(1.-fact_shell)*zbuoy(ig,l)
-                endif
-
-             else ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then
-
-                if (zlmeldwn.gt.zltdwn) then
-                   zbuoyjam(ig,l)=fact_shell*RG*((ztva_est(ig,l)- & 
-    &                ztv(ig,lt))/ztv(ig,lt))+(1.-fact_shell)*zbuoy(ig,l)
-                else
-                   zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zltdwn)/zdz)*(ztva_est(ig,l)- & 
-    &                ztv(ig,lt))/ztv(ig,lt)+((zltdwn-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
-    &                ztv(ig,lt-1))/ztv(ig,lt-1))+(1.-fact_shell)*zbuoy(ig,l)
-
-                endif
-
-!          zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zltdwn)/zdz)*(ztva_est(ig,l)- & 
-!    &          ztv1)/ztv1+((zltdwn-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
-!    &          ztv(ig,lt-1))/ztv(ig,lt-1))+(1.-fact_shell)*zbuoy(ig,l)
-!         zdqt(ig,l)=Max(0.,((lmel+zdz3-zdz2)/zdz3)*(zqta(ig,l-1)- & 
-!    &          po(ig,lt))/po(ig,lt)+((zdz2-lmel)/zdz3)*(zqta(ig,l-1)- &
-!     &          po(ig,lt-1))/po(ig,lt-1))
-          endif ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then
-
-        else  !   if (iflag_thermals_ed.lt.8) then
-           lt=l+1
-           zlt=zlev(ig,lt)
-           zdz2=zlev(ig,lt)-zlev(ig,l)
-
-           do while (lmel.gt.zdz2)
-             lt=lt+1
-             zlt=zlev(ig,lt)
-             zdz2=zlt-zlev(ig,l)
-           enddo
-           zdz3=zlev(ig,lt+1)-zlt
-           zltdwn=zlev(ig,lt)-zdz3/2
-           zlmelup=zlmel+(zdz/2)
-           coefzlmel=Min(1.,(zlmelup-zltdwn)/zdz)
-           zbuoyjam(ig,l)=1.*RG*(coefzlmel*(ztva_est(ig,l)- & 
-    &          ztv(ig,lt))/ztv(ig,lt)+(1.-coefzlmel)*(ztva_est(ig,l)- &
-    &          ztv(ig,lt-1))/ztv(ig,lt-1))+0.*zbuoy(ig,l)
-        endif !   if (iflag_thermals_ed.lt.8) then
-
-!------------------------------------------------
-!AJAM:nouveau calcul de w?  
-!------------------------------------------------
-              zdz=zlev(ig,l+1)-zlev(ig,l)
-              zdzbis=zlev(ig,l)-zlev(ig,l-1)
-              zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-              zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-              zdw2=afact*zbuoy(ig,l)/fact_epsilon
-              zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
-!              zdw2bis=0.5*(zdw2+zdw2bis)
-              lm=Max(1,l-2)
-!              zdw2=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1)) 
-!              zdw2bis=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l-1) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1))
-!             w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
-!             w_est(ig,l+1)=(zdz/zdzbis)*Max(0.0001,exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     Max(0.0001,exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)
-!              w_est(ig,l+1)=Max(0.0001,(1-exp(-zw2fact))*zdw2+w_est(ig,l)*exp(-zw2fact))
-
-!--------------------------------------------------
-!AJ052014: J'ai remplac? w_est(ig,l) par zw2(ig,l)
-!--------------------------------------------------
-         if (iflag_thermals_ed==8) then
-! Ancienne version
-!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2))
-
-	    w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
-
-! Nouvelle version Arnaud
-         else
-!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2))
-
-	    w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2)
-
-!             w_est(ig,l+1)=Max(0.0001,(zdz/(zdzbis+zdz))*(exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2bis)+zdw2)+(zdzbis/(zdzbis+zdz))* &
-!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2bis))
-
-
-
-!            w_est(ig,l+1)=Max(0.0001,(w_est(ig,l)+zdw2bis*zw2fact)*exp(-zw2fact))
-
-!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact)+ &
-!    &                      (zdzbis-zdz)/zdzbis*(zw2(ig,l-1)+zdw2bis*zw2factbis)*exp(-zw2factbis))
-
-!             w_est(ig,l+1)=Max(0.0001,exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)
-
-         endif
-
-
-         if (iflag_thermals_ed<6) then
-             zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-!              fact_epsilon=0.0005/(zalpha+0.025)**0.5
-!              fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
-              fact_epsilon=0.0002/(zalpha+0.1)
-              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-              zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-              zdw2=afact*zbuoy(ig,l)/fact_epsilon
-              zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
-!              w_est(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
-
-!              w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
-
-	    w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2)
-
-
-         endif
-!--------------------------------------------------
-!AJ052014: J'ai comment? ce if plus n?cessaire puisqu'
-!on fait max(0.0001,.....)
-!--------------------------------------------------         
-
-!             if (w_est(ig,l+1).lt.0.) then
-!               w_est(ig,l+1)=zw2(ig,l)
-!                w_est(ig,l+1)=0.0001
-!             endif
-
-       endif
-    enddo
-
-
-!-------------------------------------------------
-!calcul des taux d'entrainement et de detrainement
-!-------------------------------------------------
-
-     do ig=1,ngrid
-        if (active(ig)) then
-
-!          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
-          zw2m=w_est(ig,l+1)
-!          zw2m=zw2(ig,l)
-          zdz=zlev(ig,l+1)-zlev(ig,l)
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-!          zbuoybis=zbuoy(ig,l)+RG*0.1/300.
-          zbuoybis=zbuoy(ig,l)
-          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
-
-          
-!          entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
-!    &     afact*zbuoybis/zw2m - fact_epsilon )
-
-!          entr_star(ig,l)=MAX(0.,f_star(ig,l)*zdz*zbetalpha*  &
-!    &     afact*zbuoybis/zw2m - fact_epsilon )
-
-
-
-!          zbuoyjam(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-!=========================================================================
-! 4. Calcul de l'entrainement et du detrainement
-!=========================================================================
-
-!          entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
-!    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon ) 
-!          entrbis=entr_star(ig,l)
-
-          if (iflag_thermals_ed.lt.6) then
-          fact_epsilon=0.0002/(zalpha+0.1)
-          endif
-          
-
-
-          detr_star(ig,l)=f_star(ig,l)*zdz             &
-    &     *( mix0 * 0.1 / (zalpha+0.001)               &
-    &     + MAX(detr_min, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m   &
-    &     + detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
-
-!	  detr_star(ig,l)=(zdz/zdzbis)*detr_star(ig,l)+ &
-!    &			  ((zdzbis-zdz)/zdzbis)*detr_star(ig,l-1)
-
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-          entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-    &       mix0 * 0.1 / (zalpha+0.001)               &
-    &     + zbetalpha*MAX(entr_min,                   &
-    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon))
-
-
-!          entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-!    &       mix0 * 0.1 / (zalpha+0.001)               &
-!    &     + MAX(entr_min,                   &
-!    &     zbetalpha*afact*zbuoyjam(ig,l)/zw2m - fact_epsilon +  & 
-!    &     detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
-
-
-!	  entr_star(ig,l)=(zdz/zdzbis)*entr_star(ig,l)+ &
-!    &			  ((zdzbis-zdz)/zdzbis)*entr_star(ig,l-1)
-
-!          entr_star(ig,l)=Max(0.,f_star(ig,l)*zdz*zbetalpha*  &     
-!    &     afact*zbuoy(ig,l)/zw2m &
-!    &     - 1.*fact_epsilon)
-
-          
-! En dessous de lalim, on prend le max de alim_star et entr_star pour
-! alim_star et 0 sinon
-        if (l.lt.lalim(ig)) then
-          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
-          entr_star(ig,l)=0.
-        endif
-!        if (l.lt.lalim(ig).and.alim_star(ig,l)>alim_star(ig,l-1)) then
-!          alim_star(ig,l)=entrbis
-!        endif
-
-!        print*,'alim0',zlev(ig,l),entr_star(ig,l),detr_star(ig,l),zw2m,zbuoy(ig,l),f_star(ig,l)
-! Calcul du flux montant normalise
-      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
-     &              -detr_star(ig,l)
-
-      endif
-   enddo
-
-
-!============================================================================
-! 5. calcul de la vitesse verticale en melangeant Tl et qt du thermique
-!===========================================================================
-
-   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
-   do ig=1,ngrid
-       if (activetmp(ig)) then 
-           Zsat=.false.
-           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-
-        endif
-    enddo
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l)
-   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
-   do ig=1,ngrid
-      if (activetmp(ig)) then
-! on ecrit de maniere conservative (sat ou non)
-!          T = Tl +Lv/Cp ql
-           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
-           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-           zha(ig,l) = ztva(ig,l)
-           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
-     &              -zqla(ig,l))-zqla(ig,l))
-           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
-           zdz=zlev(ig,l+1)-zlev(ig,l)
-           zdzbis=zlev(ig,l)-zlev(ig,l-1)
-           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
-!!!!!!!          fact_epsilon=0.002
-            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-            zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-            zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
-            zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
-!              zdw2=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1)) 
-!              lm=Max(1,l-2)
-!              zdw2bis=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l-1) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1))
-!            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
-!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact)+ &
-!     &                   (zdzbis-zdz)/zdzbis*(zw2(ig,l-1)+zdw2bis*zw2factbis)*exp(-zw2factbis))
-!            zw2(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
-!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
-            if (iflag_thermals_ed==8) then
-	    zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2)
-            else
-	    zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
-            endif
-!            zw2(ig,l+1)=Max(0.0001,(zdz/(zdz+zdzbis))*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2bis)+(zdzbis/(zdz+zdzbis))* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2bis))
-
-
-           if (iflag_thermals_ed.lt.6) then
-           zalpha=f0(ig)*f_star(ig,l)/sqrt(zw2(ig,l+1))/rhobarz(ig,l)
-!           fact_epsilon=0.0005/(zalpha+0.025)**0.5
-!           fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
-           fact_epsilon=0.0002/(zalpha+0.1)**1
-            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-            zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-            zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
-            zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
-
-!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
-!            zw2(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
-	    zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
-
-           endif
-
-
-      endif
-   enddo
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
-!
-!===========================================================================
-! 6. initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-!===========================================================================
-
-   nbpb=0
-   do ig=1,ngrid
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_plume'
-                nbpb=nbpb+1
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-            endif
-
-        if (zw2(ig,l+1).lt.0.) then 
-           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-           zw2(ig,l+1)=0.
-!+CR:04/05/12:correction calcul linter pour calcul de zmax continu
-        elseif (f_star(ig,l+1).lt.0.) then
-           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-           zw2(ig,l+1)=0.
-!fin CR:04/05/12
-        endif
-
-           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
-
-        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-!on rajoute le calcul de lmix_bis
-            if (zqla(ig,l).lt.1.e-10) then
-               lmix_bis(ig)=l+1
-            endif
-            lmix(ig)=l+1
-            wmaxa(ig)=wa_moy(ig,l+1)
-        endif
-   enddo
-
-   if (nbpb>0) then
-   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
-   endif
-
-!=========================================================================
-! FIN DE LA BOUCLE VERTICALE
-      enddo
-!=========================================================================
-
-!on recalcule alim_star_tot
-       do ig=1,ngrid
-          alim_star_tot(ig)=0.
-       enddo
-       do ig=1,ngrid
-          do l=1,lalim(ig)-1
-          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-          enddo
-       enddo
-       
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
-
-#undef wrgrads_thermcell
-#ifdef wrgrads_thermcell
-         call wrgradsfi(1,klev,entr_star(igout,1:klev),'esta      ','esta      ')
-         call wrgradsfi(1,klev,detr_star(igout,1:klev),'dsta      ','dsta      ')
-         call wrgradsfi(1,klev,zbuoy(igout,1:klev),'buoy      ','buoy      ')
-         call wrgradsfi(1,klev,zdqt(igout,1:klev),'dqt      ','dqt      ')
-         call wrgradsfi(1,klev,w_est(igout,1:klev),'w_est     ','w_est     ')
-         call wrgradsfi(1,klev,w_est(igout,2:klev+1),'w_es2     ','w_es2     ')
-         call wrgradsfi(1,klev,zw2(igout,1:klev),'zw2A      ','zw2A      ')
-#endif
-
-
-     return 
-     end
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- SUBROUTINE thermcell_plume_5B(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-&           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-&           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-&           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-&           ,lev_out,lunout1,igout)
-!&           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
-
-!--------------------------------------------------------------------------
-!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
-! Version conforme a l'article de Rio et al. 2010.
-! Code ecrit par Catherine Rio, Arnaud Jam et Frederic Hourdin
-!--------------------------------------------------------------------------
-
-      USE print_control_mod, ONLY: prt_level
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "thermcell.h"
-
-      INTEGER itap
-      INTEGER lunout1,igout
-      INTEGER ngrid,klev
-      REAL ptimestep
-      REAL ztv(ngrid,klev)
-      REAL zthl(ngrid,klev)
-      REAL po(ngrid,klev)
-      REAL zl(ngrid,klev)
-      REAL rhobarz(ngrid,klev)
-      REAL zlev(ngrid,klev+1)
-      REAL pplev(ngrid,klev+1)
-      REAL pphi(ngrid,klev)
-      REAL zpspsk(ngrid,klev)
-      REAL alim_star(ngrid,klev)
-      REAL f0(ngrid)
-      INTEGER lalim(ngrid)
-      integer lev_out                           ! niveau pour les print
-      integer nbpb
-    
-      real alim_star_tot(ngrid)
-
-      REAL ztva(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zqla(ngrid,klev)
-      REAL zqta(ngrid,klev)
-      REAL zha(ngrid,klev)
-
-      REAL detr_star(ngrid,klev)
-      REAL coefc
-      REAL entr_star(ngrid,klev)
-      REAL detr(ngrid,klev)
-      REAL entr(ngrid,klev)
-
-      REAL csc(ngrid,klev)
-
-      REAL zw2(ngrid,klev+1)
-      REAL w_est(ngrid,klev+1)
-      REAL f_star(ngrid,klev+1)
-      REAL wa_moy(ngrid,klev+1)
-
-      REAL ztva_est(ngrid,klev)
-      REAL zqla_est(ngrid,klev)
-      REAL zqsatth(ngrid,klev)
-      REAL zta_est(ngrid,klev)
-      REAL zbuoyjam(ngrid,klev)
-      REAL ztemp(ngrid),zqsat(ngrid)
-      REAL zdw2
-      REAL zw2modif
-      REAL zw2fact
-      REAL zeps(ngrid,klev)
-
-      REAL linter(ngrid)
-      INTEGER lmix(ngrid)
-      INTEGER lmix_bis(ngrid)
-      REAL    wmaxa(ngrid)
-
-      INTEGER ig,l,k
-
-      real zdz,zbuoy(ngrid,klev),zalpha,gamma(ngrid,klev),zdqt(ngrid,klev),zw2m
-      real zbuoybis
-      real zcor,zdelta,zcvm5,qlbef,zdz2
-      real betalpha,zbetalpha
-      real eps, afact
-      REAL REPS,RLvCp,DDT0
-      PARAMETER (DDT0=.01)
-      logical Zsat
-      LOGICAL active(ngrid),activetmp(ngrid)
-      REAL fact_gamma,fact_epsilon,fact_gamma2,fact_epsilon2
-      REAL c2(ngrid,klev)
-      Zsat=.false.
-! Initialisation
-
-      RLvCp = RLVTT/RCPD
-      fact_epsilon=0.002
-      betalpha=0.9 
-      afact=2./3.            
-
-      zbetalpha=betalpha/(1.+betalpha)
-
-
-! Initialisations des variables reeles
-if (1==1) then
-      ztva(:,:)=ztv(:,:)
-      ztva_est(:,:)=ztva(:,:)
-      ztla(:,:)=zthl(:,:)
-      zqta(:,:)=po(:,:)
-      zha(:,:) = ztva(:,:)
-else
-      ztva(:,:)=0.
-      ztva_est(:,:)=0.
-      ztla(:,:)=0.
-      zqta(:,:)=0.
-      zha(:,:) =0.
-endif
-
-      zqla_est(:,:)=0.
-      zqsatth(:,:)=0.
-      zqla(:,:)=0.
-      detr_star(:,:)=0.
-      entr_star(:,:)=0.
-      alim_star(:,:)=0.
-      alim_star_tot(:)=0.
-      csc(:,:)=0.
-      detr(:,:)=0.
-      entr(:,:)=0.
-      zw2(:,:)=0.
-      zbuoy(:,:)=0.
-      zbuoyjam(:,:)=0.
-      gamma(:,:)=0.
-      zeps(:,:)=0.
-      w_est(:,:)=0.
-      f_star(:,:)=0.
-      wa_moy(:,:)=0.
-      linter(:)=1.
-!     linter(:)=1.
-! Initialisation des variables entieres
-      lmix(:)=1
-      lmix_bis(:)=2
-      wmaxa(:)=0.
-      lalim(:)=1
-
-
-!-------------------------------------------------------------------------
-! On ne considere comme actif que les colonnes dont les deux premieres
-! couches sont instables.
-!-------------------------------------------------------------------------
-      active(:)=ztv(:,1)>ztv(:,2)
-
-!-------------------------------------------------------------------------
-! Definition de l'alimentation a l'origine dans thermcell_init
-!-------------------------------------------------------------------------
-      do l=1,klev-1
-         do ig=1,ngrid
-            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
-               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
-     &                       *sqrt(zlev(ig,l+1)) 
-               lalim(ig)=l+1
-               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-            endif
-         enddo
-      enddo
-      do l=1,klev
-         do ig=1,ngrid 
-            if (alim_star_tot(ig) > 1.e-10 ) then
-               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
-            endif
-         enddo
-      enddo
-      alim_star_tot(:)=1.
-
-
-
-!------------------------------------------------------------------------------
-! Calcul dans la premiere couche
-! On decide dans cette version que le thermique n'est actif que si la premiere
-! couche est instable.
-! Pourrait etre change si on veut que le thermiques puisse se d??clencher
-! dans une couche l>1
-!------------------------------------------------------------------------------
-do ig=1,ngrid
-! Le panache va prendre au debut les caracteristiques de l'air contenu
-! dans cette couche.
-    if (active(ig)) then
-    ztla(ig,1)=zthl(ig,1) 
-    zqta(ig,1)=po(ig,1)
-    zqla(ig,1)=zl(ig,1)
-!cr: attention, prise en compte de f*(1)=1
-    f_star(ig,2)=alim_star(ig,1)
-    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-&                     *(zlev(ig,2)-zlev(ig,1))  &
-&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
-    w_est(ig,2)=zw2(ig,2)
-    endif
-enddo
-!
-
-!==============================================================================
-!boucle de calcul de la vitesse verticale dans le thermique
-!==============================================================================
-do l=2,klev-1
-!==============================================================================
-
-
-! On decide si le thermique est encore actif ou non
-! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-    do ig=1,ngrid
-       active(ig)=active(ig) &
-&                 .and. zw2(ig,l)>1.e-10 &
-&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
-    enddo
-
-
-
-!---------------------------------------------------------------------------
-! calcul des proprietes thermodynamiques et de la vitesse de la couche l
-! sans tenir compte du detrainement et de l'entrainement dans cette
-! couche
-! C'est a dire qu'on suppose 
-! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
-! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
-! avant) a l'alimentation pour avoir un calcul plus propre
-!---------------------------------------------------------------------------
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
-   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
-
-    do ig=1,ngrid 
-!       print*,'active',active(ig),ig,l
-        if(active(ig)) then 
-        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
-        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
-     &      -zqla_est(ig,l))-zqla_est(ig,l))
-
-!------------------------------------------------
-!AJAM:nouveau calcul de w?  
-!------------------------------------------------
-              zdz=zlev(ig,l+1)-zlev(ig,l)
-              zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-              zdw2=(afact)*zbuoy(ig,l)/(fact_epsilon)
-              w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
- 
-
-             if (w_est(ig,l+1).lt.0.) then
-                w_est(ig,l+1)=zw2(ig,l)
-             endif
-       endif
-    enddo
-
-
-!-------------------------------------------------
-!calcul des taux d'entrainement et de detrainement
-!-------------------------------------------------
-
-     do ig=1,ngrid
-        if (active(ig)) then
-
-          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
-          zw2m=w_est(ig,l+1)
-          zdz=zlev(ig,l+1)-zlev(ig,l)
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-!          zbuoybis=zbuoy(ig,l)+RG*0.1/300.
-          zbuoybis=zbuoy(ig,l)
-          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
-
-          
-          entr_star(ig,l)=f_star(ig,l)*zdz*  zbetalpha*MAX(0.,  &
-    &     afact*zbuoybis/zw2m - fact_epsilon )
-
-
-          detr_star(ig,l)=f_star(ig,l)*zdz                        &
-    &     *MAX(1.e-3, -afact*zbetalpha*zbuoy(ig,l)/zw2m          &
-    &     + 0.012*(zdqt(ig,l)/zw2m)**0.5 )
-          
-! En dessous de lalim, on prend le max de alim_star et entr_star pour
-! alim_star et 0 sinon
-        if (l.lt.lalim(ig)) then
-          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
-          entr_star(ig,l)=0.
-        endif
-
-! Calcul du flux montant normalise
-      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
-     &              -detr_star(ig,l)
-
-      endif
-   enddo
-
-
-!----------------------------------------------------------------------------
-!calcul de la vitesse verticale en melangeant Tl et qt du thermique
-!---------------------------------------------------------------------------
-   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
-   do ig=1,ngrid
-       if (activetmp(ig)) then 
-           Zsat=.false.
-           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-
-        endif
-    enddo
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l)
-   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
-
-   do ig=1,ngrid
-      if (activetmp(ig)) then
-! on ecrit de maniere conservative (sat ou non)
-!          T = Tl +Lv/Cp ql
-           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
-           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-           zha(ig,l) = ztva(ig,l)
-           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
-     &              -zqla(ig,l))-zqla(ig,l))
-           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
-           zdz=zlev(ig,l+1)-zlev(ig,l)
-           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
-
-            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-            zdw2=afact*zbuoy(ig,l)/(fact_epsilon)
-            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2) 
-      endif
-   enddo
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
-!
-!---------------------------------------------------------------------------
-!initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-!---------------------------------------------------------------------------
-
-   nbpb=0
-   do ig=1,ngrid
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_plume'
-                nbpb=nbpb+1
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-            endif
-
-        if (zw2(ig,l+1).lt.0.) then 
-           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-           zw2(ig,l+1)=0.
-        elseif (f_star(ig,l+1).lt.0.) then
-           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-!           print*,"linter plume", linter(ig)
-           zw2(ig,l+1)=0.
-        endif
-
-           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
-
-        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-!on rajoute le calcul de lmix_bis
-            if (zqla(ig,l).lt.1.e-10) then
-               lmix_bis(ig)=l+1
-            endif
-            lmix(ig)=l+1
-            wmaxa(ig)=wa_moy(ig,l+1)
-        endif
-   enddo
-
-   if (nbpb>0) then
-   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
-   endif
-
-!=========================================================================
-! FIN DE LA BOUCLE VERTICALE
-      enddo
-!=========================================================================
-
-!on recalcule alim_star_tot
-       do ig=1,ngrid
-          alim_star_tot(ig)=0.
-       enddo
-       do ig=1,ngrid
-          do l=1,lalim(ig)-1
-          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-          enddo
-       enddo
-       
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
-
-#undef wrgrads_thermcell
-#ifdef wrgrads_thermcell
-         call wrgradsfi(1,klev,entr_star(igout,1:klev),'esta      ','esta      ')
-         call wrgradsfi(1,klev,detr_star(igout,1:klev),'dsta      ','dsta      ')
-         call wrgradsfi(1,klev,zbuoy(igout,1:klev),'buoy      ','buoy      ')
-         call wrgradsfi(1,klev,zdqt(igout,1:klev),'dqt      ','dqt      ')
-         call wrgradsfi(1,klev,w_est(igout,1:klev),'w_est     ','w_est     ')
-         call wrgradsfi(1,klev,w_est(igout,2:klev+1),'w_es2     ','w_es2     ')
-         call wrgradsfi(1,klev,zw2(igout,1:klev),'zw2A      ','zw2A      ')
-#endif
-
-
-     return 
-     end
+link ../phylmd/thermcell_plume_6A.F90
Index: LMDZ6/trunk/libf/phylmdiso/thermcell_qsat.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/thermcell_qsat.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/thermcell_qsat.F90	(revision 3940)
@@ -1,95 +1,1 @@
-subroutine thermcell_qsat(klon,active,pplev,ztemp,zqta,zqsat)
-implicit none
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-
-
-!====================================================================
-! DECLARATIONS
-!====================================================================
-
-! Arguments
-INTEGER klon
-REAL zpspsk(klon),pplev(klon)
-REAL ztemp(klon),zqta(klon),zqsat(klon)
-LOGICAL active(klon)
-
-! Variables locales
-INTEGER ig,iter
-REAL Tbef(klon),DT(klon)
-REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
-logical Zsat
-REAL RLvCp
-
-REAL, SAVE :: DDT0=.01
-!$OMP THREADPRIVATE(DDT0)
-
-LOGICAL afaire(klon),tout_converge
-
-!====================================================================
-! INITIALISATIONS
-!====================================================================
-
-RLvCp = RLVTT/RCPD
-tout_converge=.false.
-afaire(:)=.false.
-DT(:)=0.
-
-
-!====================================================================
-! Routine a vectoriser en copiant active dans converge et en mettant
-! la boucle sur les iterations a l'exterieur est en mettant
-! converge= false des que la convergence est atteinte.
-!====================================================================
-
-do ig=1,klon
-   if (active(ig)) then
-               Tbef(ig)=ztemp(ig)
-               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-               qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
-               qsatbef=MIN(0.5,qsatbef)
-               zcor=1./(1.-retv*qsatbef)
-               qsatbef=qsatbef*zcor
-               qlbef=max(0.,zqta(ig)-qsatbef)
-               DT(ig) = 0.5*RLvCp*qlbef
-               zqsat(ig)=qsatbef
-     endif
-enddo
-
-! Traitement du cas ou il y a condensation mais faible
-! On ne condense pas mais on dit que le qsat est le qta
-do ig=1,klon
-   if (active(ig)) then
-      if (0.<abs(DT(ig)).and.abs(DT(ig))<=DDT0) then
-         zqsat(ig)=zqta(ig)
-      endif
-   endif
-enddo
-
-do iter=1,10
-    afaire(:)=abs(DT(:)).gt.DDT0
-    do ig=1,klon
-               if (afaire(ig)) then
-                 Tbef(ig)=Tbef(ig)+DT(ig)
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-                 qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
-                 qsatbef=MIN(0.5,qsatbef)
-                 zcor=1./(1.-retv*qsatbef)
-                 qsatbef=qsatbef*zcor
-                 qlbef=zqta(ig)-qsatbef
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-                 zcor=1./(1.-retv*qsatbef)
-                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor)
-                 num=-Tbef(ig)+ztemp(ig)+RLvCp*qlbef
-                 denom=1.+RLvCp*dqsat_dT
-                 zqsat(ig) = qsatbef
-                 DT(ig)=num/denom
-               endif
-    enddo
-enddo
-
-return
-end
+link ../phylmd/thermcell_qsat.F90
Index: LMDZ6/trunk/libf/phylmdiso/tilft43.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tilft43.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tilft43.F90	(revision 3940)
@@ -1,99 +1,1 @@
-
-! $Header$
-
-SUBROUTINE tlift43(p, t, q, qs, gz, icb, nk, tvp, tpk, clw, nd, nl, kk)
-  IMPLICIT NONE
-  REAL gz(nd), tpk(nd), clw(nd), p(nd)
-  REAL t(nd), q(nd), qs(nd), tvp(nd), lv0
-  INTEGER icb, nk, nd, nl, kk
-  REAL cpd, cpv,  cl, g, rowl, gravity, cpvmcl, eps, epsi
-  REAL ah0, cpp, cpinv, tg, qg, alv, s, ahg, tc, denom, es
-  INTEGER i, nst, nsb, j 
-  ! ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
-
-  ! -- sb:
-  ! !      CPD=1005.7
-  ! !      CPV=1870.0
-  ! !      CL=4190.0
-  ! !      RV=461.5
-  ! !      RD=287.04
-  ! !      LV0=2.501E6
-  ! !      G=9.8
-  ! !      ROWL=1000.0
-  ! ajouts:
-  include "YOMCST.h"
-  cpd = rcpd
-  cpv = rcpv
-  cl = rcw
-  lv0 = rlvtt
-  g = rg
-  rowl = ratm/100.
-  gravity = rg !sb: Pr que gravite ne devienne pas humidite!
-  ! sb --
-
-  cpvmcl = cl - cpv
-  eps = rd/rv
-  epsi = 1./eps
-
-  ! ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
-
-  ah0 = (cpd*(1.-q(nk))+cl*q(nk))*t(nk) + q(nk)*(lv0-cpvmcl*(t(nk)-273.15)) + &
-    gz(nk)
-  cpp = cpd*(1.-q(nk)) + q(nk)*cpv
-  cpinv = 1./cpp
-
-  IF (kk==1) THEN
-
-    ! ***   CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE   ***
-
-    DO i = 1, icb - 1
-      clw(i) = 0.0
-    END DO
-    DO i = nk, icb - 1
-      tpk(i) = t(nk) - (gz(i)-gz(nk))*cpinv
-      tvp(i) = tpk(i)*(1.+q(nk)*epsi)
-    END DO
-  END IF
-
-  ! ***  FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE    ***
-
-  nst = icb
-  nsb = icb
-  IF (kk==2) THEN
-    nst = nl
-    nsb = icb + 1
-  END IF
-  DO i = nsb, nst
-    tg = t(i)
-    qg = qs(i)
-    alv = lv0 - cpvmcl*(t(i)-273.15)
-    DO j = 1, 2
-      s = cpd + alv*alv*qg/(rv*t(i)*t(i))
-      s = 1./s
-      ahg = cpd*tg + (cl-cpd)*q(nk)*t(i) + alv*qg + gz(i)
-      tg = tg + s*(ah0-ahg)
-      tg = max(tg, 35.0)
-      tc = tg - 273.15
-      denom = 243.5 + tc
-      IF (tc>=0.0) THEN
-        es = 6.112*exp(17.67*tc/denom)
-      ELSE
-        es = exp(23.33086-6111.72784/tg+0.15215*log(tg))
-      END IF
-      qg = eps*es/(p(i)-es*(1.-eps))
-    END DO
-    alv = lv0 - cpvmcl*(t(i)-273.15)
-    tpk(i) = (ah0-(cl-cpd)*q(nk)*t(i)-gz(i)-alv*qg)/cpd
-    clw(i) = q(nk) - qg
-    clw(i) = max(0.0, clw(i))
-    rg = qg/(1.-q(nk))
-    tvp(i) = tpk(i)*(1.+rg*epsi)
-  END DO
-
-  ! -- sb:
-  rg = gravity ! RG redevient la gravite de YOMCST (sb)
-  ! sb --
-
-  RETURN
-END SUBROUTINE tlift43
-
+link ../phylmd/tilft43.F90
Index: LMDZ6/trunk/libf/phylmdiso/time_phylmdz_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/time_phylmdz_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/time_phylmdz_mod.F90	(revision 3940)
@@ -1,112 +1,1 @@
-!
-! $Id: time_phylmdz_mod.F90 2805 2017-03-01 16:50:11Z fairhead $
-!
-MODULE time_phylmdz_mod
-
-    IMPLICIT NONE
-    REAL,SAVE    :: pdtphys     ! physics time step (s)
-!$OMP THREADPRIVATE(pdtphys)
-    INTEGER,SAVE :: day_step_phy    ! number of physical steps per day
-!$OMP THREADPRIVATE(day_step_phy)
-    INTEGER,SAVE :: ndays       ! number of days to run
-!$OMP THREADPRIVATE(ndays)
-    INTEGER,SAVE :: annee_ref   ! reference year from the origin
-!$OMP THREADPRIVATE(annee_ref)
-    INTEGER,SAVE :: day_ref     ! reference year of the origin
-!$OMP THREADPRIVATE(day_ref)
-    INTEGER,SAVE :: day_ini     ! initial day of the run starting from 1st january of annee_ref
-!$OMP THREADPRIVATE(day_ini)
-    INTEGER,SAVE :: day_end     ! final day of the run starting from 1st january of annee_ref
-!$OMP THREADPRIVATE(day_end)
-    REAL,SAVE    :: start_time  ! starting time from the begining of the initial day
-!$OMP THREADPRIVATE(start_time)
-    INTEGER,SAVE :: raz_date
-!$OMP THREADPRIVATE(raz_date)
-
-    INTEGER,SAVE :: itau_phy     ! number of physiq iteration from origin
-!$OMP THREADPRIVATE(itau_phy)
-    INTEGER,SAVE :: itaufin_phy      ! final iteration (in itau_phy steps)
-!$OMP THREADPRIVATE(itaufin_phy)
-    REAL,SAVE    :: current_time ! current elapsed time in seconds from the begining of the run
-!$OMP THREADPRIVATE(current_time)
-    
-
-CONTAINS
-
-  SUBROUTINE init_time(annee_ref_, day_ref_, day_ini_, start_time_, &
-                       ndays_, pdtphys_)
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE phys_cal_mod, ONLY: phys_cal_init
-  IMPLICIT NONE
-  INCLUDE 'YOMCST.h'
-    INTEGER, INTENT(IN) :: annee_ref_  
-    INTEGER, INTENT(IN) :: day_ref_    
-    INTEGER, INTENT(IN) :: day_ini_    
-    REAL,    INTENT(IN) :: start_time_ 
-    INTEGER, INTENT(IN) :: ndays_      
-    REAL,    INTENT(IN) :: pdtphys_    
-    
-    annee_ref    = annee_ref_
-    day_ref      = day_ref_
-    day_ini      = day_ini_
-    start_time   = start_time_
-    ndays        = ndays_
-    pdtphys      = pdtphys_
-    
-    ! Initialize module variable not inherited from dynamics
-    day_step_phy = NINT(rday/pdtphys)
-    day_end  = day_ini + ndays
-  
-    raz_date = 0
-    CALL getin_p('raz_date', raz_date)
-
-    current_time=0.
-    
-    CALL phys_cal_init(annee_ref,day_ref)
-    
-  END SUBROUTINE init_time
-
-  SUBROUTINE init_iteration(itau_phy_)
-  IMPLICIT NONE
-    INTEGER, INTENT(IN) :: itau_phy_
-    itau_phy=itau_phy_
-    IF (raz_date==1) itau_phy=0
-    
-    itaufin_phy=itau_phy+NINT(ndays/pdtphys)
-    
-  END SUBROUTINE init_iteration
-
-  SUBROUTINE update_time(pdtphys_)
-  ! This subroutine updates the module saved variables.
-  USE ioipsl, ONLY : ymds2ju
-  USE phys_cal_mod, ONLY: phys_cal_update
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-  INCLUDE 'YOMCST.h'
-  REAL,INTENT(IN) :: pdtphys_
-  REAL            :: julian_date
-  INTEGER         :: cur_day
-  REAL            :: cur_sec
-
-    ! Check if the physics timestep has changed
-    IF ( ABS( (pdtphys-pdtphys_) / ((pdtphys+pdtphys_)/2))> 10.*EPSILON(pdtphys_)) THEN
-       WRITE(lunout,*) "WARNING ! Physics time step changes from a call to the next",pdtphys_,pdtphys
-       WRITE(lunout,*) "Not sure the physics parametrizations can handle this..."
-    ENDIF
-    pdtphys=pdtphys_
-    
-    ! Update elapsed time since begining of run:
-    current_time = current_time + pdtphys
-    cur_day = int(current_time/rday)
-    cur_sec = current_time - (cur_day * rday) 
-
-    ! Compute corresponding Julian date and update calendar
-    cur_day = cur_day + day_ini
-    cur_sec = cur_sec + (start_time * rday)
-    CALL ymds2ju(annee_ref,1, cur_day, cur_sec, julian_date)
-    CALL phys_cal_update(julian_date)
-    
-  END SUBROUTINE update_time
-
-END MODULE time_phylmdz_mod      
-
+link ../phylmd/time_phylmdz_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/tlift.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tlift.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tlift.F90	(revision 3940)
@@ -1,246 +1,1 @@
-
-! $Header$
-
-SUBROUTINE tlift(p, t, rr, rs, gz, plcl, icb, nk, tvp, tpk, clw, nd, nl, &
-    dtvpdt1, dtvpdq1)
-  IMPLICIT NONE
-  ! Argument NK ajoute (jyg) = Niveau de depart de la
-  ! convection
-  INTEGER icb, nk, nd, nl
-  INTEGER,PARAMETER :: na=60
-  REAL gz(nd), tpk(nd), clw(nd), plcl
-  REAL t(nd), rr(nd), rs(nd), tvp(nd), p(nd)
-  REAL dtvpdt1(nd), dtvpdq1(nd) ! Derivatives of parcel virtual
-  ! temperature wrt T1 and Q1
-
-  REAL clw_new(na), qi(na)
-  REAL dtpdt1(na), dtpdq1(na) ! Derivatives of parcel temperature
-  ! wrt T1 and Q1
-  REAL gravity, cpd, cpv, cl, ci, cpvmcl, clmci, eps, alv0, alf0
-  REAL cpp, cpinv, ah0, alf, tg, s, ahg, tc, denom, alv, es, esi
-  REAL qsat_new, snew
-  INTEGER icbl, i, imin, j, icb1
-
-  LOGICAL ice_conv
-
-  ! ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
-
-  ! sb        CPD=1005.7
-  ! sb      CPV=1870.0
-  ! sb        CL=4190.0
-  ! sb        CPVMCL=2320.0
-  ! sb        RV=461.5
-  ! sb        RD=287.04
-  ! sb        EPS=RD/RV
-  ! sb        ALV0=2.501E6
-  ! cccccccccccccccccccccc
-  ! constantes coherentes avec le modele du Centre Europeen
-  ! sb      RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
-  ! sb      RV = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 18.0153
-  ! sb      CPD = 3.5 * RD
-  ! sb      CPV = 4.0 * RV
-  ! sb      CL = 4218.0
-  ! sb      CI=2090.0
-  ! sb      CPVMCL=CL-CPV
-  ! sb      CLMCI=CL-CI
-  ! sb      EPS=RD/RV
-  ! sb      ALV0=2.5008E+06
-  ! sb      ALF0=3.34E+05
-
-  ! ccccccccccc
-  ! on utilise les constantes thermo du Centre Europeen: (SB)
-
-  include "YOMCST.h"
-  gravity = rg !sb: Pr que gravite ne devienne pas humidite!
-
-  cpd = rcpd
-  cpv = rcpv
-  cl = rcw
-  ci = rcs
-  cpvmcl = cl - cpv
-  clmci = cl - ci
-  eps = rd/rv
-  alv0 = rlvtt
-  alf0 = rlmlt ! (ALF0 = RLSTT-RLVTT)
-
-  ! ccccccccccccccccccccc
-
-  ! ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
-
-  icb1 = max(icb, 2)
-  icb1 = min(icb, nl)
-
-  ! jyg1
-  ! C      CPP=CPD*(1.-RR(1))+RR(1)*CPV
-  cpp = cpd*(1.-rr(nk)) + rr(nk)*cpv
-  ! jyg2
-  cpinv = 1./cpp
-  ! jyg1
-  ! ICB may be below condensation level
-  ! CC        DO 100 I=1,ICB1-1
-  ! CC         TPK(I)=T(1)-GZ(I)*CPINV
-  ! CC         TVP(I)=TPK(I)*(1.+RR(1)/EPS)
-  DO i = 1, icb1
-    clw(i) = 0.0
-  END DO
-
-  DO i = nk, icb1
-    tpk(i) = t(nk) - (gz(i)-gz(nk))*cpinv
-    ! jyg1
-    ! CC         TVP(I)=TPK(I)*(1.+RR(NK)/EPS)
-    tvp(i) = tpk(i)*(1.+rr(nk)/eps-rr(nk))
-    ! jyg2
-    dtvpdt1(i) = 1. + rr(nk)/eps - rr(nk)
-    dtvpdq1(i) = tpk(i)*(1./eps-1.)
-
-    ! jyg2
-
-  END DO
-
-
-  ! ***  FIND LIFTED PARCEL TEMPERATURE AND MIXING RATIO    ***
-
-  ! jyg1
-  ! C        AH0=(CPD*(1.-RR(1))+CL*RR(1))*T(1)
-  ! C     $     +RR(1)*(ALV0-CPVMCL*(T(1)-273.15))
-  ah0 = (cpd*(1.-rr(nk))+cl*rr(nk))*t(nk) + rr(nk)*(alv0-cpvmcl*(t(nk)-273.15 &
-    )) + gz(nk)
-  ! jyg2
-
-  ! jyg1
-  imin = icb1
-  ! If ICB is below LCL, start loop at ICB+1
-  IF (plcl<p(icb1)) imin = min(imin+1, nl)
-
-  ! CC        DO 300 I=ICB1,NL
-  DO i = imin, nl
-    ! jyg2
-    alv = alv0 - cpvmcl*(t(i)-273.15)
-    alf = alf0 + clmci*(t(i)-273.15)
-
-    rg = rs(i)
-    tg = t(i)
-    ! S=CPD+ALV*ALV*RG/(RV*T(I)*T(I))
-    ! jyg1
-    ! C        S=CPD*(1.-RR(1))+CL*RR(1)+ALV*ALV*RG/(RV*T(I)*T(I))
-    s = cpd*(1.-rr(nk)) + cl*rr(nk) + alv*alv*rg/(rv*t(i)*t(i))
-    ! jyg2
-    s = 1./s
-
-    DO j = 1, 2
-      ! jyg1
-      ! C         AHG=CPD*TG+(CL-CPD)*RR(1)*TG+ALV*RG+GZ(I)
-      ahg = cpd*tg + (cl-cpd)*rr(nk)*tg + alv*rg + gz(i)
-      ! jyg2
-      tg = tg + s*(ah0-ahg)
-      tc = tg - 273.15
-      denom = 243.5 + tc
-      denom = max(denom, 1.0)
-
-      ! FORMULE DE BOLTON POUR PSAT
-
-      es = 6.112*exp(17.67*tc/denom)
-      rg = eps*es/(p(i)-es*(1.-eps))
-
-
-    END DO
-
-    ! jyg1
-    ! C        TPK(I)=(AH0-GZ(I)-ALV*RG)/(CPD+(CL-CPD)*RR(1))
-    tpk(i) = (ah0-gz(i)-alv*rg)/(cpd+(cl-cpd)*rr(nk))
-    ! jyg2
-    ! TPK(I)=(AH0-GZ(I)-ALV*RG-(CL-CPD)*T(I)*RR(1))/CPD
-
-    ! jyg1
-    ! C        CLW(I)=RR(1)-RG
-    clw(i) = rr(nk) - rg
-    ! jyg2
-    clw(i) = max(0.0, clw(i))
-    ! jyg1
-    ! CC        TVP(I)=TPK(I)*(1.+RG/EPS)
-    tvp(i) = tpk(i)*(1.+rg/eps-rr(nk))
-    ! jyg2
-
-    ! jyg1       Derivatives
-
-    dtpdt1(i) = cpd*s
-    dtpdq1(i) = alv*s
-
-    dtvpdt1(i) = dtpdt1(i)*(1.+rg/eps-rr(nk)+alv*rg/(rd*tpk(i)))
-    dtvpdq1(i) = dtpdq1(i)*(1.+rg/eps-rr(nk)+alv*rg/(rd*tpk(i))) - tpk(i)
-
-    ! jyg2
-
-  END DO
-
-  ice_conv = .FALSE.
-
-  IF (ice_conv) THEN
-
-    ! JAM
-    ! RAJOUT DE LA PROCEDURE ICEFRAC
-
-    ! sb        CALL ICEFRAC(T,CLW,CLW_NEW,QI,ND,NL)
-
-    DO i = icb1, nl
-      IF (t(i)<263.15) THEN
-        tg = tpk(i)
-        tc = tpk(i) - 273.15
-        denom = 243.5 + tc
-        es = 6.112*exp(17.67*tc/denom)
-        alv = alv0 - cpvmcl*(t(i)-273.15)
-        alf = alf0 + clmci*(t(i)-273.15)
-
-        DO j = 1, 4
-          esi = exp(23.33086-(6111.72784/tpk(i))+0.15215*log(tpk(i)))
-          qsat_new = eps*esi/(p(i)-esi*(1.-eps))
-          ! CC        SNEW=
-          ! CPD*(1.-RR(1))+CL*RR(1)+ALV*ALV*QSAT_NEW/(RV*TPK(I)*TPK(I))
-          snew = cpd*(1.-rr(nk)) + cl*rr(nk) + alv*alv*qsat_new/(rv*tpk(i)* &
-            tpk(i))
-
-          snew = 1./snew
-          tpk(i) = tg + (alf*qi(i)+alv*rg*(1.-(esi/es)))*snew
-          ! @$$        PRINT*,'################################'
-          ! @$$        PRINT*,TPK(I)
-          ! @$$        PRINT*,(ALF*QI(I)+ALV*RG*(1.-(ESI/ES)))*SNEW
-        END DO
-        ! CC        CLW(I)=RR(1)-QSAT_NEW
-        clw(i) = rr(nk) - qsat_new
-        clw(i) = max(0.0, clw(i))
-        ! jyg1
-        ! CC        TVP(I)=TPK(I)*(1.+QSAT_NEW/EPS)
-        tvp(i) = tpk(i)*(1.+qsat_new/eps-rr(nk))
-        ! jyg2
-      ELSE
-        CONTINUE
-      END IF
-
-    END DO
-
-  END IF
-
-
-  ! *****************************************************
-  ! * BK :  RAJOUT DE LA TEMPERATURE DES ASCENDANCES
-  ! *   NON DILUES AU  NIVEAU KLEV = ND
-  ! *   POSONS LE ENVIRON EGAL A CELUI DE KLEV-1
-  ! *******************************************************
-
-  tpk(nl+1) = tpk(nl)
-
-  ! ******************************************************
-
-  rg = gravity ! RG redevient la gravite de YOMCST (sb)
-
-
-  RETURN
-END SUBROUTINE tlift
-
-
-
-
-
-
-
-
+link ../phylmd/tlift.F90
Index: LMDZ6/trunk/libf/phylmdiso/tracco2i_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tracco2i_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tracco2i_mod.F90	(revision 3940)
@@ -1,342 +1,1 @@
-MODULE tracco2i_mod
-!
-! This module does the work for the interactive CO2 tracers
-! Authors: Patricia Cadule and Olivier Boucher
-!
-! Purpose and description:
-!  -----------------------
-! Main routine for the interactive carbon cycle
-! Gather all carbon fluxes and emissions from ORCHIDEE, PISCES and fossil fuel
-! Compute the net flux in source field which is used in phytrac
-! Compute global CO2 mixing ratio for radiation scheme if option is activated
-! Redistribute CO2 evenly over the atmosphere if transport is desactivated
-!
-CONTAINS
-
-  SUBROUTINE tracco2i_init()
-    ! This subroutine calls carbon_cycle_init needed to be done before first call to phys_output_write in physiq.
-    USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl
-
-    ! Initialize carbon_cycle_mod
-    IF (carbon_cycle_cpl) THEN
-       CALL carbon_cycle_init()
-    ENDIF
-
-  END SUBROUTINE tracco2i_init
-
-  SUBROUTINE tracco2i(pdtphys, debutphy, &
-       xlat, xlon, pphis, pphi, &
-       t_seri, pplay, paprs, tr_seri, source)
-
-    USE dimphy
-    USE infotrac_phy
-    USE geometry_mod, ONLY: cell_area
-    USE carbon_cycle_mod, ONLY: id_CO2, nbcf_in, fields_in, cfname_in
-    USE carbon_cycle_mod, ONLY: fco2_ocn_day, fco2_ff, fco2_bb, fco2_land, fco2_ocean
-    USE carbon_cycle_mod, ONLY: fco2_land_nbp, fco2_land_nep, fco2_land_fLuc
-    USE carbon_cycle_mod, ONLY: fco2_land_fwoodharvest, fco2_land_fHarvest
-    USE carbon_cycle_mod, ONLY: carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, RCO2_glo, RCO2_tot
-    USE mod_grid_phy_lmdz
-    USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
-    USE mod_phys_lmdz_para, ONLY: gather, bcast, scatter
-    USE phys_cal_mod
-    USE phys_state_var_mod, ONLY: pctsrf
-    USE indice_sol_mod, ONLY: nbsrf, is_ter, is_lic, is_oce, is_sic
-
-    IMPLICIT NONE
-
-    INCLUDE "clesphys.h"
-    INCLUDE "YOMCST.h"
-
-! Input argument
-!---------------
-    REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)
-    LOGICAL,INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
-
-    REAL,DIMENSION(klon),INTENT(IN)        :: xlat    ! latitudes pour chaque point 
-    REAL,DIMENSION(klon),INTENT(IN)        :: xlon    ! longitudes pour chaque point 
-    REAL,DIMENSION(klon),INTENT(IN)        :: pphis   ! geopotentiel du sol
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pphi    ! geopotentiel de chaque couche
-
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
-    REAL,DIMENSION(klon,nbtr),INTENT(INOUT):: source  ! flux de traceur [U/m2/s]
-
-! Output argument
-!----------------
-    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/kgA]  
-
-! Local variables
-!----------------
-
-    INTEGER                        :: it, k, i, nb
-    REAL, DIMENSION(klon,klev)     :: m_air     ! mass of air in every grid box [kg]
-    REAL, DIMENSION(klon_glo,klev) :: co2_glo   ! variable temporaire sur la grille global
-    REAL, DIMENSION(klon_glo,klev) :: m_air_glo ! variable temporaire sur la grille global
-
-    LOGICAL, SAVE :: check_fCO2_nbp_in_cfname
-!$OMP THREADPRIVATE(check_fCO2_nbp_in_cfname)
-    INTEGER, SAVE :: day_pre=-1
-!$OMP THREADPRIVATE(day_pre)
-
-    IF (is_mpi_root) THEN
-      PRINT *,'in tracco2i: date from phys_cal_mod =',year_cur,'-',mth_cur,'-',day_cur,'-',hour
-    ENDIF
-
-!--initialisation of CO2 field if not in restart file
-!--dirty way of doing, do it better later
-!--convert 280 ppm into kg CO2 / kg air
-    IF (debutphy) THEN
-
-! Initialisation de tr_seri(id_CO2) si pas initialise
-      IF (MAXVAL(tr_seri(:,:,id_CO2)).LT.1.e-15) THEN 
-        tr_seri(:,:,id_CO2)=co2_ppm0*1.e-6/RMD*RMCO2 !--initialised from co2_ppm0 in rdem
-      ENDIF 
-
-!--check if fCO2_nbp is in 
-      check_fCO2_nbp_in_cfname=.FALSE.
-      DO nb=1, nbcf_in
-        IF (cfname_in(nb)=="fCO2_nbp") check_fCO2_nbp_in_cfname=.TRUE.
-      ENDDO
-
-    ENDIF
-
-!--calculate mass of air in every grid box in kg air
-    DO i=1, klon
-    DO k=1, klev
-      m_air(i,k)=(paprs(i,k)-paprs(i,k+1))/RG*cell_area(i)
-    ENDDO
-    ENDDO
-
-!--call CO2 emission routine 
-!--co2bb is zero for now
-!--unit kg CO2 m-2 s-1 
-    CALL co2_emissions(debutphy)
-
-!--retrieving land and ocean CO2 flux
-    fco2_land(:)=0.0
-    fco2_ocean(:)=0.0
-    fco2_land_nbp(:)=0.
-    fco2_land_nep(:)=0.
-    fco2_land_fLuc(:)=0.
-    fco2_land_fwoodharvest(:)=0.
-    fco2_land_fHarvest(:)=0.
-
-    DO nb=1, nbcf_in
-
-      SELECT CASE(cfname_in(nb))
-!--dealing with the different fluxes coming from ORCHIDEE
-!--fluxes come in unit of kg C m-2 s-1 is converted into kg CO2 m-2 s-1
-      CASE("fCO2_nep")
-          fco2_land_nep(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
-      CASE("fCO2_fLuc")
-          fco2_land_fLuc(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
-      CASE("fCO2_fwoodharvest")
-          fco2_land_fwoodharvest(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
-      CASE("fCO2_fHarvest")
-          fco2_land_fHarvest(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
-      CASE("fCO2_nbp")
-          fco2_land_nbp(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
-!--fCO2_fco2_ocn comes in unit of mol C02 m-2 s-1 is converted into kg CO2 m-2 s-1 + change sign
-      CASE("fCO2_fgco2") 
-          fco2_ocean(:)=-1.*fco2_ocn_day(:)*RMCO2/1.e3*(pctsrf(:,is_oce)+pctsrf(:,is_sic))
-      END SELECT
-
-    ENDDO
-
-!--if fCO2_nbp is transferred we use it, otherwise we use the sum of what has been passed from ORCHIDEE
-    IF (check_fCO2_nbp_in_cfname)  THEN
-       fco2_land(:)=fco2_land_nbp(:)
-    ELSE
-       fco2_land(:)=fco2_land_nep(:)+fco2_land_fLuc(:)+fco2_land_fwoodharvest(:)+fco2_land_fHarvest(:)
-    ENDIF
-
-!!--preparing the net anthropogenic flux at the surface for mixing layer
-!!--unit kg CO2 / m2 / s
-!    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_ff) ',MAXVAL(fco2_ff)
-!    PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_ff) ',MINVAL(fco2_ff)
-!    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_bb) ',MAXVAL(fco2_bb)
-!    PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_bb) ',MINVAL(fco2_bb)
-!    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_land) ',MAXVAL(fco2_land)
-!    PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_land) ',MINVAL(fco2_land)
-!    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_ocean) ',MAXVAL(fco2_ocean)
-!    PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_ocean) ',MINVAL(fco2_ocean)
-!    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(source(:,id_CO2)) ',MAXVAL(source(:,id_CO2))
-!    PRINT *, 'tracco2i_mod.F90 --- MINVAL(source(:,id_CO2)) ',MINVAL(source(:,id_CO2))
-!
-!--build final source term for CO2
-    source(:,id_CO2)=fco2_ff(:)+fco2_bb(:)+fco2_land(:)+fco2_ocean(:)
-
-!--computing global mean CO2 for radiation
-!--for every timestep comment out the IF ENDIF statements 
-!--otherwise this is updated every day
-    IF (debutphy.OR.day_cur.NE.day_pre) THEN
-
-      CALL gather(tr_seri(:,:,id_CO2),co2_glo)
-      CALL gather(m_air,m_air_glo)
-
-!$OMP MASTER
-
-!--compute a global mean CO2 value and print its value in ppm
-       IF (is_mpi_root) THEN
-         RCO2_tot=SUM(co2_glo*m_air_glo)  !--unit kg CO2
-         RCO2_glo=RCO2_tot/SUM(m_air_glo) !--unit kg CO2 / kg air
-         PRINT *,'tracco2i: global CO2 in ppm =', RCO2_glo*1.e6*RMD/RMCO2
-         PRINT *,'tracco2i: total CO2 in kg =', RCO2_tot
-       ENDIF
-!$OMP END MASTER
-       CALL bcast(RCO2_glo)
-       day_pre=day_cur
-!--if not carbon_cycle_tr, then we reinitialize the CO2 each day to its global mean value
-       IF (.NOT.carbon_cycle_tr) THEN 
-         tr_seri(:,:,id_CO2)=RCO2_glo
-       ENDIF
-    ENDIF
-
-  END SUBROUTINE tracco2i
-
-  SUBROUTINE co2_emissions(debutphy)
-
-    USE dimphy
-    USE infotrac_phy
-    USE geometry_mod, ONLY : cell_area
-    USE mod_grid_phy_lmdz
-    USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
-    USE mod_phys_lmdz_para, ONLY: gather, scatter
-    USE phys_cal_mod
-
-    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_varid, nf95_open
-    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
-
-    USE carbon_cycle_mod, ONLY : fco2_ff, fco2_bb, fco2_land, fco2_ocean
-
-    IMPLICIT NONE
-
-    INCLUDE "YOMCST.h"
-    LOGICAL,INTENT(IN) :: debutphy
-
-! For NetCDF:
-    INTEGER ncid_in  ! IDs for input files
-    INTEGER varid, ncerr
-
-    INTEGER :: n_glo, n_month
-    REAL, POINTER:: vector(:), time(:)
-    REAL,ALLOCATABLE       :: flx_co2ff_glo(:,:) !  fossil-fuel CO2 
-    REAL,ALLOCATABLE       :: flx_co2bb_glo(:,:) !  biomass-burning CO2 
-    REAL,ALLOCATABLE, SAVE :: flx_co2ff(:,:)     !  fossil-fuel CO2 
-    REAL,ALLOCATABLE, SAVE :: flx_co2bb(:,:)     !  biomass-burning CO2 
-!$OMP THREADPRIVATE(flx_co2ff,flx_co2bb)
-
-!! may be controlled via the .def later on
-!! also co2bb for now comes from ORCHIDEE
-    LOGICAL, PARAMETER :: readco2ff=.TRUE.
-!! this should be left to FALSE for now
-    LOGICAL, PARAMETER :: readco2bb=.FALSE. 
-
-    CHARACTER (len = 20) :: modname = 'tracco2i.co2_emissions'
-    CHARACTER (len = 80) :: abort_message
-
-    IF (debutphy) THEN 
-
-    ALLOCATE(flx_co2ff(klon,12))
-    ALLOCATE(flx_co2bb(klon,12))
-
-!$OMP MASTER
-    IF (is_mpi_root) THEN
-    
-      IF (.NOT.ALLOCATED(flx_co2ff_glo)) ALLOCATE(flx_co2ff_glo(klon_glo,12))
-      IF (.NOT.ALLOCATED(flx_co2bb_glo)) ALLOCATE(flx_co2bb_glo(klon_glo,12))
-
-!--reading CO2 fossil fuel emissions
-      IF (readco2ff) THEN 
-
-        ! ... Open the COZff file
-        CALL nf95_open("sflx_lmdz_co2_ff.nc", nf90_nowrite, ncid_in)
-
-        CALL nf95_inq_varid(ncid_in, "vector", varid)
-        CALL nf95_gw_var(ncid_in, varid, vector)
-        n_glo = size(vector)
-        IF (n_glo.NE.klon_glo) THEN
-           abort_message='sflx_lmdz_co2_ff: le nombre de points n est pas egal a klon_glo'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-
-        CALL nf95_inq_varid(ncid_in, "time", varid)
-        CALL nf95_gw_var(ncid_in, varid, time)
-        n_month = size(time)
-        IF (n_month.NE.12) THEN
-           abort_message='sflx_lmdz_co2_ff: le nombre de month n est pas egal a 12'
-           CALL abort_physic(modname,abort_message,1)
-        ENDIF
-
-!--reading flx_co2 for fossil fuel
-        CALL nf95_inq_varid(ncid_in, "flx_co2", varid)
-        ncerr = nf90_get_var(ncid_in, varid, flx_co2ff_glo)
-
-        CALL nf95_close(ncid_in)
-    
-      ELSE  !--co2ff not to be read
-        flx_co2ff_glo(:,:)=0.0
-      ENDIF
-
-!--reading CO2 biomass burning emissions
-!--using it will be inconsistent with treatment in ORCHIDEE
-      IF (readco2bb) THEN 
-
-      ! ... Open the CO2bb file
-      CALL nf95_open("sflx_lmdz_co2_bb.nc", nf90_nowrite, ncid_in)
-
-      CALL nf95_inq_varid(ncid_in, "vector", varid)
-      CALL nf95_gw_var(ncid_in, varid, vector)
-      n_glo = size(vector)
-      IF (n_glo.NE.klon_glo) THEN
-         abort_message='sflx_lmdz_co2_bb: le nombre de points n est pas egal a klon_glo'
-         CALL abort_physic(modname,abort_message,1)
-      ENDIF
-
-      CALL nf95_inq_varid(ncid_in, "time", varid)
-      CALL nf95_gw_var(ncid_in, varid, time)
-      n_month = size(time)
-      IF (n_month.NE.12) THEN
-         abort_message='sflx_lmdz_co2_bb: le nombre de month n est pas egal a 12'
-         CALL abort_physic(modname,abort_message,1)
-      ENDIF
-
-!--reading flx_co2 for biomass burning
-      CALL nf95_inq_varid(ncid_in, "flx_co2", varid)
-      ncerr = nf90_get_var(ncid_in, varid, flx_co2bb_glo)
-
-      CALL nf95_close(ncid_in)
-    
-      ELSE  !--co2bb not to be read
-        flx_co2bb_glo(:,:)=0.0
-      ENDIF
-
-    ENDIF
-!$OMP END MASTER
-
-    ! Allocation needed for all proc otherwise scatter might complain
-    IF (.NOT.ALLOCATED(flx_co2ff_glo)) ALLOCATE(flx_co2ff_glo(0,0))
-    IF (.NOT.ALLOCATED(flx_co2bb_glo)) ALLOCATE(flx_co2bb_glo(0,0))
-
-!--scatter on all proc
-    CALL scatter(flx_co2ff_glo,flx_co2ff)
-    CALL scatter(flx_co2bb_glo,flx_co2bb)
-
-   IF (ALLOCATED(flx_co2ff_glo)) DEALLOCATE(flx_co2ff_glo)
-   IF (ALLOCATED(flx_co2bb_glo)) DEALLOCATE(flx_co2bb_glo)
-
-  ENDIF !--end debuthy
-
-!---select the correct month
-  IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
-    PRINT *,'probleme avec le mois dans co2_ini =', mth_cur
-  ENDIF
-
-  fco2_ff(:) = flx_co2ff(:,mth_cur)
-  fco2_bb(:) = flx_co2bb(:,mth_cur)
-
-  END SUBROUTINE co2_emissions
-
-END MODULE tracco2i_mod
+link ../phylmd/tracco2i_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/tracinca_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tracinca_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tracinca_mod.F90	(revision 3940)
@@ -1,202 +1,1 @@
-!$Id $
-!
-MODULE tracinca_mod
-!
-! This module prepares and calls the INCA main subroutines. 
-!
-  IMPLICIT NONE  
-
-  CHARACTER(len=4),SAVE :: config_inca
-!$OMP THREADPRIVATE(config_inca)
-                     ! config_inca='none' => without INCA
-                     ! config_inca='chem' => INCA with chemistry
-                     ! config_inca='aero' => INCA with aerosols
-CONTAINS
-
-  SUBROUTINE tracinca_init(aerosol,lessivage)
-    ! This subroutine initialize some control varaibles. 
-
-    USE infotrac_phy, ONLY: nbtr
-    USE ioipsl_getin_p_mod, ONLY: getin_p
-    IMPLICIT NONE
-    
-    ! Output variables
-    LOGICAL,DIMENSION(nbtr), INTENT(OUT) :: aerosol
-    LOGICAL,INTENT(OUT) :: lessivage
-    
-    
-    ! Initialization
-    lessivage  =.FALSE.
-    aerosol(:) = .FALSE.
-
-  END SUBROUTINE tracinca_init
-
-  SUBROUTINE tracinca(                                &
-       nstep,    julien,   gmtime,         lafin,     &
-       pdtphys,  t_seri,   paprs,          pplay,     &
-       pmfu,     upwd,     ftsol,  pctsrf, pphis,     &
-       pphi,     albsol,   sh,             ch, rh,    &
-       cldfra,   rneb,     diafra,         cldliq,    &
-       itop_con, ibas_con, pmflxr,         pmflxs,    &
-       prfl,     psfl,     aerosol_couple, flxmass_w, &
-       tau_aero, piz_aero, cg_aero,        ccm,       &
-       rfname,                                        &
-       tr_seri,  source)      
-
-!========================================================
-!    -- CHIMIE INCA --
-!========================================================
-
-    USE dimphy
-    USE infotrac_phy, ONLY: nbtr
-    USE vampir
-    USE indice_sol_mod
-    USE geometry_mod, ONLY: cell_area
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-    USE aero_mod, ONLY : naero_grp
-    IMPLICIT NONE
-    
-!==========================================================================
-!                   -- DESCRIPTION DES ARGUMENTS --
-!==========================================================================
-
-
-! EN ENTREE ...
-!
-!Configuration grille,temps:
-    INTEGER,INTENT(IN) :: nstep      ! Appel physique
-    INTEGER,INTENT(IN) :: julien     ! Jour julien
-    REAL,INTENT(IN)    :: gmtime
-    REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)
-    LOGICAL,INTENT(IN) :: lafin      ! le flag de la fin de la physique
-    
-
-!Physique: 
-!--------
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: ch      ! eau liquide
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: rh      ! humidite relative
-    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pphi    ! geopotentiel
-    REAL,DIMENSION(klon),INTENT(IN)        :: pphis
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: cldliq  ! eau liquide nuageuse
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: cldfra  ! fraction nuageuse (tous les nuages)
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: diafra  ! fraction nuageuse (convection ou stratus artificiels)
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: rneb    ! fraction nuageuse (grande echelle)
-    INTEGER,DIMENSION(klon),INTENT(IN)     :: itop_con
-    INTEGER,DIMENSION(klon),INTENT(IN)     :: ibas_con
-    REAL,DIMENSION(klon),INTENT(IN)        :: albsol  ! albedo surface
-!
-!Convection:
-!----------
-    REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu  ! flux de masse dans le panache montant - Tiedtke
-    REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd  ! flux de masse dans le panache montant - Emanuel
-
-!...Tiedke     
-    REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
-    REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
-
-    LOGICAL,INTENT(IN)                       :: aerosol_couple
-    REAL,DIMENSION(klon,klev),INTENT(IN)     :: flxmass_w
-    REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: tau_aero
-    REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: piz_aero
-    REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: cg_aero
-    CHARACTER(len=4),DIMENSION(naero_grp),INTENT(IN) :: rfname 
-    REAL,DIMENSION(klon,klev,2),INTENT(IN)   :: ccm 
-
-! Arguments necessaires pour les sources et puits de traceur:
-    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol  ! Temperature du sol (surf)(Kelvin)
-    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
-
-
-  ! InOutput argument
-    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]  
-
-  ! Output arguments
-    REAL,DIMENSION(klon,nbtr), INTENT(OUT)        :: source  ! a voir lorsque le flux de surface est prescrit 
-
-!=======================================================================================
-!                        -- VARIABLES LOCALES TRACEURS --
-!=======================================================================================
-
-    INTEGER :: k
-    REAL,DIMENSION(klon,klev) :: pdel
-    REAL,DIMENSION(klon,klev) :: zpmfu  ! flux de masse dans le panache montant
-    REAL    :: calday
-    INTEGER :: ncsec
-
-    CALL VTe(VTphysiq)
-    CALL VTb(VTinca)
-    
-    calday = REAL(julien) + gmtime
-    ncsec  = NINT (86400.*gmtime)
-     
-    DO k = 1, klev
-       pdel(:,k) = paprs(:,k) - paprs (:,k+1)
-    END DO
-  
-#ifdef INCA
-    IF (config_inca == 'aero' .OR. config_inca == 'chem') THEN 
-       zpmfu(:,:)=pmfu(:,:)       
-    ELSE IF (config_inca == 'aeNP') THEN
-       zpmfu(:,:)=upwd(:,:)
-    ENDIF
-
-    CALL aerosolmain(                    &
-         aerosol_couple,tr_seri,pdtphys, &
-         pplay,pdel,prfl,pmflxr,psfl,    &
-         pmflxs,zpmfu,itop_con,ibas_con,  &
-         pphi,cell_area,nstep,rneb,t_seri, &      
-         rh,tau_aero,piz_aero,cg_aero,   &
-         rfname,ccm,lafin)
-#endif
-
-
-#ifdef INCA
-    CALL chemmain (tr_seri, &   !mmr
-         nstep,      & !nstep
-         calday,     & !calday
-         julien,     & !ncdate
-         ncsec,      & !ncsec
-         1,          & !lat
-         pdtphys,    & !delt
-         paprs(1,1), & !ps
-         pplay,      & !pmid
-         pdel,       & !pdel
-         cell_area,  &
-         pctsrf(1,1),& !oro
-         ftsol,      & !tsurf
-         albsol,     & !albs
-         pphi,       & !zma
-         pphis,      & !phis
-         cldfra,     & !cldfr
-         rneb,       & !cldfr_st
-         diafra,     & !cldfr_cv
-         itop_con,   & !cldtop
-         ibas_con,   & !cldbot
-         cldliq,     & !cwat
-         prfl,       & !flxrst
-         pmflxr,     & !flxrcv
-         psfl,       & !flxsst
-         pmflxs,     & !flxscv
-         zpmfu,      & !flxupd   !--now depends on whether AP or NP
-         flxmass_w,  & !flxmass_w
-         t_seri,     & !tfld
-         sh,         & !sh
-         ch,         & !ql
-         rh,         & !rh
-         nbp_lon,    & !nx
-         nbp_lat,    & !ny
-         source )
-#endif
-    
-    CALL VTe(VTinca)
-    CALL VTb(VTphysiq)
-    
-    
-  END SUBROUTINE tracinca
-
-
-END MODULE tracinca_mod
+link ../phylmd/tracinca_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/traclmdz_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/traclmdz_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/traclmdz_mod.F90	(revision 3940)
@@ -1,628 +1,1 @@
-!$Id $
-!
-MODULE traclmdz_mod
-
-! 
-! In this module all tracers specific to LMDZ are treated. This module is used 
-! only if running without any other chemestry model as INCA or REPROBUS.  
-!
-  IMPLICIT NONE
-
-  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: masktr   ! Masque reservoir de sol traceur
-!$OMP THREADPRIVATE(masktr)                        ! Masque de l'echange avec la surface (1 = reservoir) ou (possible >= 1 )
-  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: fshtr    ! Flux surfacique dans le reservoir de sol
-!$OMP THREADPRIVATE(fshtr)
-  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: hsoltr   ! Epaisseur equivalente du reservoir de sol
-!$OMP THREADPRIVATE(hsoltr)
-!
-!Radioelements:
-!--------------
-!
-  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: tautr    ! Constante de decroissance radioactive
-!$OMP THREADPRIVATE(tautr)
-  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: vdeptr   ! Vitesse de depot sec dans la couche Brownienne
-!$OMP THREADPRIVATE(vdeptr)
-  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: scavtr   ! Coefficient de lessivage
-!$OMP THREADPRIVATE(scavtr)
-  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: srcbe    ! Production du beryllium7 dans l atmosphere (U/s/kgA)
-!$OMP THREADPRIVATE(srcbe)
-
-  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: radio    ! radio(it)   = true  => decroisssance radioactive
-!$OMP THREADPRIVATE(radio)  
-
-  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: trs     ! Conc. radon ds le sol
-!$OMP THREADPRIVATE(trs)
-
-  INTEGER,SAVE :: id_aga      ! Identification number for tracer : Age of stratospheric air
-!$OMP THREADPRIVATE(id_aga)
-  INTEGER,SAVE :: lev_1p5km   ! Approximative vertical layer number at 1.5km above surface, used for calculation of the age of air. The result shouldn't be that sensible to the exactness of this value as long as it is in the lower troposphere. 
-!$OMP THREADPRIVATE(lev_1p5km)
-
-  INTEGER,SAVE :: id_rn, id_pb ! Identification number for tracer : radon (Rn222), lead (Pb210)
-!$OMP THREADPRIVATE(id_rn, id_pb)
-
-  INTEGER,SAVE :: id_be       ! Activation et position du traceur Be7 [ id_be=0 -> desactive ] 
-!$OMP THREADPRIVATE(id_be)
-
-  INTEGER,SAVE :: id_pcsat, id_pcocsat, id_pcq ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
-!$OMP THREADPRIVATE(id_pcsat, id_pcocsat, id_pcq)
-  INTEGER,SAVE :: id_pcs0, id_pcos0, id_pcq0   ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
-!                                              ! qui ne sont pas transportes par la convection
-!$OMP THREADPRIVATE(id_pcs0, id_pcos0, id_pcq0)
-
-  INTEGER, SAVE:: id_o3
-!$OMP THREADPRIVATE(id_o3)
-! index of ozone tracer with Cariolle parameterization
-! 0 means no ozone tracer
-
-  LOGICAL,SAVE :: rnpb=.FALSE. ! Presence du couple Rn222, Pb210
-!$OMP THREADPRIVATE(rnpb)
-
-
-CONTAINS
-
-  SUBROUTINE traclmdz_from_restart(trs_in)
-    ! This subroutine initialize the module saved variable trs with values from restart file (startphy.nc). 
-    ! This subroutine is called from phyetat0 after the field trs_in has been read.
-    
-    USE dimphy
-    USE infotrac_phy
-    
-    ! Input argument
-    REAL,DIMENSION(klon,nbtr), INTENT(IN) :: trs_in 
-    
-    ! Local variables
-    INTEGER :: ierr
-    
-    ! Allocate restart variables trs
-    ALLOCATE( trs(klon,nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_from_restart', 'pb in allocation 1',1)
-    
-    ! Initialize trs with values read from restart file 
-    trs(:,:) = trs_in(:,:)
-    
-  END SUBROUTINE traclmdz_from_restart
-
-
-  SUBROUTINE traclmdz_init(pctsrf, xlat, xlon, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
-    ! This subroutine allocates and initialize module variables and control variables.
-    ! Initialization of the tracers should be done here only for those not found in the restart file.
-    USE dimphy
-    USE infotrac_phy
-    USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz
-    USE press_coefoz_m, ONLY: press_coefoz
-    USE mod_grid_phy_lmdz
-    USE mod_phys_lmdz_para
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: lunout
-
-! Input variables
-    REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: pctsrf ! Pourcentage de sol f(nature du sol)
-    REAL,DIMENSION(klon),INTENT(IN)           :: xlat   ! latitudes en degres pour chaque point 
-    REAL,DIMENSION(klon),INTENT(IN)           :: xlon   ! longitudes en degres pour chaque point 
-    REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: ftsol  ! Temperature du sol (surf)(Kelvin)
-    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri! Concentration Traceur [U/KgA]  
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
-    REAL,INTENT(IN)                        :: pdtphys ! Pas d'integration pour la physique (seconde)  
-
-! Output variables
-    LOGICAL,DIMENSION(nbtr), INTENT(OUT) :: aerosol
-    LOGICAL,INTENT(OUT)                  :: lessivage
-        
-! Local variables    
-    INTEGER :: ierr, it, iiq, i, k
-    REAL, DIMENSION(klon_glo,klev) :: varglo ! variable temporaire sur la grille global    
-    REAL, DIMENSION(klev)          :: mintmp, maxtmp
-    LOGICAL                        :: zero
-! RomP >>> profil initial Be7
-      integer ilesfil
-      parameter (ilesfil=1)
-      integer  irr,kradio
-      real     beryllium(klon,klev)
-! profil initial Pb210
-      integer ilesfil2
-      parameter (ilesfil2=1)
-      integer  irr2,kradio2
-      real     plomb(klon,klev)
-!! RomP <<<
-! --------------------------------------------
-! Allocation
-! --------------------------------------------
-    ALLOCATE( scavtr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 9',1)
-    scavtr(:)=1.
-    
-    ALLOCATE( radio(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 11',1)
-    radio(:) = .false.    ! Par defaut pas decroissance radioactive
-    
-    ALLOCATE( masktr(klon,nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 2',1)
-    
-    ALLOCATE( fshtr(klon,nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 3',1)
-    
-    ALLOCATE( hsoltr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 4',1)
-    
-    ALLOCATE( tautr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 5',1)
-    tautr(:)  = 0.
-    
-    ALLOCATE( vdeptr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 6',1)
-    vdeptr(:) = 0.
-
-
-    lessivage  = .TRUE.
-!!jyg(20130206) : le choix d activation du lessivage est fait dans phytrac avec iflag_lscav
-!!    call getin('lessivage',lessivage)
-!!    if(lessivage) then
-!!     print*,'lessivage lsc ON'
-!!    else
-!!     print*,'lessivage lsc OFF'
-!!    endif
-    aerosol(:) = .FALSE.  ! Tous les traceurs sont des gaz par defaut
-    
-!
-! Recherche des traceurs connus : Be7, O3, CO2,...
-! --------------------------------------------
-    id_rn=0; id_pb=0; id_aga=0; id_be=0; id_o3=0
-    id_pcsat=0; id_pcocsat=0; id_pcq=0; id_pcs0=0; id_pcos0=0; id_pcq0=0
-    DO it=1,nbtr
-!!       iiq=niadv(it+2)                                                            ! jyg
-       iiq=niadv(it+nqo)                                                            ! jyg
-       IF ( tname(iiq) == "RN" ) THEN                                               
-          id_rn=it ! radon
-       ELSE IF ( tname(iiq) == "PB") THEN
-          id_pb=it ! plomb
-! RomP >>> profil initial de PB210 
-     open (ilesfil2,file='prof.pb210',status='old',iostat=irr2)
-     IF (irr2 == 0) THEN 
-      read(ilesfil2,*) kradio2
-      print*,'number of levels for pb210 profile ',kradio2
-      do k=kradio2,1,-1
-       read (ilesfil2,*) plomb(:,k)
-      enddo
-      close(ilesfil2)
-      do k=1,klev
-       do i=1,klon
-         tr_seri(i,k,id_pb)=plomb(i,k)
-!!        print*, 'tr_seri',i,k,tr_seri(i,k,id_pb)
-        enddo
-      enddo
-     ELSE
-       print *, 'Prof.pb210 does not exist: use restart values'
-     ENDIF
-! RomP <<<
-       ELSE IF ( tname(iiq) == "Aga" .OR. tname(iiq) == "AGA" ) THEN
-          ! Age of stratospheric air
-          id_aga=it
-          radio(id_aga) = .FALSE.
-          aerosol(id_aga) = .FALSE.
-          pbl_flg(id_aga) = 0 
-          
-          ! Find the first model layer above 1.5km from the surface
-          IF (klev>=30) THEN
-             lev_1p5km=6   ! NB! This value is for klev=39
-          ELSE IF (klev>=10) THEN
-             lev_1p5km=5   ! NB! This value is for klev=19
-          ELSE
-             lev_1p5km=klev/2
-          END IF
-       ELSE IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR.  &
-            tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN  
-          ! Recherche du Beryllium 7
-          id_be=it
-          ALLOCATE( srcbe(klon,klev) )
-          radio(id_be) = .TRUE.
-          aerosol(id_be) = .TRUE. ! le Be est un aerosol
-!jyg le 13/03/2013 ; ajout de pplay en argument de init_be
-!!!          CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
-          CALL init_be(pctsrf,pplay,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
-          WRITE(lunout,*) 'Initialisation srcBe: OK'
-! RomP >>> profil initial de Be7
-      open (ilesfil,file='prof.be7',status='old',iostat=irr)
-      IF (irr == 0) THEN 
-       read(ilesfil,*) kradio
-       print*,'number of levels for Be7 profile ',kradio
-       do k=kradio,1,-1
-        read (ilesfil,*) beryllium(:,k)
-       enddo
-       close(ilesfil)
-       do k=1,klev
-         do i=1,klon
-          tr_seri(i,k,id_be)=beryllium(i,k)
-!!        print*, 'tr_seri',i,k,tr_seri(i,k,id_be)
-         enddo
-       enddo
-     ELSE
-       print *, 'Prof.Be7 does not exist: use restart values'
-     ENDIF
-! RomP <<<
-       ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN
-          ! Recherche de l'ozone : parametrization de la chimie par Cariolle
-          id_o3=it
-          CALL alloc_coefoz   ! allocate ozone coefficients
-          CALL press_coefoz   ! read input pressure levels
-       ELSE IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN
-          id_pcsat=it
-       ELSE IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN
-          id_pcocsat=it
-       ELSE IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN
-          id_pcq=it
-       ELSE IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN
-          id_pcs0=it
-          conv_flg(it)=0 ! No transport by convection for this tracer
-       ELSE IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN
-          id_pcos0=it
-          conv_flg(it)=0 ! No transport by convection for this tracer
-       ELSE IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN
-          id_pcq0=it
-          conv_flg(it)=0 ! No transport by convection for this tracer
-       ELSE
-          WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tname(iiq))
-       END IF
-    END DO
-
-!
-! Valeurs specifiques pour les traceurs Rn222 et Pb210
-! ----------------------------------------------
-    IF ( id_rn/=0 .AND. id_pb/=0 ) THEN
-       rnpb = .TRUE.
-       radio(id_rn)= .TRUE.
-       radio(id_pb)= .TRUE.
-       pbl_flg(id_rn) = 0 ! au lieu de clsol=true ! CL au sol calcule
-       pbl_flg(id_pb) = 0 ! au lieu de clsol=true
-       aerosol(id_rn) = .FALSE.
-       aerosol(id_pb) = .TRUE. ! le Pb est un aerosol
-       
-       CALL initrrnpb (ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
-    END IF
-
-!
-! Check if all tracers have restart values
-! ----------------------------------------------
-    DO it=1,nbtr
-!!       iiq=niadv(it+2)                                                            ! jyg
-       iiq=niadv(it+nqo)                                                            ! jyg
-       ! Test if tracer is zero everywhere. 
-       ! Done by master process MPI and master thread OpenMP
-       CALL gather(tr_seri(:,:,it),varglo)
-       IF (is_mpi_root .AND. is_omp_root) THEN
-          mintmp=MINVAL(varglo,dim=1)
-          maxtmp=MAXVAL(varglo,dim=1)
-          IF (MINVAL(mintmp,dim=1)==0. .AND. MAXVAL(maxtmp,dim=1)==0.) THEN
-             ! Tracer is zero everywhere
-             zero=.TRUE.
-          ELSE
-             zero=.FALSE.
-          END IF
-       END IF
-
-       ! Distribute variable at all processes
-       CALL bcast(zero)
-
-       ! Initalize tracer that was not found in restart file.
-       IF (zero) THEN
-          ! The tracer was not found in restart file or it was equal zero everywhere.
-          WRITE(lunout,*) "The tracer ",trim(tname(iiq))," will be initialized"
-          IF (it==id_pcsat .OR. it==id_pcq .OR. &
-               it==id_pcs0 .OR. it==id_pcq0) THEN
-             tr_seri(:,:,it) = 100.
-          ELSE IF (it==id_pcocsat .OR. it==id_pcos0) THEN
-             DO i = 1, klon
-                IF ( pctsrf (i, is_oce) == 0. ) THEN
-                   tr_seri(i,:,it) = 0.
-                ELSE
-                   tr_seri(i,:,it) = 100.
-                END IF
-             END DO
-          ELSE
-             ! No specific initialization exist for this tracer
-             tr_seri(:,:,it) = 0.
-          END IF
-       END IF
-    END DO
-
-  END SUBROUTINE traclmdz_init
-
-  SUBROUTINE traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
-       cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, &
-       rh, pphi, ustar, wstar, ale_bl, ale_wake,  zu10m, zv10m, &
-       tr_seri, source, d_tr_cl,d_tr_dec, zmasse)               !RomP
-    
-    USE dimphy
-    USE infotrac_phy
-    USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz
-    USE o3_chem_m, ONLY: o3_chem
-    USE indice_sol_mod
-
-    INCLUDE "YOMCST.h"
-
-!==========================================================================
-!                   -- DESCRIPTION DES ARGUMENTS --
-!==========================================================================
-
-! Input arguments
-!
-!Configuration grille,temps:
-    INTEGER,INTENT(IN) :: nstep      ! nombre d'appels de la physiq
-    INTEGER,INTENT(IN) :: julien     ! Jour julien
-    REAL,INTENT(IN)    :: gmtime
-    REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)  
-    REAL,DIMENSION(klon),INTENT(IN) :: xlat    ! latitudes pour chaque point 
-    REAL, INTENT(IN):: xlon(:) ! dim(klon) longitude
-
-!
-!Physique: 
-!--------
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-    REAL,intent(in):: zmasse (:, :)   ! dim(klon,klev) density of air, in kg/m2
-
-
-!Couche limite:
-!--------------
-!
-    REAL,DIMENSION(klon),INTENT(IN)      :: cdragh     ! coeff drag pour T et Q
-    REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh      ! coeff melange CL (m**2/s)
-    REAL,DIMENSION(klon),INTENT(IN)      :: yu1        ! vents au premier niveau
-    REAL,DIMENSION(klon),INTENT(IN)      :: yv1        ! vents au premier niveau
-    LOGICAL,INTENT(IN)                   :: couchelimite
-    REAL,DIMENSION(klon,klev),INTENT(IN) :: sh         ! humidite specifique
-    REAL,DIMENSION(klon,klev),INTENT(IN) :: rh      ! Humidite relative
-    REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi    ! geopotentie
-    REAL,DIMENSION(klon),INTENT(IN)      :: ustar   ! ustar (m/s)
-    REAL,DIMENSION(klon),INTENT(IN)      :: wstar,ale_bl,ale_wake   ! wstar (m/s) and Avail. Lifti. Energ.
-    REAL,DIMENSION(klon),INTENT(IN)      :: zu10m   ! vent zonal 10m (m/s)
-    REAL,DIMENSION(klon),INTENT(IN)      :: zv10m   ! vent zonal 10m (m/s)
-
-! Arguments necessaires pour les sources et puits de traceur:
-    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol  ! Temperature du sol (surf)(Kelvin)
-    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
-
-! InOutput argument
-    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA]  
-
-! Output argument
-    REAL,DIMENSION(klon,nbtr), INTENT(OUT)        :: source  ! a voir lorsque le flux de surface est prescrit 
-    REAL,DIMENSION(klon,klev,nbtr), INTENT(OUT)   :: d_tr_cl ! Td couche limite/traceur
-
-!=======================================================================================
-!                        -- VARIABLES LOCALES TRACEURS --
-!=======================================================================================
-
-    INTEGER :: i, k, it
-    INTEGER :: lmt_pas ! number of time steps of "physics" per day
-
-    REAL,DIMENSION(klon)           :: d_trs    ! Td dans le reservoir
-    REAL,DIMENSION(klon,klev)      :: qsat     ! pression de la vapeur a saturation
-    REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec ! Td radioactive
-    REAL                           :: zrho     ! Masse Volumique de l'air KgA/m3
-    REAL                           :: amn, amx
-!
-!=================================================================
-!  Ajout de la production en  Be7 (Beryllium) srcbe U/s/kgA
-!=================================================================
-!
-    IF ( id_be /= 0 ) THEN
-       DO k = 1, klev
-          DO i = 1, klon
-             tr_seri(i,k,id_be) = tr_seri(i,k,id_be)+srcbe(i,k)*pdtphys
-          END DO
-       END DO
-       WRITE(*,*) 'Ajout srcBe dans tr_seri: OK'
-    END IF
-  
-
-!=================================================================
-! Update pseudo-vapor tracers 
-!=================================================================
-
-    CALL q_sat(klon*klev,t_seri,pplay,qsat)
-
-    IF ( id_pcsat /= 0 ) THEN
-     DO k = 1, klev
-      DO i = 1, klon
-         IF ( pplay(i,k).GE.85000.) THEN
-            tr_seri(i,k,id_pcsat) = qsat(i,k)
-         ELSE
-            tr_seri(i,k,id_pcsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcsat))            
-         END IF
-      END DO 
-     END DO
-    END IF
-
-    IF ( id_pcocsat /= 0 ) THEN
-     DO k = 1, klev
-      DO i = 1, klon
-         IF ( pplay(i,k).GE.85000.) THEN
-            IF ( pctsrf (i, is_oce) > 0. ) THEN
-               tr_seri(i,k,id_pcocsat) = qsat(i,k)
-            ELSE
-               tr_seri(i,k,id_pcocsat) = 0.
-          END IF
-       ELSE 
-          tr_seri(i,k,id_pcocsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcocsat))
-       END IF
-      END DO
-     END DO
-    END IF
-
-    IF ( id_pcq /= 0 ) THEN
-     DO k = 1, klev
-      DO i = 1, klon
-         IF ( pplay(i,k).GE.85000.) THEN
-            tr_seri(i,k,id_pcq) = sh(i,k)
-         ELSE
-            tr_seri(i,k,id_pcq) = MIN (qsat(i,k), tr_seri(i,k,id_pcq))    
-         END IF
-      END DO
-     END DO
-    END IF
-
-
-    IF ( id_pcs0 /= 0 ) THEN
-     DO k = 1, klev
-      DO i = 1, klon
-         IF ( pplay(i,k).GE.85000.) THEN
-            tr_seri(i,k,id_pcs0) = qsat(i,k)
-         ELSE
-            tr_seri(i,k,id_pcs0) = MIN (qsat(i,k), tr_seri(i,k,id_pcs0))    
-         END IF
-      END DO
-     END DO
-    END IF
-
-
-    IF ( id_pcos0 /= 0 ) THEN
-     DO k = 1, klev
-      DO i = 1, klon
-         IF ( pplay(i,k).GE.85000.) THEN
-            IF ( pctsrf (i, is_oce) > 0. ) THEN
-               tr_seri(i,k,id_pcos0) = qsat(i,k)
-            ELSE
-               tr_seri(i,k,id_pcos0) = 0.
-            END IF
-         ELSE
-            tr_seri(i,k,id_pcos0) = MIN (qsat(i,k), tr_seri(i,k,id_pcos0))
-         END IF
-      END DO
-     END DO
-    END IF
-
-
-    IF ( id_pcq0 /= 0 ) THEN
-     DO k = 1, klev
-      DO i = 1, klon
-         IF ( pplay(i,k).GE.85000.) THEN
-            tr_seri(i,k,id_pcq0) = sh(i,k)
-         ELSE 
-            tr_seri(i,k,id_pcq0) = MIN (qsat(i,k), tr_seri(i,k,id_pcq0))
-         END IF
-      END DO
-     END DO
-    END IF
-
-!=================================================================
-! Update tracer : Age of stratospheric air 
-!=================================================================
-    IF (id_aga/=0) THEN
-       
-       ! Bottom layers
-       DO k = 1, lev_1p5km
-          tr_seri(:,k,id_aga) = 0.0
-       END DO
-       
-       ! Layers above 1.5km
-       DO k = lev_1p5km+1,klev-1
-          tr_seri(:,k,id_aga) = tr_seri(:,k,id_aga) + pdtphys
-       END DO
-       
-       ! Top layer
-       tr_seri(:,klev,id_aga) = tr_seri(:,klev-1,id_aga)
-       
-    END IF
-
-!======================================================================
-!     -- Calcul de l'effet de la couche limite --
-!======================================================================
-
-    IF (couchelimite) THEN             
-       source(:,:) = 0.0
-
-       IF (id_be /=0) THEN
-          DO i=1, klon
-             zrho = pplay(i,1)/t_seri(i,1)/RD
-             source(i,id_be) = - vdeptr(id_be)*tr_seri(i,1,id_be)*zrho
-          END DO
-       END IF
-
-    END IF
-    
-    DO it=1, nbtr
-       IF (couchelimite .AND. pbl_flg(it) == 0 .AND. (it==id_rn .OR. it==id_pb)) THEN 
-          ! couche limite avec quantite dans le sol calculee
-          CALL cltracrn(it, pdtphys, yu1, yv1,     &
-               cdragh, coefh,t_seri,ftsol,pctsrf,  &
-               tr_seri(:,:,it),trs(:,it),          &
-               paprs, pplay, zmasse * rg, &
-               masktr(:,it),fshtr(:,it),hsoltr(it),&
-               tautr(it),vdeptr(it),               &
-               xlat,d_tr_cl(:,:,it),d_trs)
-          
-          DO k = 1, klev
-             DO i = 1, klon
-                tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
-             END DO
-          END DO
-        
-          ! Traceur dans le reservoir sol
-          DO i = 1, klon
-             trs(i,it) = trs(i,it) + d_trs(i)
-          END DO
-       END IF
-    END DO
-          
-
-!======================================================================
-!   Calcul de l'effet du puits radioactif
-!======================================================================
-    CALL radio_decay (radio,rnpb,pdtphys,tautr,tr_seri,d_tr_dec)
-
-    DO it=1,nbtr
-       WRITE(solsym(it),'(i2)') it
-    END DO
-
-    DO it=1,nbtr
-       IF(radio(it)) then     
-          DO k = 1, klev
-             DO i = 1, klon
-                tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_dec(i,k,it)
-             END DO
-          END DO
-          CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='//solsym(it))
-       END IF
-    END DO
-
-!======================================================================
-!   Parameterization of ozone chemistry
-!======================================================================
-
-    IF (id_o3 /= 0) then
-       lmt_pas = NINT(86400./pdtphys)
-       IF (MOD(nstep - 1, lmt_pas) == 0) THEN
-          ! Once per day, update the coefficients for ozone chemistry:
-          CALL regr_pr_comb_coefoz(julien, xlat, paprs, pplay)
-       END IF
-       CALL o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, xlat, &
-            xlon, tr_seri(:, :, id_o3))
-    END IF
-
-  END SUBROUTINE traclmdz
-
-
-  SUBROUTINE traclmdz_to_restart(trs_out)
-    ! This subroutine is called from phyredem.F where the module 
-    ! variable trs is written to restart file (restartphy.nc)
-    USE dimphy
-    USE infotrac_phy
-    
-    REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
-    INTEGER :: ierr
-
-    IF ( ALLOCATED(trs) ) THEN
-       trs_out(:,:) = trs(:,:)
-    ELSE
-       ! No previous allocate of trs. This is the case for create_etat0_limit.
-       trs_out(:,:) = 0.0
-    END IF
-    
-  END SUBROUTINE traclmdz_to_restart
-  
-
-END MODULE traclmdz_mod
+link ../phylmd/traclmdz_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/tracreprobus_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tracreprobus_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tracreprobus_mod.F90	(revision 3940)
@@ -1,130 +1,1 @@
-MODULE tracreprobus_mod
-!
-! This module prepares and calls the Reprobus main subroutine 
-!
-
-CONTAINS
-
-  SUBROUTINE tracreprobus(pdtphys, gmtime, debutphy, julien, &
-       presnivs, xlat, xlon, pphis, pphi, &
-       t_seri, pplay, paprs, sh , &
-       tr_seri)
-
-    USE dimphy
-    USE infotrac_phy
-#ifdef REPROBUS 
-    USE CHEM_REP, ONLY : pdt_rep, &  ! pas de temps reprobus
-         daynum, iter, &             ! jourjulien, iteration chimie
-         pdel,&
-         d_q_rep,d_ql_rep,d_qi_rep
-#endif
-    IMPLICIT NONE
-
-! Input argument
-!---------------
-    REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)
-    REAL,INTENT(IN)    :: gmtime     ! Heure courante
-    LOGICAL,INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
-    INTEGER,INTENT(IN) :: julien     ! Jour julien
-
-    REAL,DIMENSION(klev),INTENT(IN)        :: presnivs! pressions approximat. des milieux couches (en PA)
-    REAL,DIMENSION(klon),INTENT(IN)        :: xlat    ! latitudes pour chaque point 
-    REAL,DIMENSION(klon),INTENT(IN)        :: xlon    ! longitudes pour chaque point 
-    REAL,DIMENSION(klon),INTENT(IN)        :: pphis   ! geopotentiel du sol
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pphi    ! geopotentiel de chaque couche
-
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique   
-
-
-! Output argument
-!----------------
-    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA]  
-  
-
-! Local variables
-!----------------
-    INTEGER :: it, k, niter
-
-#ifdef REPROBUS
-    !   -- CHIMIE REPROBUS --
-!    pdt_rep=pdtphys/2.
-    niter=pdtphys/pdt_rep
-    write(*,*)'nb d appel de REPROBUS',niter
-    
-    DO k = 1, klev
-       pdel(:,k) = paprs(:,k) - paprs (:,k+1)
-    END DO
-    
-    ! initialisation de ozone passif a ozone en debut d hiver HN et HS
-    IF (julien == 341 .OR. julien == 181) THEN
-       tr_seri(:,:,11)=tr_seri(:,:,8)
-    END IF
-
-    d_q_rep(:,:)  =0.
-    d_ql_rep(:,:) =0.
-    d_qi_rep(:,:) =0.
-    
-    DO  iter = 1,niter
-       daynum = FLOAT(julien) + gmtime + (iter-1)*pdt_rep/86400.
-       
-!       DO it=1, nbtr
-!     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
-! seulement pour les especes chimiques (pas l'age de l'air)
-! verif valeurs extremes
-! correction: a 1.e-30 quand =0 ou negatif et
-! call abort si >ou= 1.e10
-!          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
-!          IF (it < nqtot) THEN
-!             WRITE(*,*)'iciav',it,nqtot
-!#ifdef REPROBUS
-!             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'avant chimie ')
-!#endif
-!             WRITE(*,*)iter,'avpres'
-!          ENDIF
-!       ENDDO
-       
-#ifdef REPROBUS
-       CALL chemmain_rlong_1401( &
-            tr_seri, & !argument phytrac (change de nom apres: vmr)
-            xlon,    & !argument phytrac (change de nom apres: lon)
-            xlat,    & !argument phytrac (change de nom apres: lat)
-            t_seri,  & !argument phytrac (meme nom)
-            pplay,   & !argument phytrac (meme nom)
-            pphi,    & !argument phytrac (meme nom)
-            pphis,   & !argument phytrac (meme nom)
-            presnivs, & !argument phytrac (meme nom)
-            sh,      & !argument phytrac (meme nom)
-            debutphy) !argument phytrac (change de nom apres: debut)
-       ! pdel, pdt_rep, daynum : definit dans phytrac et utilise dans chemmain
-       !                 et transporte par CHEM_REP
-
-!       DO it=1, nbtr
-!     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
-! seulement pour les especes chimiques (pas l'age de l'air)
-! verif valeurs extremes
-! correction: a 1.e-30 quand =0 ou negatif et
-! call abort si >ou= 1.e10
-!          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
-!          IF (it < nqtot) THEN
-!             WRITE(*,*)'iciap',it,nqtot
-!             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'apres chemmain')
-!             WRITE(*,*)iter,'appres'
-!          ENDIF
-!       ENDDO
-
-#endif        
-       
-    END DO
-    
-
-    ! 
-    DO it=1,nbtr
-       WRITE(solsym(it),'(i2)') it
-    END DO
-#endif
-  END SUBROUTINE tracreprobus
-
-END MODULE tracreprobus_mod
+link ../phylmd/tracreprobus_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/transp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/transp.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/transp.F90	(revision 3940)
@@ -1,52 +1,1 @@
-
-! $Id: transp.F90 3257 2018-03-13 13:41:20Z fairhead $
-
-SUBROUTINE transp(paprs, tsol, t, q, ql, qs, u, v, geom, vtran_e, vtran_q, utran_e, &
-    utran_q, vtran_w, utran_w)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X.Li (LMD/CNRS)
-  ! Date: le 25 avril 1994
-  ! Objet: Calculer le transport de l'energie et de la vapeur d'eau
-  ! ======================================================================
-
-  include "YOMCST.h"
-
-  REAL paprs(klon, klev+1), tsol(klon)
-  REAL t(klon, klev), q(klon, klev), ql(klon, klev), qs(klon, klev)
-  REAL u(klon, klev), v(klon, klev)
-  REAL utran_e(klon), utran_q(klon), vtran_e(klon), vtran_q(klon)
-  REAL utran_w(klon), vtran_w(klon)
-
-  INTEGER i, l
-  ! ------------------------------------------------------------------
-  REAL geom(klon, klev), e
-  ! ------------------------------------------------------------------
-  DO i = 1, klon
-    utran_e(i) = 0.0
-    utran_q(i) = 0.0
-    vtran_e(i) = 0.0
-    vtran_q(i) = 0.0
-    utran_w(i) = 0.0
-    vtran_w(i) = 0.0
-  END DO
-
-  DO l = 1, klev
-    DO i = 1, klon
-!      e = rcpd*t(i, l) + rlvtt*q(i, l) + geom(i, l)
-      e = rcpd*t(i, l) + geom(i, l)
-      utran_e(i) = utran_e(i) + u(i, l)*e*(paprs(i,l)-paprs(i,l+1))/rg
-      utran_q(i) = utran_q(i) + u(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1))/rg
-      utran_w(i) = utran_w(i) + u(i, l)*(q(i, l)+ql(i, l)+qs(i, l))           &
-                                       *(paprs(i,l)-paprs(i,l+1))/rg
-      vtran_e(i) = vtran_e(i) + v(i, l)*e*(paprs(i,l)-paprs(i,l+1))/rg
-      vtran_q(i) = vtran_q(i) + v(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1))/rg
-      vtran_w(i) = vtran_w(i) + v(i, l)*(q(i, l)+ql(i, l)+qs(i, l))           &
-                                       *(paprs(i,l)-paprs(i,l+1))/rg
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE transp
+link ../phylmd/transp.F90
Index: LMDZ6/trunk/libf/phylmdiso/transp_lay.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/transp_lay.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/transp_lay.F90	(revision 3940)
@@ -1,50 +1,1 @@
-
-! $Header$
-
-SUBROUTINE transp_lay(paprs, tsol, t, q, u, v, geom, vtran_e, vtran_q, &
-    utran_e, utran_q)
-
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X.Li (LMD/CNRS)
-  ! Date: le 25 avril 1994
-  ! Objet: Calculer le transport de l'energie et de la vapeur d'eau
-  ! ======================================================================
-
-  include "YOMCST.h"
-
-  REAL paprs(klon, klev+1), tsol(klon)
-  REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
-  REAL utran_e(klon, klev), utran_q(klon, klev)
-  REAL vtran_e(klon, klev), vtran_q(klon, klev)
-
-  INTEGER i, l
-  ! ------------------------------------------------------------------
-  REAL geom(klon, klev), esh
-  ! ------------------------------------------------------------------
-  DO l = 1, klev
-    DO i = 1, klon
-      utran_e(i, l) = 0.0
-      utran_q(i, l) = 0.0
-      vtran_e(i, l) = 0.0
-      vtran_q(i, l) = 0.0
-    END DO
-  END DO
-
-  DO l = 1, klev
-    DO i = 1, klon
-      esh = rcpd*t(i, l) + rlvtt*q(i, l) + geom(i, l)
-      utran_e(i, l) = utran_e(i, l) + u(i, l)*esh*(paprs(i,l)-paprs(i,l+1))/ &
-        rg
-      utran_q(i, l) = utran_q(i, l) + u(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &
-        ))/rg
-      vtran_e(i, l) = vtran_e(i, l) + v(i, l)*esh*(paprs(i,l)-paprs(i,l+1))/ &
-        rg
-      vtran_q(i, l) = vtran_q(i, l) + v(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &
-        ))/rg
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE transp_lay
+link ../phylmd/transp_lay.F90
Index: LMDZ6/trunk/libf/phylmdiso/tropopause_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tropopause_m.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tropopause_m.F90	(revision 3940)
@@ -1,146 +1,1 @@
-MODULE tropopause_m
-
-  IMPLICIT NONE
-  PRIVATE
-  PUBLIC :: dyn_tropopause
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-!
-FUNCTION dyn_tropopause(t, ts, paprs, pplay, rot, itrop, thet0, pvor0)
-!
-!-------------------------------------------------------------------------------
-  USE assert_m,     ONLY: assert
-  USE assert_eq_m,  ONLY: assert_eq
-  USE dimphy,       ONLY: klon, klev
-  USE geometry_mod, ONLY: latitude_deg, longitude_deg
-  USE vertical_layers_mod, ONLY: aps, bps, preff
-#ifdef REPROBUS
-  USE chem_rep, ONLY: itroprep
-#endif
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL ::     dyn_tropopause(klon) !--- Pressure at tropopause
-  REAL, INTENT(IN)  ::      t(:,:) !--- Cells-centers temperature
-  REAL, INTENT(IN)  ::     ts(:)   !--- Surface       temperature
-  REAL, INTENT(IN)  ::  paprs(:,:) !--- Cells-edges   pressure
-  REAL, INTENT(IN)  ::  pplay(:,:) !--- Cells-centers pressure
-  REAL, INTENT(IN)  ::    rot(:,:) !--- Cells-centers relative vorticity
-  INTEGER, INTENT(OUT), OPTIONAL :: itrop(klon) !--- Last tropospheric layer idx
-  REAL,    INTENT(IN),  OPTIONAL :: thet0, pvor0
-!-------------------------------------------------------------------------------
-! Local variables:
-  include "YOMCST.h"
-  REAL, PARAMETER :: DynPTrMin =8.E+3 !--- Thresholds for minimum and maximum
-  REAL, PARAMETER :: DynPTrMax =4.E+4 !    dynamical tropopause pressure (Pa).
-  CHARACTER(LEN=80)  :: sub
-  INTEGER :: i, k, kb, kt, kp, ib, ie, nw
-  REAL    :: al, th0, pv0
-  REAL,    DIMENSION(klon,klev) :: tpot_cen, tpot_edg, pvor_cen
-  REAL,    PARAMETER :: sg0=0.75  !--- Start level for PV=cte search loop
-  INTEGER, PARAMETER :: nadj=3    !--- Adjacent levs nb for thresholds detection
-  REAL,    PARAMETER :: w(5)=[0.1,0.25,0.3,0.25,0.1] !--- Vertical smoothing
-  INTEGER, SAVE :: k0
-  LOGICAL, SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(k0,first)
-!-------------------------------------------------------------------------------
-  sub='dyn_tropopause'
-  CALL assert(SIZE(t ,1)==klon, TRIM(sub)//" t klon")
-  CALL assert(SIZE(t ,2)==klev, TRIM(sub)//" t klev")
-  CALL assert(SIZE(ts,1)==klon, TRIM(sub)//" ts klon")
-  CALL assert(SHAPE(paprs)==[klon,klev+1],TRIM(sub)//" paprs shape")
-  CALL assert(SHAPE(pplay)==[klon,klev  ],TRIM(sub)//" pplay shape")
-  CALL assert(SHAPE(rot)  ==[klon,klev  ],TRIM(sub)//" rot shape")
-
-  !--- DEFAULT THRESHOLDS
-  th0=380.; IF(PRESENT(thet0)) th0=thet0   !--- In kelvins
-  pv0=  2.; IF(PRESENT(pvor0)) pv0=pvor0   !--- In PVU
-  IF(first) THEN
-    DO k0=1,klev; IF(aps(k0)/preff+bps(k0)<sg0) EXIT; END DO; first=.FALSE.
-  END IF
-
-  !--- POTENTIAL TEMPERATURE AT CELLS CENTERS AND INTERFACES
-  DO i = 1,klon
-    tpot_cen(i,1) = t(i,1)*(preff/pplay(i,1))**RKAPPA
-    tpot_edg(i,1) = ts(i) *(preff/paprs(i,1))**RKAPPA
-    DO k=2,klev
-      al = LOG(pplay(i,k-1)/paprs(i,k))/LOG(pplay(i,k-1)/pplay(i,k))
-      tpot_cen(i,k) =  t(i,k)                        *(preff/pplay(i,k))**RKAPPA
-      tpot_edg(i,k) = (t(i,k-1)+al*(t(i,k)-t(i,k-1)))*(preff/paprs(i,k))**RKAPPA
-      !--- FORCE QUANTITIES TO BE GROWING
-      IF(tpot_edg(i,k)<tpot_edg(i,k-1)) tpot_edg(i,k)=tpot_edg(i,k-1)+1.E-5
-      IF(tpot_cen(i,k)<tpot_cen(i,k-1)) tpot_cen(i,k)=tpot_cen(i,k-1)+1.E-5
-    END DO
-    !--- VERTICAL SMOOTHING
-    tpot_cen(i,:)=smooth(tpot_cen(i,:),w)
-    tpot_edg(i,:)=smooth(tpot_edg(i,:),w)
-  END DO
-
-  !--- ERTEL POTENTIAL VORTICITY AT CELLS CENTERS (except in top layer)
-  DO i = 1, klon
-    DO k= 1, klev-1
-      pvor_cen(i,k)=-1.E6*RG*(rot(i,k)+2.*ROMEGA*SIN(latitude_deg(i)*RPI/180.))&
-                   * (tpot_edg(i,k+1)-tpot_edg(i,k)) / (paprs(i,k+1)-paprs(i,k))
-    END DO
-    !--- VERTICAL SMOOTHING
-    pvor_cen(i,1:klev-1)=smooth(pvor_cen(i,1:klev-1),w)
-  END DO
-
-  !--- LOCATE TROPOPAUSE: LOWEST POINT BETWEEN THETA=380K AND PV=2PVU SURFACES.
-  DO i = 1, klon
-    !--- UPPER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM TOP
-    DO kt=klev-1,1,-1; IF(ALL(ABS(pvor_cen(i,kt-nadj:kt))<=pv0)) EXIT; END DO
-    !--- LOWER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM BOTTOM
-    DO kb=k0,klev-1;   IF(ALL(ABS(pvor_cen(i,kb:kb+nadj))> pv0)) EXIT; END DO; kb=kb-1
-    !--- ISO-THETA POINT: THETA=380K       STARTING FROM TOP
-    DO kp=klev-1,1,-1; IF(ALL(ABS(tpot_cen(i,kp-nadj:kp))<=th0)) EXIT; END DO
-    !--- CHOOSE BETWEEN LOWER AND UPPER TROPOPAUSE
-    IF(2*COUNT(ABS(pvor_cen(i,kb:kt))>pv0)>kt-kb+1) kt=kb
-    !--- PV-DEFINED TROPOPAUSE
-    al = (ABS(pvor_cen(i,kt+1))-pv0)/ABS(pvor_cen(i,kt+1)-pvor_cen(i,kt))
-    dyn_tropopause(i) = pplay(i,kt+1)*(pplay(i,kt)/pplay(i,kt+1))**al
-    !--- THETA=380K IN THE TROPICAL REGION
-    al = (tpot_cen(i,kp+1)-th0)/(tpot_cen(i,kp+1)-tpot_cen(i,kp))
-    dyn_tropopause(i) = MAX( pplay(i,kp+1)*(pplay(i,kp)/pplay(i,kp+1))**al,    &
-                            dyn_tropopause(i) )
-    !--- UNREALISTIC VALUES DETECTION
-    IF(dyn_tropopause(i)<DynPTrMin.OR.dyn_tropopause(i)>DynPTrMax) THEN
-      dyn_tropopause(i)=MIN(MAX(dyn_tropopause(i),DynPTrMax),DynPTrMin)
-      DO kt=1,klev-1; IF(pplay(i,kt+1)>dyn_tropopause(i)) EXIT; END DO; kp=kt
-    END IF
-#ifdef REPROBUS
-    itroprep(i)=MAX(kt,kp)
-#endif
-    !--- LAST TROPOSPHERIC LAYER INDEX NEEDED
-    IF(PRESENT(itrop)) itrop(i)=MAX(kt,kp)
-  END DO
-
-END FUNCTION dyn_tropopause
-
-
-!-------------------------------------------------------------------------------
-!
-FUNCTION smooth(v,w)
-!
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)         :: v(:), w(:)
-  REAL, DIMENSION(SIZE(v)) :: smooth
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: nv, nw, k, kb, ke, lb, le
-!-------------------------------------------------------------------------------
-  nv=SIZE(v); nw=(SIZE(w)-1)/2
-  DO k=1,nv
-    kb=MAX(k-nw,1 ); lb=MAX(2+nw   -k,1)
-    ke=MIN(k+nw,nv); le=MIN(1+nw+nv-k,1+2*nw)
-    smooth(k)=SUM(v(kb:ke)*w(lb:le))/SUM(w(lb:le))
-  END DO
-
-END FUNCTION smooth
-!
-!-------------------------------------------------------------------------------
-
-END MODULE tropopause_m
+link ../phylmd/tropopause_m.F90
Index: LMDZ6/trunk/libf/phylmdiso/tsoilnudge.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/tsoilnudge.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/tsoilnudge.h	(revision 3940)
@@ -1,7 +1,1 @@
-      logical nudge_tsoil
-      integer isoil_nudge
-      real Tsoil_nudge, tau_soil_nudge
-
-      common /tsoilnudge/ nudge_tsoil, isoil_nudge, Tsoil_nudge,        &
-     &                   tau_soil_nudge
-
+link ../phylmd/tsoilnudge.h
Index: LMDZ6/trunk/libf/phylmdiso/undefSTD.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/undefSTD.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/undefSTD.F90	(revision 3940)
@@ -1,109 +1,1 @@
-
-! $Id: undefSTD.F90 3435 2019-01-22 15:21:59Z fairhead $
-
-SUBROUTINE undefstd(itap, read_climoz)
-  USE netcdf
-  USE dimphy
-#ifdef CPP_IOIPSL 
-  USE phys_state_var_mod
-#endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
-
-  IMPLICIT NONE
-  include "clesphys.h"
-#ifndef CPP_XIOS 
-  REAL :: missing_val
-#endif
-
-  ! ====================================================================
-
-  ! I. Musat : 09.2004
-
-  ! Calcul * du nombre de pas de temps (FLOAT(ecrit_XXX)-tnondef))
-  ! ou la variable tlevSTD est bien definie (.NE.missing_val),
-  ! et
-  ! * de la somme de tlevSTD => tsumSTD
-
-  ! nout=1 !var. journaliere "day" moyenne sur tous les pas de temps
-  ! ! de la physique
-  ! nout=2 !var. mensuelle "mth" moyennee sur tous les pas de temps
-  ! ! de la physique
-  ! nout=3 !var. mensuelle "NMC" moyennee toutes les ecrit_hf
-
-
-  ! NB: mettre "inst(X)" dans le write_hist*NMC.h !
-  ! ====================================================================
-
-  ! ym#include "dimphy.h"
-  ! variables Input
-
-  ! INTEGER nlevSTD, klevSTD, itap
-  ! PARAMETER(klevSTD=17)
-  INTEGER itap
-
-  ! variables locales
-  ! INTEGER i, k, nout, n
-  ! PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC
-  INTEGER i, k, n
-  ! REAL freq_calNMC(nout)
-  INTEGER read_climoz
-
-  ! variables Output
-  ! REAL tlevSTD(klon,klevSTD), tsumSTD(klon,klevSTD,nout)
-  ! LOGICAL oknondef(klon,klevSTD,nout)
-  ! REAL tnondef(klon,klevSTD,nout)
-
-! REAL missing_val
-
-! missing_val = nf90_fill_real
-#ifndef CPP_XIOS
-      missing_val=missing_val_nf90
-#endif
-
-  DO n = 1, nout
-
-
-    ! calcul variables tous les freq_calNMC(n)/phys_tstep pas de temps
-    ! de la physique
-
-    IF (mod(itap,nint(freq_calnmc(n)/phys_tstep))==0) THEN
-      DO k = 1, nlevstd
-        DO i = 1, klon
-          IF (tlevstd(i,k)==missing_val) THEN
-            ! IF(oknondef(i,k,n)) THEN
-            tnondef(i, k, n) = tnondef(i, k, n) + 1.
-            ! ENDIF !oknondef(i,k)
-
-          ELSE IF (tlevstd(i,k)/=missing_val) THEN
-            tsumstd(i, k, n) = tsumstd(i, k, n) + tlevstd(i, k)
-            usumstd(i, k, n) = usumstd(i, k, n) + ulevstd(i, k)
-            vsumstd(i, k, n) = vsumstd(i, k, n) + vlevstd(i, k)
-            wsumstd(i, k, n) = wsumstd(i, k, n) + wlevstd(i, k)
-            phisumstd(i, k, n) = phisumstd(i, k, n) + philevstd(i, k)
-            qsumstd(i, k, n) = qsumstd(i, k, n) + qlevstd(i, k)
-            rhsumstd(i, k, n) = rhsumstd(i, k, n) + rhlevstd(i, k)
-            uvsumstd(i, k, n) = uvsumstd(i, k, n) + uvstd(i, k)
-            vqsumstd(i, k, n) = vqsumstd(i, k, n) + vqstd(i, k)
-            vtsumstd(i, k, n) = vtsumstd(i, k, n) + vtstd(i, k)
-            wqsumstd(i, k, n) = wqsumstd(i, k, n) + wqstd(i, k)
-            vphisumstd(i, k, n) = vphisumstd(i, k, n) + vphistd(i, k)
-            wtsumstd(i, k, n) = wtsumstd(i, k, n) + wtstd(i, k)
-            u2sumstd(i, k, n) = u2sumstd(i, k, n) + u2std(i, k)
-            v2sumstd(i, k, n) = v2sumstd(i, k, n) + v2std(i, k)
-            t2sumstd(i, k, n) = t2sumstd(i, k, n) + t2std(i, k)
-            o3sumstd(i, k, n) = o3sumstd(i, k, n) + o3std(i, k)
-            IF (read_climoz==2) o3daysumstd(i, k, n) = o3daysumstd(i, k, n) + &
-              o3daystd(i, k)
-
-          END IF
-        END DO !i
-      END DO !k
-
-    END IF !MOD(itap,NINT(freq_calNMC(n)/phys_tstep)).EQ.0
-
-  END DO !n
-
-  RETURN
-END SUBROUTINE undefstd
+link ../phylmd/undefSTD.F90
Index: LMDZ6/trunk/libf/phylmdiso/ustarhb.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/ustarhb.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/ustarhb.F90	(revision 3940)
@@ -1,52 +1,1 @@
-
-! $Header$
-
-SUBROUTINE ustarhb(knon, u, v, cd_m, ustar)
-  USE dimphy
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Laurent Li (LMD/CNRS), le 30 septembre 1998
-  ! Couche limite non-locale. Adaptation du code du CCM3.
-  ! Code non teste, donc a ne pas utiliser.
-  ! ======================================================================
-  ! Nonlocal scheme that determines eddy diffusivities based on a
-  ! diagnosed boundary layer height and a turbulent velocity scale.
-  ! Also countergradient effects for heat and moisture are included.
-
-  ! For more information, see Holtslag, A.A.M., and B.A. Boville, 1993:
-  ! Local versus nonlocal boundary-layer diffusion in a global climate
-  ! model. J. of Climate, vol. 6, 1825-1842.
-  ! ======================================================================
-  include "YOMCST.h"
-
-  ! Arguments:
-
-  INTEGER knon ! nombre de points a calculer
-  REAL u(klon, klev) ! vitesse U (m/s)
-  REAL v(klon, klev) ! vitesse V (m/s)
-  REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
-  REAL ustar(klon)
-
-  INTEGER i, k
-  REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
-  REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
-  LOGICAL unssrf(klon) ! unstb pbl w/lvls within srf pbl lyr
-  LOGICAL unsout(klon) ! unstb pbl w/lvls in outer pbl lyr
-  LOGICAL check(klon) ! True=>chk if Richardson no.>critcal
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-  DO i = 1, knon
-    zx_alf1 = 1.0
-    zx_alf2 = 1.0 - zx_alf1
-    zxu = u(i, 1)*zx_alf1 + u(i, 2)*zx_alf2
-    zxv = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2
-    zxmod = 1.0 + sqrt(zxu**2+zxv**2)
-    taux = zxu*zxmod*cd_m(i)
-    tauy = zxv*zxmod*cd_m(i)
-    ustar(i) = sqrt(taux**2+tauy**2)
-    ! print*,'Ust ',zxu,zxmod,taux,ustar(i)
-  END DO
-
-  RETURN
-END SUBROUTINE ustarhb
+link ../phylmd/ustarhb.F90
Index: LMDZ6/trunk/libf/phylmdiso/vdif_kcay.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/vdif_kcay.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/vdif_kcay.F90	(revision 3940)
@@ -1,674 +1,1 @@
-
-! $Header$
-
-SUBROUTINE vdif_kcay(ngrid, dt, g, rconst, plev, temp, zlev, zlay, u, v, &
-    teta, cd, q2, q2diag, km, kn, ustar, l_mix)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! dt : pas de temps
-  ! g  : g
-  ! zlev : altitude a chaque niveau (interface inferieure de la couche
-  ! de meme indice)
-  ! zlay : altitude au centre de chaque couche
-  ! u,v : vitesse au centre de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! teta : temperature potentielle au centre de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! cd : cdrag
-  ! (en entree : la valeur au debut du pas de temps)
-  ! q2 : $q^2$ au bas de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! (en sortie : la valeur a la fin du pas de temps)
-  ! km : diffusivite turbulente de quantite de mouvement (au bas de chaque
-  ! couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-  ! kn : diffusivite turbulente des scalaires (au bas de chaque couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-
-  ! .......................................................................
-  REAL dt, g, rconst
-  REAL plev(klon, klev+1), temp(klon, klev)
-  REAL ustar(klon), snstable
-  REAL zlev(klon, klev+1)
-  REAL zlay(klon, klev)
-  REAL u(klon, klev)
-  REAL v(klon, klev)
-  REAL teta(klon, klev)
-  REAL cd(klon)
-  REAL q2(klon, klev+1), q2s(klon, klev+1)
-  REAL q2diag(klon, klev+1)
-  REAL km(klon, klev+1)
-  REAL kn(klon, klev+1)
-  REAL sq(klon), sqz(klon), zz(klon, klev+1), zq, long0(klon)
-
-  INTEGER l_mix, iii
-  ! .......................................................................
-
-  ! nlay : nombre de couches
-  ! nlev : nombre de niveaux
-  ! ngrid : nombre de points de grille
-  ! unsdz : 1 sur l'epaisseur de couche
-  ! unsdzdec : 1 sur la distance entre le centre de la couche et le
-  ! centre de la couche inferieure
-  ! q : echelle de vitesse au bas de chaque couche
-  ! (valeur a la fin du pas de temps)
-
-  ! .......................................................................
-  INTEGER nlay, nlev, ngrid
-  REAL unsdz(klon, klev)
-  REAL unsdzdec(klon, klev+1)
-  REAL q(klon, klev+1)
-
-  ! .......................................................................
-
-  ! kmpre : km au debut du pas de temps
-  ! qcstat : q : solution stationnaire du probleme couple
-  ! (valeur a la fin du pas de temps)
-  ! q2cstat : q2 : solution stationnaire du probleme couple
-  ! (valeur a la fin du pas de temps)
-
-  ! .......................................................................
-  REAL kmpre(klon, klev+1)
-  REAL qcstat
-  REAL q2cstat
-  REAL sss, sssq
-  ! .......................................................................
-
-  ! long : longueur de melange calculee selon Blackadar
-
-  ! .......................................................................
-  REAL long(klon, klev+1)
-  ! .......................................................................
-
-  ! kmq3 : terme en q^3 dans le developpement de km
-  ! (valeur au debut du pas de temps)
-  ! kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
-  ! (valeur a la fin du pas de temps)
-  ! knq3 : terme en q^3 dans le developpement de kn
-  ! mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
-  ! (valeur a la fin du pas de temps)
-  ! m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
-  ! (valeur a la fin du pas de temps)
-  ! m : valeur a la fin du pas de temps
-  ! mpre : valeur au debut du pas de temps
-  ! m2 : valeur a la fin du pas de temps
-  ! n2 : valeur a la fin du pas de temps
-
-  ! .......................................................................
-  REAL kmq3
-  REAL kmcstat
-  REAL knq3
-  REAL mcstat
-  REAL m2cstat
-  REAL m(klon, klev+1)
-  REAL mpre(klon, klev+1)
-  REAL m2(klon, klev+1)
-  REAL n2(klon, klev+1)
-  ! .......................................................................
-
-  ! gn : intermediaire pour les coefficients de stabilite
-  ! gnmin : borne inferieure de gn (-0.23 ou -0.28)
-  ! gnmax : borne superieure de gn (0.0233)
-  ! gninf : vrai si gn est en dessous de sa borne inferieure
-  ! gnsup : vrai si gn est en dessus de sa borne superieure
-  ! gm : drole d'objet bien utile
-  ! ri : nombre de Richardson
-  ! sn : coefficient de stabilite pour n
-  ! snq2 : premier terme du developement limite de sn en q2
-  ! sm : coefficient de stabilite pour m
-  ! smq2 : premier terme du developement limite de sm en q2
-
-  ! .......................................................................
-  REAL gn
-  REAL gnmin
-  REAL gnmax
-  LOGICAL gninf
-  LOGICAL gnsup
-  REAL gm
-  ! REAL ri(klon,klev+1)
-  REAL sn(klon, klev+1)
-  REAL snq2(klon, klev+1)
-  REAL sm(klon, klev+1)
-  REAL smq2(klon, klev+1)
-  ! .......................................................................
-
-  ! kappa : consatnte de Von Karman (0.4)
-  ! long00 : longueur de reference pour le calcul de long (160)
-  ! a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
-  ! de stabilite (0.92/0.74/16.6/10.1/0.08)
-  ! cn1,cn2 : constantes pour sn
-  ! cm1,cm2,cm3,cm4 : constantes pour sm
-
-  ! .......................................................................
-  REAL kappa
-  REAL long00
-  REAL a1, a2, b1, b2, c1
-  REAL cn1, cn2
-  REAL cm1, cm2, cm3, cm4
-  ! .......................................................................
-
-  ! termq : termes en $q$ dans l'equation de q2
-  ! termq3 : termes en $q^3$ dans l'equation de q2
-  ! termqm2 : termes en $q*m^2$ dans l'equation de q2
-  ! termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
-
-  ! .......................................................................
-  REAL termq
-  REAL termq3
-  REAL termqm2
-  REAL termq3m2
-  ! .......................................................................
-
-  ! q2min : borne inferieure de q2
-  ! q2max : borne superieure de q2
-
-  ! .......................................................................
-  REAL q2min
-  REAL q2max
-  ! .......................................................................
-  ! knmin : borne inferieure de kn
-  ! kmmin : borne inferieure de km
-  ! .......................................................................
-  REAL knmin
-  REAL kmmin
-  ! .......................................................................
-  INTEGER ilay, ilev, igrid
-  REAL tmp1, tmp2
-  ! .......................................................................
-  PARAMETER (kappa=0.4E+0)
-  PARAMETER (long00=160.E+0)
-  ! PARAMETER (gnmin=-10.E+0)
-  PARAMETER (gnmin=-0.28)
-  PARAMETER (gnmax=0.0233E+0)
-  PARAMETER (a1=0.92E+0)
-  PARAMETER (a2=0.74E+0)
-  PARAMETER (b1=16.6E+0)
-  PARAMETER (b2=10.1E+0)
-  PARAMETER (c1=0.08E+0)
-  PARAMETER (knmin=1.E-5)
-  PARAMETER (kmmin=1.E-5)
-  PARAMETER (q2min=1.E-5)
-  PARAMETER (q2max=1.E+2)
-  ! ym      PARAMETER (nlay=klev)
-  ! ym      PARAMETER (nlev=klev+1)
-
-  PARAMETER (cn1=a2*(1.E+0-6.E+0*a1/b1))
-  PARAMETER (cn2=-3.E+0*a2*(6.E+0*a1+b2))
-  PARAMETER (cm1=a1*(1.E+0-3.E+0*c1-6.E+0*a1/b1))
-  PARAMETER (cm2=a1*(-3.E+0*a2*((b2-3.E+0*a2)*(1.E+0-6.E+0*a1/b1)- &
-    3.E+0*c1*(b2+6.E+0*a1))))
-  PARAMETER (cm3=-3.E+0*a2*(6.E+0*a1+b2))
-  PARAMETER (cm4=-9.E+0*a1*a2)
-
-  LOGICAL first
-  SAVE first
-  DATA first/.TRUE./
-  !$OMP THREADPRIVATE(first)
-  ! .......................................................................
-  ! traitment des valeur de q2 en entree
-  ! .......................................................................
-
-  ! Initialisation de q2
-  nlay = klev
-  nlev = klev + 1
-
-  CALL yamada(ngrid, dt, g, rconst, plev, temp, zlev, zlay, u, v, teta, cd, &
-    q2diag, km, kn, ustar, l_mix)
-  IF (first .AND. 1==1) THEN
-    first = .FALSE.
-    q2 = q2diag
-  END IF
-
-  DO ilev = 1, nlev
-    DO igrid = 1, ngrid
-      q2(igrid, ilev) = amax1(q2(igrid,ilev), q2min)
-      q(igrid, ilev) = sqrt(q2(igrid,ilev))
-    END DO
-  END DO
-
-  DO igrid = 1, ngrid
-    tmp1 = cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
-    q2(igrid, 1) = b1**(2.E+0/3.E+0)*tmp1
-    q2(igrid, 1) = amax1(q2(igrid,1), q2min)
-    q(igrid, 1) = sqrt(q2(igrid,1))
-  END DO
-
-  ! .......................................................................
-  ! les increments verticaux
-  ! .......................................................................
-
-  ! !!!!! allerte !!!!!c
-  ! !!!!! zlev n'est pas declare a nlev !!!!!c
-  ! !!!!! ---->
-  DO igrid = 1, ngrid
-    zlev(igrid, nlev) = zlay(igrid, nlay) + (zlay(igrid,nlay)-zlev(igrid,nlev &
-      -1))
-  END DO
-  ! !!!!! <----
-  ! !!!!! allerte !!!!!c
-
-  DO ilay = 1, nlay
-    DO igrid = 1, ngrid
-      unsdz(igrid, ilay) = 1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
-    END DO
-  END DO
-  DO igrid = 1, ngrid
-    unsdzdec(igrid, 1) = 1.E+0/(zlay(igrid,1)-zlev(igrid,1))
-  END DO
-  DO ilay = 2, nlay
-    DO igrid = 1, ngrid
-      unsdzdec(igrid, ilay) = 1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
-    END DO
-  END DO
-  DO igrid = 1, ngrid
-    unsdzdec(igrid, nlay+1) = 1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
-  END DO
-
-  ! .......................................................................
-  ! le cisaillement et le gradient de temperature
-  ! .......................................................................
-
-  DO igrid = 1, ngrid
-    m2(igrid, 1) = (unsdzdec(igrid,1)*u(igrid,1))**2 + &
-      (unsdzdec(igrid,1)*v(igrid,1))**2
-    m(igrid, 1) = sqrt(m2(igrid,1))
-    mpre(igrid, 1) = m(igrid, 1)
-  END DO
-
-  ! -----------------------------------------------------------------------
-  DO ilev = 2, nlev - 1
-    DO igrid = 1, ngrid
-      ! -----------------------------------------------------------------------
-
-      n2(igrid, ilev) = g*unsdzdec(igrid, ilev)*(teta(igrid,ilev)-teta(igrid, &
-        ilev-1))/(teta(igrid,ilev)+teta(igrid,ilev-1))*2.E+0
-      ! n2(igrid,ilev)=0.
-
-      ! --->
-      ! on ne sais traiter que les cas stratifies. et l'ajustement
-      ! convectif est cense faire en sorte que seul des configurations
-      ! stratifiees soient rencontrees en entree de cette routine.
-      ! mais, bon ... on sait jamais (meme on sait que n2 prends
-      ! quelques valeurs negatives ... parfois) alors :
-      ! <---
-
-      IF (n2(igrid,ilev)<0.E+0) THEN
-        n2(igrid, ilev) = 0.E+0
-      END IF
-
-      m2(igrid, ilev) = (unsdzdec(igrid,ilev)*(u(igrid,ilev)-u(igrid, &
-        ilev-1)))**2 + (unsdzdec(igrid,ilev)*(v(igrid,ilev)-v(igrid, &
-        ilev-1)))**2
-      m(igrid, ilev) = sqrt(m2(igrid,ilev))
-      mpre(igrid, ilev) = m(igrid, ilev)
-
-      ! -----------------------------------------------------------------------
-    END DO
-  END DO
-  ! -----------------------------------------------------------------------
-
-  DO igrid = 1, ngrid
-    m2(igrid, nlev) = m2(igrid, nlev-1)
-    m(igrid, nlev) = m(igrid, nlev-1)
-    mpre(igrid, nlev) = m(igrid, nlev)
-  END DO
-
-  ! .......................................................................
-  ! calcul des fonctions de stabilite
-  ! .......................................................................
-
-  IF (l_mix==4) THEN
-    DO igrid = 1, ngrid
-      sqz(igrid) = 1.E-10
-      sq(igrid) = 1.E-10
-    END DO
-    DO ilev = 2, nlev - 1
-      DO igrid = 1, ngrid
-        zq = sqrt(q2(igrid,ilev))
-        sqz(igrid) = sqz(igrid) + zq*zlev(igrid, ilev)*(zlay(igrid,ilev)-zlay &
-          (igrid,ilev-1))
-        sq(igrid) = sq(igrid) + zq*(zlay(igrid,ilev)-zlay(igrid,ilev-1))
-      END DO
-    END DO
-    DO igrid = 1, ngrid
-      long0(igrid) = 0.2*sqz(igrid)/sq(igrid)
-    END DO
-  ELSE IF (l_mix==3) THEN
-    long0(igrid) = long00
-  END IF
-
-  ! (abd 5 2)      print*,'LONG0=',long0
-
-  ! -----------------------------------------------------------------------
-  DO ilev = 2, nlev - 1
-    DO igrid = 1, ngrid
-      ! -----------------------------------------------------------------------
-
-      tmp1 = kappa*(zlev(igrid,ilev)-zlev(igrid,1))
-      IF (l_mix>=10) THEN
-        long(igrid, ilev) = l_mix
-      ELSE
-        long(igrid, ilev) = tmp1/(1.E+0+tmp1/long0(igrid))
-      END IF
-      long(igrid, ilev) = max(min(long(igrid,ilev),0.5*sqrt(q2(igrid,ilev))/ &
-        sqrt(max(n2(igrid,ilev),1.E-10))), 5.)
-
-      gn = -long(igrid, ilev)**2/q2(igrid, ilev)*n2(igrid, ilev)
-      gm = long(igrid, ilev)**2/q2(igrid, ilev)*m2(igrid, ilev)
-
-      gninf = .FALSE.
-      gnsup = .FALSE.
-      long(igrid, ilev) = long(igrid, ilev)
-      long(igrid, ilev) = long(igrid, ilev)
-
-      IF (gn<gnmin) THEN
-        gninf = .TRUE.
-        gn = gnmin
-      END IF
-
-      IF (gn>gnmax) THEN
-        gnsup = .TRUE.
-        gn = gnmax
-      END IF
-
-      sn(igrid, ilev) = cn1/(1.E+0+cn2*gn)
-      sm(igrid, ilev) = (cm1+cm2*gn)/((1.E+0+cm3*gn)*(1.E+0+cm4*gn))
-
-      IF ((gninf) .OR. (gnsup)) THEN
-        snq2(igrid, ilev) = 0.E+0
-        smq2(igrid, ilev) = 0.E+0
-      ELSE
-        snq2(igrid, ilev) = -gn*(-cn1*cn2/(1.E+0+cn2*gn)**2)
-        smq2(igrid, ilev) = -gn*(cm2*(1.E+0+cm3*gn)*(1.E+0+cm4*gn)-(cm3*( &
-          1.E+0+cm4*gn)+cm4*(1.E+0+cm3*gn))*(cm1+cm2*gn))/((1.E+0+cm3*gn)*( &
-          1.E+0+cm4*gn))**2
-      END IF
-
-      ! abd
-      ! if(ilev.le.57.and.ilev.ge.37) then
-      ! print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
-      ! endif
-      ! --->
-      ! la decomposition de Taylor en q2 n'a de sens que
-      ! dans les cas stratifies ou sn et sm sont quasi
-      ! proportionnels a q2. ailleurs on laisse le meme
-      ! algorithme car l'ajustement convectif fait le travail.
-      ! mais c'est delirant quand sn et snq2 n'ont pas le meme
-      ! signe : dans ces cas, on ne fait pas la decomposition.
-      ! <---
-
-      IF (snq2(igrid,ilev)*sn(igrid,ilev)<=0.E+0) snq2(igrid, ilev) = 0.E+0
-      IF (smq2(igrid,ilev)*sm(igrid,ilev)<=0.E+0) smq2(igrid, ilev) = 0.E+0
-
-      ! Correction pour les couches stables.
-      ! Schema repris de JHoltzlag Boville, lui meme venant de...
-
-      IF (1==1) THEN
-        snstable = 1. - zlev(igrid, ilev)/(700.*max(ustar(igrid),0.0001))
-        snstable = 1. - zlev(igrid, ilev)/400.
-        snstable = max(snstable, 0.)
-        snstable = snstable*snstable
-
-        ! abde       print*,'SN ',ilev,sn(1,ilev),snstable
-        IF (sn(igrid,ilev)<snstable) THEN
-          sn(igrid, ilev) = snstable
-          snq2(igrid, ilev) = 0.
-        END IF
-
-        IF (sm(igrid,ilev)<snstable) THEN
-          sm(igrid, ilev) = snstable
-          smq2(igrid, ilev) = 0.
-        END IF
-
-      END IF
-
-      ! sn : coefficient de stabilite pour n
-      ! snq2 : premier terme du developement limite de sn en q2
-      ! -----------------------------------------------------------------------
-    END DO
-  END DO
-  ! -----------------------------------------------------------------------
-
-  ! .......................................................................
-  ! calcul de km et kn au debut du pas de temps
-  ! .......................................................................
-
-  DO igrid = 1, ngrid
-    kn(igrid, 1) = knmin
-    km(igrid, 1) = kmmin
-    kmpre(igrid, 1) = km(igrid, 1)
-  END DO
-
-  ! -----------------------------------------------------------------------
-  DO ilev = 2, nlev - 1
-    DO igrid = 1, ngrid
-      ! -----------------------------------------------------------------------
-
-      kn(igrid, ilev) = long(igrid, ilev)*q(igrid, ilev)*sn(igrid, ilev)
-      km(igrid, ilev) = long(igrid, ilev)*q(igrid, ilev)*sm(igrid, ilev)
-      kmpre(igrid, ilev) = km(igrid, ilev)
-
-      ! -----------------------------------------------------------------------
-    END DO
-  END DO
-  ! -----------------------------------------------------------------------
-
-  DO igrid = 1, ngrid
-    kn(igrid, nlev) = kn(igrid, nlev-1)
-    km(igrid, nlev) = km(igrid, nlev-1)
-    kmpre(igrid, nlev) = km(igrid, nlev)
-  END DO
-
-  ! .......................................................................
-  ! boucle sur les niveaux 2 a nlev-1
-  ! .......................................................................
-
-  ! ---->
-  DO ilev = 2, nlev - 1
-    ! ---->
-    DO igrid = 1, ngrid
-
-      ! .......................................................................
-
-      ! calcul des termes sources et puits de l'equation de q2
-      ! ------------------------------------------------------
-
-      knq3 = kn(igrid, ilev)*snq2(igrid, ilev)/sn(igrid, ilev)
-      kmq3 = km(igrid, ilev)*smq2(igrid, ilev)/sm(igrid, ilev)
-
-      termq = 0.E+0
-      termq3 = 0.E+0
-      termqm2 = 0.E+0
-      termq3m2 = 0.E+0
-
-      tmp1 = dt*2.E+0*km(igrid, ilev)*m2(igrid, ilev)
-      tmp2 = dt*2.E+0*kmq3*m2(igrid, ilev)
-      termqm2 = termqm2 + dt*2.E+0*km(igrid, ilev)*m2(igrid, ilev) - &
-        dt*2.E+0*kmq3*m2(igrid, ilev)
-      termq3m2 = termq3m2 + dt*2.E+0*kmq3*m2(igrid, ilev)
-
-      termq = termq - dt*2.E+0*kn(igrid, ilev)*n2(igrid, ilev) + &
-        dt*2.E+0*knq3*n2(igrid, ilev)
-      termq3 = termq3 - dt*2.E+0*knq3*n2(igrid, ilev)
-
-      termq3 = termq3 - dt*2.E+0*q(igrid, ilev)**3/(b1*long(igrid,ilev))
-
-      ! .......................................................................
-
-      ! resolution stationnaire couplee avec le gradient de vitesse local
-      ! -----------------------------------------------------------------
-
-      ! -----{on cherche le cisaillement qui annule l'equation de q^2
-      ! supposee en q3}
-
-      tmp1 = termq + termq3
-      tmp2 = termqm2 + termq3m2
-      m2cstat = m2(igrid, ilev) - (tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
-      mcstat = sqrt(m2cstat)
-
-      ! abde      print*,'M2 L=',ilev,mpre(igrid,ilev),mcstat
-
-      ! -----{puis on ecrit la valeur de q qui annule l'equation de m
-      ! supposee en q3}
-
-      IF (ilev==2) THEN
-        kmcstat = 1.E+0/mcstat*(unsdz(igrid,ilev)*kmpre(igrid,ilev+1)*mpre( &
-          igrid,ilev+1)+unsdz(igrid,ilev-1)*cd(igrid)*(sqrt(u(igrid,3)**2+ &
-          v(igrid,3)**2)-mcstat/unsdzdec(igrid,ilev)-mpre(igrid, &
-          ilev+1)/unsdzdec(igrid,ilev+1))**2)/(unsdz(igrid,ilev)+unsdz(igrid, &
-          ilev-1))
-      ELSE
-        kmcstat = 1.E+0/mcstat*(unsdz(igrid,ilev)*kmpre(igrid,ilev+1)*mpre( &
-          igrid,ilev+1)+unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)*mpre(igrid, &
-          ilev-1))/(unsdz(igrid,ilev)+unsdz(igrid,ilev-1))
-      END IF
-      tmp2 = kmcstat/(sm(igrid,ilev)/q2(igrid,ilev))/long(igrid, ilev)
-      qcstat = tmp2**(1.E+0/3.E+0)
-      q2cstat = qcstat**2
-
-      ! .......................................................................
-
-      ! choix de la solution finale
-      ! ---------------------------
-
-      q(igrid, ilev) = qcstat
-      q2(igrid, ilev) = q2cstat
-      m(igrid, ilev) = mcstat
-      ! abd       if(ilev.le.57.and.ilev.ge.37) then
-      ! print*,'L=',ilev,'   M2=',m2(igrid,ilev),m2cstat,
-      ! s     'N2=',n2(igrid,ilev)
-      ! abd       endif
-      m2(igrid, ilev) = m2cstat
-
-      ! --->
-      ! pour des raisons simples q2 est minore
-      ! <---
-
-      IF (q2(igrid,ilev)<q2min) THEN
-        q2(igrid, ilev) = q2min
-        q(igrid, ilev) = sqrt(q2min)
-      END IF
-
-      ! .......................................................................
-
-      ! calcul final de kn et km
-      ! ------------------------
-
-      gn = -long(igrid, ilev)**2/q2(igrid, ilev)*n2(igrid, ilev)
-      IF (gn<gnmin) gn = gnmin
-      IF (gn>gnmax) gn = gnmax
-      sn(igrid, ilev) = cn1/(1.E+0+cn2*gn)
-      sm(igrid, ilev) = (cm1+cm2*gn)/((1.E+0+cm3*gn)*(1.E+0+cm4*gn))
-      kn(igrid, ilev) = long(igrid, ilev)*q(igrid, ilev)*sn(igrid, ilev)
-      km(igrid, ilev) = long(igrid, ilev)*q(igrid, ilev)*sm(igrid, ilev)
-      ! abd
-      ! if(ilev.le.57.and.ilev.ge.37) then
-      ! print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
-      ! endif
-
-      ! .......................................................................
-
-    END DO
-
-  END DO
-
-  ! .......................................................................
-
-
-  DO igrid = 1, ngrid
-    kn(igrid, 1) = knmin
-    km(igrid, 1) = kmmin
-    ! kn(igrid,1)=cd(igrid)
-    ! km(igrid,1)=cd(igrid)
-    q2(igrid, nlev) = q2(igrid, nlev-1)
-    q(igrid, nlev) = q(igrid, nlev-1)
-    kn(igrid, nlev) = kn(igrid, nlev-1)
-    km(igrid, nlev) = km(igrid, nlev-1)
-  END DO
-
-  ! CALCUL DE LA DIFFUSION VERTICALE DE Q2
-  IF (1==1) THEN
-
-    DO ilev = 2, klev - 1
-      sss = sss + plev(1, ilev-1) - plev(1, ilev+1)
-      sssq = sssq + (plev(1,ilev-1)-plev(1,ilev+1))*q2(1, ilev)
-    END DO
-    ! print*,'Q2moy avant',sssq/sss
-    ! print*,'Q2q20 ',(q2(1,ilev),ilev=1,10)
-    ! print*,'Q2km0 ',(km(1,ilev),ilev=1,10)
-    ! ! C'est quoi ca qu'etait dans l'original???
-    ! do igrid=1,ngrid
-    ! q2(igrid,1)=10.
-    ! enddo
-    ! q2s=q2
-    ! do iii=1,10
-    ! call vdif_q2(dt,g,rconst,plev,temp,km,q2)
-    ! do ilev=1,klev+1
-    ! write(iii+49,*) q2(1,ilev),zlev(1,ilev)
-    ! enddo
-    ! enddo
-    ! stop
-    ! do ilev=1,klev
-    ! print*,zlev(1,ilev),q2s(1,ilev),q2(1,ilev)
-    ! enddo
-    ! q2s=q2-q2s
-    ! do ilev=1,klev
-    ! print*,q2s(1,ilev),zlev(1,ilev)
-    ! enddo
-    DO ilev = 2, klev - 1
-      sss = sss + plev(1, ilev-1) - plev(1, ilev+1)
-      sssq = sssq + (plev(1,ilev-1)-plev(1,ilev+1))*q2(1, ilev)
-    END DO
-    PRINT *, 'Q2moy apres', sssq/sss
-
-
-    DO ilev = 1, nlev
-      DO igrid = 1, ngrid
-        q2(igrid, ilev) = max(q2(igrid,ilev), q2min)
-        q(igrid, ilev) = sqrt(q2(igrid,ilev))
-
-        ! .......................................................................
-
-        ! calcul final de kn et km
-        ! ------------------------
-
-        gn = -long(igrid, ilev)**2/q2(igrid, ilev)*n2(igrid, ilev)
-        IF (gn<gnmin) gn = gnmin
-        IF (gn>gnmax) gn = gnmax
-        sn(igrid, ilev) = cn1/(1.E+0+cn2*gn)
-        sm(igrid, ilev) = (cm1+cm2*gn)/((1.E+0+cm3*gn)*(1.E+0+cm4*gn))
-        ! Correction pour les couches stables.
-        ! Schema repris de JHoltzlag Boville, lui meme venant de...
-
-        IF (1==1) THEN
-          snstable = 1. - zlev(igrid, ilev)/(700.*max(ustar(igrid),0.0001))
-          snstable = 1. - zlev(igrid, ilev)/400.
-          snstable = max(snstable, 0.)
-          snstable = snstable*snstable
-
-          ! abde      print*,'SN ',ilev,sn(1,ilev),snstable
-          IF (sn(igrid,ilev)<snstable) THEN
-            sn(igrid, ilev) = snstable
-            snq2(igrid, ilev) = 0.
-          END IF
-
-          IF (sm(igrid,ilev)<snstable) THEN
-            sm(igrid, ilev) = snstable
-            smq2(igrid, ilev) = 0.
-          END IF
-
-        END IF
-
-        ! sn : coefficient de stabilite pour n
-        kn(igrid, ilev) = long(igrid, ilev)*q(igrid, ilev)*sn(igrid, ilev)
-        km(igrid, ilev) = long(igrid, ilev)*q(igrid, ilev)
-
-      END DO
-    END DO
-    ! print*,'Q2km1 ',(km(1,ilev),ilev=1,10)
-
-  END IF
-
-  RETURN
-END SUBROUTINE vdif_kcay
+link ../phylmd/vdif_kcay.F90
Index: LMDZ6/trunk/libf/phylmdiso/write_bilKP_ave.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/write_bilKP_ave.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/write_bilKP_ave.h	(revision 3940)
@@ -1,155 +1,1 @@
-c
-c $Header$
-c
-      IF (ok_journe) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-c
-c Champs 2D:
-c
-      itau_w = itau_phy + itap + start_time * day_step / iphysiq
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, ue_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"ue",itau_w,ue_lay)
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, ve_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"ve",itau_w,ve_lay)
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, uq_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"uq",itau_w,uq_lay)
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, vq_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"vq",itau_w,vq_lay)
-c
-c Champs 3D:
-C
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"temp",itau_w,t_seri)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"ovap",itau_w,qx(:,:,ivap))
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"geop",itau_w,zphi)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"vitu",itau_w,u_seri)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"vitv",itau_w,v_seri)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"vitw",itau_w,omega)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"pres",itau_w,pplay)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, paprs, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"play",itau_w,paprs)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"oliq",itau_w,cldliq)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtdyn",itau_w,d_t_dyn)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqdyn",itau_w,d_q_dyn)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtcon",itau_w,d_t_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"ducon",itau_w,d_u_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dvcon",itau_w,d_v_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqcon",itau_w,d_q_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtlsc",itau_w,d_t_lsc)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqlsc",itau_w,d_q_lsc)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtvdf",itau_w,d_t_vdf)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqvdf",itau_w,d_q_vdf)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtajs",itau_w,d_t_ajs)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqajs",itau_w,d_q_ajs)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dteva",itau_w,d_t_eva)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqeva",itau_w,d_q_eva)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtswr",itau_w,heat)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtsw0",itau_w,heat0)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtlwr",itau_w,cool)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtlw0",itau_w,cool0)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"duvdf",itau_w,d_u_vdf)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dvvdf",itau_w,d_v_vdf)
-c
-      IF (ok_orodr) THEN
-      IF (ok_orolf) THEN
-c
-      DO k = 1, klev
-      DO i = 1, klon
-        d_u_oli(i,k) = d_u_oro(i,k) + d_u_lif(i,k)
-        d_v_oli(i,k) = d_v_oro(i,k) + d_v_lif(i,k)
-      ENDDO
-      ENDDO
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oli, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"duoli",d_u_oli)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oli, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dvoli",itau_w,d_v_oli)
-c
-      ENDIF
-      ENDIF
-C
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"duphy",itau_w,d_u)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dvphy",itau_w,d_v)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dtphy",itau_w,d_t)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_qx(:,:,1), 
-cymf     .zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqphy",itau_w,d_qx(:,:,1))
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_qx(:,:,2), 
-cym     .zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPave,"dqlphy",itau_w,d_qx(:,:,2))
-c
-C
-      if (ok_sync) then
-        call histsync(nid_bilKPave)
-      endif
-       ENDIF
-
+link ../phylmd/write_bilKP_ave.h
Index: LMDZ6/trunk/libf/phylmdiso/write_bilKP_ins.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/write_bilKP_ins.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/write_bilKP_ins.h	(revision 3940)
@@ -1,179 +1,1 @@
- c
-c $Header$
-c
-      IF (ok_journe) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-c
-      itau_w = itau_phy + itap + start_time * day_step / iphysiq
-c
-c Champs 3D:
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, ue_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"ue",itau_w,ue_lay)
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, ve_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"ve",itau_w,ve_lay)
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, uq_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"uq",itau_w,uq_lay)
-c
-cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, vq_lay,zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"vq",itau_w,vq_lay)
-c
-c Champs 3D:
-C
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"temp",itau_w,t_seri)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"ovap",itau_w,qx(:,:,ivap))
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"geop",itau_w,zphi)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"vitu",itau_w,u_seri)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"vitv",itau_w,v_seri)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"vitw",itau_w,omega)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"pres",itau_w,pplay)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, paprs, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"play",itau_w,paprs)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"oliq",itau_w,cldliq)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtdyn",itau_w,d_t_dyn)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqdyn",itau_w,d_q_dyn)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtcon",itau_w,d_t_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"ducon",itau_w,d_u_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dvcon",itau_w,d_v_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqcon",itau_w,d_q_con)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtlsc",itau_w,d_t_lsc)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqlsc",itau_w,d_q_lsc)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtvdf",itau_w,d_t_vdf)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqvdf",itau_w,d_q_vdf)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtajs",itau_w,d_t_ajs)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqajs",itau_w,d_q_ajs)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dteva",itau_w,d_t_eva)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqeva",itau_w,d_q_eva)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtswr",itau_w,heat)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtsw0",itau_w,heat0)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtlwr",itau_w,cool)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtlw0",itau_w,cool0)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"duvdf",itau_w,d_u_vdf)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dvvdf",itau_w,d_v_vdf)
-c
-      IF (ok_orodr) THEN
-      IF (ok_orolf) THEN
-c
-      DO k = 1, klev
-      DO i = 1, klon
-        d_u_oli(i,k) = d_u_oro(i,k) + d_u_lif(i,k)
-        d_v_oli(i,k) = d_v_oro(i,k) + d_v_lif(i,k)
-      ENDDO
-      ENDDO
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oli, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"duoli",itau_w,d_u_oli)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oli, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dvoli",itau_w,d_v_oli)
-c
-      ENDIF
-      ENDIF
-C
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"duphy",itau_w,d_u)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dvphy",itau_w,d_v)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dtphy",itau_w,d_t)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_qx(:,:,1), 
-cym     .zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqphy",itau_w,d_qx(:,:,1))
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_qx(:,:,2), 
-cym     .zx_tmp_3d)
-      CALL histwrite_phy(nid_bilKPins,"dqlphy",itau_w,d_qx(:,:,2))
-c
-cIM 280405 BEG
-c
-c Champs 2D:
-c
-c   Ecriture de champs dynamiques sur des niveaux de pression
-c     DO k=1, nlevSTD
-      DO k=1, 12
-c
-       IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
-       IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
-c
-       IF(bb2.EQ."850") THEN
-c
-cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1,usumSTD(:,k,1),zx_tmp_2d)
-        CALL histwrite_phy(nid_bilKPins,"u"//bb2,itau_w,usumSTD(:,k,1))
-c
-cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1,vsumSTD(:,k,1),zx_tmp_2d)
-        CALL histwrite_phy(nid_bilKPins,"v"//bb2,itau_w,vsumSTD(:,k,1))
-c
-       ENDIF !(bb2.EQ."850")
-c
-       ENDDO !k=1, 12
-c
-cIM 280405 END
-C
-      if (ok_sync) then
-        call histsync(nid_bilKPins)
-      endif
-       ENDIF
-
+link ../phylmd/write_bilKP_ins.h
Index: LMDZ6/trunk/libf/phylmdiso/write_histREGDYN.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/write_histREGDYN.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/write_histREGDYN.h	(revision 3940)
@@ -1,63 +1,1 @@
-!
-! $Header$
-!
-      if (ok_regdyn) then
-      
-      if (is_sequential) then
-
-
-      ndex3d = 0
-      itau_w = itau_phy + itap + start_time * day_step / iphysiq
-c
-       CALL histwrite(nid_regdyn,"hw1",itau_w,histoW(:,:,:,1),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nh1",itau_w,nhistoW(:,:,:,1),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nht1",itau_w,nhistoWt(:,:,:,1),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"hw2",itau_w,histoW(:,:,:,2),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nh2",itau_w,nhistoW(:,:,:,2),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nht2",itau_w,nhistoWt(:,:,:,2),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"hw3",itau_w,histoW(:,:,:,3),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nh3",itau_w,nhistoW(:,:,:,3),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nht3",itau_w,nhistoWt(:,:,:,3),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"hw4",itau_w,histoW(:,:,:,4),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nh4",itau_w,nhistoW(:,:,:,4),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nht4",itau_w,nhistoWt(:,:,:,4),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"hw5",itau_w,histoW(:,:,:,5),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nh5",itau_w,nhistoW(:,:,:,5),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-c
-       CALL histwrite(nid_regdyn,"nht5",itau_w,nhistoWt(:,:,:,5),
-     &               kmaxm1*lmaxm1*iwmax,ndex3d)
-
-      if (ok_sync) then
-        call histsync(nid_regdyn)
-      endif
-
-      endif ! is_sequential
-
-      endif
+link ../phylmd/write_histREGDYN.h
Index: LMDZ6/trunk/libf/phylmdiso/write_histday_seri.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/write_histday_seri.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/write_histday_seri.h	(revision 3940)
@@ -1,165 +1,1 @@
-!
-! $Header$
-!
-      IF (is_sequential) THEN
-      
-      IF (type_run.EQ."AMIP") THEN
-!
-      ndex2d = 0
-      itau_w = itau_phy + itap + start_time * day_step_phy
-!
-! Champs 2D:
-!
-      pi = ACOS(-1.)
-      pir = 4.0*ATAN(1.0) / 180.0
-!
-      DO i=1, klon
-       zx_tmp_fi2d(i)=(topsw(i)-toplw(i))
-      ENDDO
-!
-      ok_msk=.FALSE.
-      msk(1:klon)=pctsrf(1:klon,is_ter)
-      CALL moyglo_pondaire(klon, zx_tmp_fi2d, cell_area,  &
-           ok_msk, msk, moyglo)
-      zx_tmp_fi2d(1:klon)=moyglo
-!
-      CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"bilTOA",itau_w, &
-                     zx_tmp_2d,nbp_lon*nbp_lat,ndex2d)
-!
-      ok_msk=.FALSE.
-      CALL moyglo_pondaire(klon, bils, cell_area,  &
-           ok_msk, msk, moyglo)
-      zx_tmp_fi2d(1:klon)=moyglo
-!
-      CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"bils",itau_w, &
-                     zx_tmp_2d,nbp_lon*nbp_lat,ndex2d)
-!
-      DO k=1, klev
-      DO i=1, klon
-!IM 080904    zx_tmp_fi3d(i,k)=u(i,k)**2+v(i,k)**2
-       zx_tmp_fi3d(i,k)=(u(i,k)**2+v(i,k)**2)/2.
-      ENDDO
-      ENDDO
-!
-      CALL moyglo_pondaima(klon, klev, zx_tmp_fi3d,  &
-           cell_area, paprs, moyglo)
-      zx_tmp_fi2d(1:klon)=moyglo
-!
-      CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"ecin",itau_w, &
-                     zx_tmp_2d,nbp_lon*nbp_lat,ndex2d) 
-!
-!
-!
-      CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,cell_area,zx_tmp_2d)
-      airetot=0.
-      DO i=1, klon
-       airetot=airetot+cell_area(i)
-      ENDDO
-!     IF(itap.EQ.1) PRINT*,'airetotphy=',airetot
-!
-      airetot=0.
-      DO j=1, nbp_lat
-       DO i=1, nbp_lon
-        airetot=airetot+zx_tmp_2d(i,j)
-       ENDDO
-      ENDDO
-!
-!     IF(itap.EQ.1) PRINT*,'airetotij=',airetot,
-!    $ '4piR2',4.*pi*RA*RA
-!
-      zx_tmp_fi2d(1:klon)=aam/airetot
-      CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"momang",itau_w,zx_tmp_2d, &
-                     nbp_lon*nbp_lat,ndex2d)
-!
-      zx_tmp_fi2d(1:klon)=torsfc/airetot
-      CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"torsfc",itau_w,zx_tmp_2d, &
-                     nbp_lon*nbp_lat,ndex2d)
-!
-!IM 151004 END
-!
-      CALL moyglo_pondmass(klon, klev, t_seri, &
-           cell_area, paprs, moyglo)
-      zx_tmp_fi2d(1:klon)=moyglo
-!
-      CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"tamv",itau_w, &
-                     zx_tmp_2d,nbp_lon*nbp_lat,ndex2d)
-!
-      ok_msk=.FALSE.
-      CALL moyglo_pondaire(klon, paprs(:,1), cell_area,  &
-           ok_msk, msk, moyglo)
-      zx_tmp_fi2d(1:klon)=moyglo
-!
-      CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"psol",itau_w, &
-                     zx_tmp_2d,nbp_lon*nbp_lat,ndex2d)
-!
-      ok_msk=.FALSE.
-      CALL moyglo_pondaire(klon, evap, cell_area,  &
-           ok_msk, msk, moyglo)
-      zx_tmp_fi2d(1:klon)=moyglo
-!
-      CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"evap",itau_w, &
-                     zx_tmp_2d,nbp_lon*nbp_lat,ndex2d)
-!
-!     DO i=1, klon
-!      zx_tmp_fi2d(i)=SnowFrac(i,is_ter)
-!     ENDDO
-!
-!     ok_msk=.TRUE.
-!     msk(1:klon)=pctsrf(1:klon,is_ter)
-!     CALL moyglo_pondaire(klon, zx_tmp_fi2d, cell_area, 
-!    .                     ok_msk, msk, moyglo)
-!     zx_tmp_fi2d(1:klon)=moyglo
-!
-!     CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat,zx_tmp_fi2d,zx_tmp_2d)
-!     CALL histwrite(nid_day_seri,"SnowFrac",
-!    .               itau_w,zx_tmp_2d,nbp_lon*nbp_lat,ndex2d) 
-!
-!     DO i=1, klon
-!IM 080904    zx_tmp_fi2d(i)=zsnow_mass(i)/330.*rowl
-!      zx_tmp_fi2d(i)=zsnow_mass(i)
-!     ENDDO
-!
-!IM 140904   ok_msk=.FALSE.
-!     ok_msk=.TRUE.
-!     msk(1:klon)=pctsrf(1:klon,is_ter)
-!     CALL moyglo_pondaire(klon, zx_tmp_fi2d, cell_area, 
-!    .     ok_msk, msk, moyglo)
-!     zx_tmp_fi2d(1:klon)=moyglo
-!
-!     CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat,zx_tmp_fi2d,zx_tmp_2d)
-!     CALL histwrite(nid_day_seri,"snow_depth",itau_w,
-!    .               zx_tmp_2d,nbp_lon*nbp_lat,ndex2d)
-!
-      DO i=1, klon
-       zx_tmp_fi2d(i)=ftsol(i,is_oce)
-      ENDDO
-!
-      ok_msk=.TRUE.
-      msk(1:klon)=pctsrf(1:klon,is_oce)
-      CALL moyglo_pondaire(klon, zx_tmp_fi2d, cell_area,  &
-           ok_msk, msk, moyglo)
-      zx_tmp_fi2d(1:klon)=moyglo
-!
-      CALL gr_fi_ecrit(1, klon,nbp_lon,nbp_lat, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day_seri,"tsol_"//clnsurf(is_oce), &
-                     itau_w,zx_tmp_2d,nbp_lon*nbp_lat,ndex2d) 
-!
-!=================================================================
-!=================================================================
-!=================================================================
-!
-      if (ok_sync) then
-        call histsync(nid_day_seri)
-      endif
-!
-      ENDIF !fin test sur type_run.EQ."AMIP"
-      
-      ENDIF  ! mono_cpu
+link ../phylmd/write_histday_seri.h
Index: LMDZ6/trunk/libf/phylmdiso/write_histrac.h
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/write_histrac.h	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/write_histrac.h	(revision 3940)
@@ -1,126 +1,1 @@
-!$Id $
-!***************************************
-!  ECRITURE DU FICHIER :  histrac.nc
-!***************************************
-  IF (ecrit_tra > 0.) THEN
-     
-     itau_w = itau_phy + nstep + start_time * day_step / iphysiq
-     
-     CALL histwrite_phy(nid_tra,.FALSE.,"phis",itau_w,pphis)
-     CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w,cell_area)
-     CALL histwrite_phy(nid_tra,.FALSE.,"zmasse",itau_w,zmasse)
-! RomP >>>
-     CALL histwrite_phy(nid_tra,.FALSE.,"sourceBE",itau_w,sourceBE)
-! RomP <<<
-
-!TRACEURS
-!----------------
-     DO it=1,nbtr
-!!        iiq=niadv(it+2)                                                           ! jyg
-        iiq=niadv(it+nqo)                                                           ! jyg
-
-! CONCENTRATIONS
-        CALL histwrite_phy(nid_tra,.FALSE.,tname(iiq),itau_w,tr_seri(:,:,it))
-
-! TD LESSIVAGE       
-      IF (lessivage .AND. aerosol(it)) THEN
-        CALL histwrite_phy(nid_tra,.FALSE.,"fl"//tname(iiq),itau_w,flestottr(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_ls_"//tname(iiq),itau_w,d_tr_ls(:,:,it))
-        IF(iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) then
-          CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_insc_"//tname(iiq),itau_w,d_tr_insc(:,:,it))
-          CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_bcscav_"//tname(iiq),itau_w,d_tr_bcscav(:,:,it))
-          CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_evls_"//tname(iiq),itau_w,d_tr_evapls(:,:,it))
-          CALL histwrite_phy(nid_tra,.FALSE.,"qpr_ls_"//tname(iiq),itau_w,qPrls(:,it))
-        ENDIF
-      ENDIF
-
-! TD THERMIQUES
-        IF (iflag_thermals.gt.0) THEN
-           CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_th_"//tname(iiq),itau_w,d_tr_th(:,:,it))
-        ENDIF
-
-! TD CONVECTION
-        IF (iflag_con.GE.2) THEN
-           CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_cv_"//tname(iiq),itau_w,d_tr_cv(:,:,it))
-        ENDIF
-
-! TD COUCHE-LIMITE
-      IF (iflag_vdf_trac>=0) THEN
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_cl_"//tname(iiq),itau_w,d_tr_cl(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_dry_"//tname(iiq),itau_w,d_tr_dry(:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"flux_tr_dry_"//tname(iiq),itau_w,flux_tr_dry(:,it))
-      ENDIF
-
-! TD radio-decroissance
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_dec_"//tname(iiq),itau_w,d_tr_dec(:,:,it))
-
-! RomP >>>
-        IF (iflag_con.EQ.30) THEN
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_cvMA_"//tname(iiq),itau_w,dtrcvMA(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_trsp_"//tname(iiq),itau_w,d_tr_trsp(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_sscav_"//tname(iiq),itau_w,d_tr_sscav(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_sat_"//tname(iiq),itau_w,d_tr_sat(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_uscav_"//tname(iiq),itau_w,d_tr_uscav(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"tr_pr_"//tname(iiq),itau_w,qPr(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"tr_aa_"//tname(iiq),itau_w,qPa(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"tr_mel_"//tname(iiq),itau_w,qMel(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"tr_di_"//tname(iiq),itau_w,qDi(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"tr_trspdi_"//tname(iiq),itau_w,qTrdi(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"zmfd1a_"//tname(iiq),itau_w,zmfd1a(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"zmfphi2_"//tname(iiq),itau_w,zmfphi2(:,:,it))
-        CALL histwrite_phy(nid_tra,.FALSE.,"zmfdam_"//tname(iiq),itau_w,zmfdam(:,:,it))
-        ENDIF
-        CALL histwrite_phy(nid_tra,.FALSE.,"dtrdyn_"//tname(iiq),itau_w,d_tr_dyn(:,:,it))
-! RomP <<<
-     ENDDO
-!---------------
-!
-!
-! VENT (niveau 1)   
-     CALL histwrite_phy(nid_tra,.FALSE.,"pyu1",itau_w,yu1)
-     CALL histwrite_phy(nid_tra,.FALSE.,"pyv1",itau_w,yv1)
-!
-! TEMPERATURE DU SOL
-     zx_tmp_fi2d(:)=ftsol(:,1)         
-     CALL histwrite_phy(nid_tra,.FALSE.,"ftsol1",itau_w,zx_tmp_fi2d)
-     zx_tmp_fi2d(:)=ftsol(:,2)
-     CALL histwrite_phy(nid_tra,.FALSE.,"ftsol2",itau_w,zx_tmp_fi2d)
-     zx_tmp_fi2d(:)=ftsol(:,3)
-     CALL histwrite_phy(nid_tra,.FALSE.,"ftsol3",itau_w,zx_tmp_fi2d)
-     zx_tmp_fi2d(:)=ftsol(:,4)
-     CALL histwrite_phy(nid_tra,.FALSE.,"ftsol4",itau_w,zx_tmp_fi2d)
-!      
-! NATURE DU SOL
-     zx_tmp_fi2d(:)=pctsrf(:,1)
-     CALL histwrite_phy(nid_tra,.FALSE.,"psrf1",itau_w,zx_tmp_fi2d)
-     zx_tmp_fi2d(:)=pctsrf(:,2)
-     CALL histwrite_phy(nid_tra,.FALSE.,"psrf2",itau_w,zx_tmp_fi2d)
-     zx_tmp_fi2d(:)=pctsrf(:,3)
-     CALL histwrite_phy(nid_tra,.FALSE.,"psrf3",itau_w,zx_tmp_fi2d)
-     zx_tmp_fi2d(:)=pctsrf(:,4)
-     CALL histwrite_phy(nid_tra,.FALSE.,"psrf4",itau_w,zx_tmp_fi2d)
- 
-! DIVERS    
-     CALL histwrite_phy(nid_tra,.FALSE.,"Mint",itau_w,Mint(:,:))
-     CALL histwrite_phy(nid_tra,.FALSE.,"frac_impa",itau_w,frac_impa(:,:))    
-     CALL histwrite_phy(nid_tra,.FALSE.,"frac_nucl",itau_w,frac_nucl(:,:))
-
-
-     CALL histwrite_phy(nid_tra,.FALSE.,"pplay",itau_w,pplay)     
-     CALL histwrite_phy(nid_tra,.FALSE.,"T",itau_w,t_seri)     
-     CALL histwrite_phy(nid_tra,.FALSE.,"mfu",itau_w,pmfu)
-     CALL histwrite_phy(nid_tra,.FALSE.,"mfd",itau_w,pmfd)
-     CALL histwrite_phy(nid_tra,.FALSE.,"en_u",itau_w,pen_u)
-     CALL histwrite_phy(nid_tra,.FALSE.,"en_d",itau_w,pen_d)
-     CALL histwrite_phy(nid_tra,.FALSE.,"de_d",itau_w,pde_d)
-     CALL histwrite_phy(nid_tra,.FALSE.,"de_u",itau_w,pde_u)
-     CALL histwrite_phy(nid_tra,.FALSE.,"coefh",itau_w,coefh)
-
-     IF (ok_sync) THEN
-!$OMP MASTER
-        CALL histsync(nid_tra)
-!$OMP END MASTER
-     ENDIF
-
-  ENDIF !ecrit_tra>0.
-
+link ../phylmd/write_histrac.h
Index: LMDZ6/trunk/libf/phylmdiso/wx_pbl_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/wx_pbl_mod.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/wx_pbl_mod.F90	(revision 3940)
@@ -1,479 +1,1 @@
-MODULE wx_pbl_mod
-!
-! Planetary Boundary Layer and Surface module
-!
-! This module manage the calculation of turbulent diffusion in the boundary layer 
-! and all interactions towards the differents sub-surfaces.
-!
-!
-  USE dimphy
-
-  IMPLICIT NONE
-
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Tp, Kech_T_xp, Kech_T_wp
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KTp, KxKwTp, dd_AT, dd_BT
-!$OMP THREADPRIVATE(Kech_Tp, Kech_T_xp, Kech_T_wp, dd_KTp, KxKwTp, dd_AT, dd_BT)
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Qp, Kech_Q_xp, Kech_Q_wp
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KQp, KxKwQp, dd_AQ, dd_BQ
-!$OMP THREADPRIVATE(Kech_Qp, Kech_Q_xp, Kech_Q_wp, dd_KQp, KxKwQp, dd_AQ, dd_BQ)
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Up, Kech_U_xp, Kech_U_wp
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KUp, KxKwUp, dd_AU, dd_BU
-!$OMP THREADPRIVATE(Kech_Up, Kech_U_xp, Kech_U_wp, dd_KUp, KxKwUp, dd_AU, dd_BU)
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Vp, Kech_V_xp, Kech_V_wp
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KVp, KxKwVp, dd_AV, dd_BV
-!$OMP THREADPRIVATE(Kech_Vp, Kech_V_xp, Kech_V_wp, dd_KVp, KxKwVp, dd_AV, dd_BV)
-
-CONTAINS
-!
-!****************************************************************************************
-!
-SUBROUTINE wx_pbl_init
-
-! Local variables
-!****************************************************************************************
-    INTEGER                       :: ierr
- 
-
-!****************************************************************************************
-! Allocate module variables
-!
-!****************************************************************************************    
-
-    ierr = 0
-
-    ALLOCATE(Kech_Tp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_T_xp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_T_wp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_KTp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(KxKwTp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_AT(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_BT(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-!----------------------------------------------------------------------------
-    ALLOCATE(Kech_Qp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_Q_xp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_Q_wp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_KQp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(KxKwQp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_AQ(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_BQ(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-!----------------------------------------------------------------------------
-    ALLOCATE(Kech_Up(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_U_xp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_U_wp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_KUp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(KxKwUp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_AU(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_BU(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-!----------------------------------------------------------------------------
-    ALLOCATE(Kech_Vp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_V_xp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(Kech_V_wp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_KVp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(KxKwVp(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_AV(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-    ALLOCATE(dd_BV(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
-
-!----------------------------------------------------------------------------
-
-END SUBROUTINE wx_pbl_init
-
-SUBROUTINE wx_pbl0_fuse(knon, dtime, ypplay, ywake_s, &
-                                 yt_x, yt_w, yq_x, yq_w, &
-                                 yu_x, yu_w, yv_x, yv_w, &
-                                 ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
-                                 AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w, &
-                                 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
-                                 BcoefT_x, BcoefT_w, BcoefQ_x, BcoefQ_w, &
-                                 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
-                                 AcoefT, AcoefQ, AcoefU, AcoefV, &
-                                 BcoefT, BcoefQ, BcoefU, BcoefV, &
-                                 ycdragh, ycdragm, &
-                                 yt1, yq1, yu1, yv1 &
-#ifdef ISO
-                                ,yxt_x,yxt_w,yxt1 &
-#endif
-                         )
-!
-    USE print_control_mod, ONLY: prt_level,lunout
-
-#ifdef ISO
-  USE infotrac_phy, ONLY: ntraciso ! ajout C Risi pour isos  
-#endif
-!
-    INCLUDE "YOMCST.h"
-!
-    INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
-    REAL,                         INTENT(IN)        :: dtime   ! time step size (s)
-    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypplay  ! mid-layer pressure (Pa)
-    REAL, DIMENSION(knon),        INTENT(IN)        :: ywake_s ! cold pools fractional area
-    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: yt_x, yt_w, yq_x, yq_w
-    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: yu_x, yu_w, yv_x, yv_w
-    REAL, DIMENSION(knon),        INTENT(IN)        :: ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w
-    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w
-    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w
-    REAL, DIMENSION(knon),        INTENT(IN)        :: BcoefT_x, BcoefT_w, BcoefQ_x, BcoefQ_w
-    REAL, DIMENSION(knon),        INTENT(IN)        :: BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: AcoefT, AcoefQ, AcoefU, AcoefV
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: BcoefT, BcoefQ, BcoefU, BcoefV
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: ycdragh, ycdragm
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: yt1, yq1, yu1, yv1  ! Apparent T, q, u, v at first level, as
-                                                                           !seen by surface modules
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,knon,klev),   INTENT(IN)        :: yxt_x, yxt_w
-    REAL, DIMENSION(ntraciso,knon),        INTENT(OUT)       :: yxt1 
-#endif
-!
-! Local variables
-    INTEGER                    :: j
-    REAL                       :: rho1
-    REAL                       :: mod_wind_x
-    REAL                       :: mod_wind_w   
-    REAL                       :: dd_Cdragh
-    REAL                       :: dd_Cdragm
-    REAL                       :: dd_Kh
-    REAL                       :: dd_Km
-    REAL                       :: dd_u 
-    REAL                       :: dd_v 
-    REAL                       :: dd_t 
-    REAL                       :: dd_q 
-#ifdef ISO
-    REAL, DIMENSION(ntraciso)  :: dd_xt
-    integer                    :: ixt
-#endif
-!
-    REAL                       :: KCT, KCQ, KCU, KCV
-!
-    REAL                       :: BBT, BBQ, BBU, BBV
-    REAL                       :: DDT, DDQ, DDU, DDV
-    REAL                       :: LambdaT, LambdaQ, LambdaU, LambdaV 
-    REAL                       :: LambdaTs, LambdaQs, LambdaUs, LambdaVs 
-!
-    REAL, DIMENSION(knon)      :: sigx       ! fractional area of (x) region
-
-    REAL, DIMENSION(knon)      :: Kech_h    ! Energy exchange coefficient
-    REAL, DIMENSION(knon)      :: Kech_h_x, Kech_h_w
-    REAL, DIMENSION(knon)      :: Kech_m    ! Momentum exchange coefficient
-    REAL, DIMENSION(knon)      :: Kech_m_x, Kech_m_w
-
-!!!
-!!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences
-
-        sigx(:) = 1.-ywake_s(:)
-
-        DO j=1,knon
-!
-! Calcul des coefficients d echange
-         mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)
-         mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)
-!!         rho1 = ypplay(j,1)/(RD*yt(j,1))
-         rho1 = ypplay(j,1)/(RD*(yt_x(j,1) + ywake_s(j)*(yt_w(j,1)-yt_x(j,1))))
-         Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1
-         Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1
-         Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1
-         Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1
-!
-         dd_Kh = Kech_h_w(j) - Kech_h_x(j)
-         dd_Km = Kech_m_w(j) - Kech_m_x(j)
-         IF (prt_level >=10) THEN
-          print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w
-          print *,' rho1 ',rho1
-          print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j)
-          print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j)
-          print *,' dd_Kh: ',dd_Kh
-         ENDIF
-!
-         Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh
-         Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km
-!
-! Calcul des coefficients d echange corriges des retroactions
-        Kech_T_xp(j) = Kech_h_x(j)/(1.-BcoefT_x(j)*Kech_h_x(j)*dtime)
-        Kech_T_wp(j) = Kech_h_w(j)/(1.-BcoefT_w(j)*Kech_h_w(j)*dtime)
-        Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime)
-        Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime)
-        Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime)
-        Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime)
-        Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime)
-        Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime)
-!
-         dd_KTp(j) = Kech_T_wp(j) - Kech_T_xp(j)
-         dd_KQp(j) = Kech_Q_wp(j) - Kech_Q_xp(j)
-         dd_KUp(j) = Kech_U_wp(j) - Kech_U_xp(j)
-         dd_KVp(j) = Kech_V_wp(j) - Kech_V_xp(j)
-!
-        Kech_Tp(j) = Kech_T_xp(j) + ywake_s(j)*dd_KTp(j)
-        Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp(j)
-        Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp(j)
-        Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp(j)
-!
-! Calcul des differences w-x
-       dd_Cdragm = ycdragm_w(j) - ycdragm_x(j)
-       dd_Cdragh = ycdragh_w(j) - ycdragh_x(j)
-       dd_u = yu_w(j,1) - yu_x(j,1)
-       dd_v = yv_w(j,1) - yv_x(j,1)
-       dd_t = yt_w(j,1) - yt_x(j,1)
-       dd_q = yq_w(j,1) - yq_x(j,1)
-#ifdef ISO
-       do ixt=1,ntraciso
-         dd_xt(ixt) = yxt_w(ixt,j,1) - yxt_x(ixt,j,1)
-       enddo !do ixt=1,ntraciso
-#endif
-       dd_AT(j) = AcoefT_w(j) - AcoefT_x(j)
-       dd_AQ(j) = AcoefQ_w(j) - AcoefQ_x(j)
-       dd_AU(j) = AcoefU_w(j) - AcoefU_x(j)
-       dd_AV(j) = AcoefV_w(j) - AcoefV_x(j)
-       dd_BT(j) = BcoefT_w(j) - BcoefT_x(j)
-       dd_BQ(j) = BcoefQ_w(j) - BcoefQ_x(j)
-       dd_BU(j) = BcoefU_w(j) - BcoefU_x(j)
-       dd_BV(j) = BcoefV_w(j) - BcoefV_x(j)
-!
-       KxKwTp(j) = Kech_T_xp(j)*Kech_T_wp(j)
-       KxKwQp(j) = Kech_Q_xp(j)*Kech_Q_wp(j)
-       KxKwUp(j) = Kech_U_xp(j)*Kech_U_wp(j)
-       KxKwVp(j) = Kech_V_xp(j)*Kech_V_wp(j)
-       BBT = (BcoefT_x(j) + sigx(j)*dd_BT(j))*dtime
-       BBQ = (BcoefQ_x(j) + sigx(j)*dd_BQ(j))*dtime
-       BBU = (BcoefU_x(j) + sigx(j)*dd_BU(j))*dtime
-       BBV = (BcoefV_x(j) + sigx(j)*dd_BV(j))*dtime
-       KCT = Kech_h(j)
-       KCQ = Kech_h(j)
-       KCU = Kech_m(j)
-       KCV = Kech_m(j)
-       DDT = Kech_Tp(j)
-       DDQ = Kech_Qp(j)
-       DDU = Kech_Up(j)
-       DDV = Kech_Vp(j)
-       LambdaT = dd_Kh/KCT
-       LambdaQ = dd_Kh/KCQ
-       LambdaU = dd_Km/KCU
-       LambdaV = dd_Km/KCV
-       LambdaTs = dd_KTp(j)/DDT
-       LambdaQs = dd_KQp(j)/DDQ
-       LambdaUs = dd_KUp(j)/DDU
-       LambdaVs = dd_KVp(j)/DDV
-!
-       IF (prt_level >=10) THEN
-          print *,'Variables pour la fusion : Kech_T_xp(j)' ,Kech_T_xp(j)
-          print *,'Variables pour la fusion : Kech_T_wp(j)' ,Kech_T_wp(j)
-          print *,'Variables pour la fusion : Kech_Tp(j)' ,Kech_Tp(j)
-          print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j)
-       ENDIF
-!
-! Calcul des coef A, B \'equivalents dans la couche 1
-!
-       AcoefT(j) = AcoefT_x(j) + ywake_s(j)*dd_AT(j)*(1.+sigx(j)*LambdaTs)
-       AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*dd_AQ(j)*(1.+sigx(j)*LambdaQs)
-       AcoefU(j) = AcoefU_x(j) + ywake_s(j)*dd_AU(j)*(1.+sigx(j)*LambdaUs)
-       AcoefV(j) = AcoefV_x(j) + ywake_s(j)*dd_AV(j)*(1.+sigx(j)*LambdaVs)
-!                                           
-       BcoefT(j) = BcoefT_x(j) + ywake_s(j)*BcoefT_x(j)*sigx(j)*LambdaT*LambdaTs &
-                               + ywake_s(j)*dd_BT(j)*(1.+sigx(j)*LambdaT)*(1.+sigx(j)*LambdaTs)
-                                           
-       BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*sigx(j)*LambdaQ*LambdaQs &
-                               + ywake_s(j)*dd_BQ(j)*(1.+sigx(j)*LambdaQ)*(1.+sigx(j)*LambdaQs)
-                                           
-       BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*sigx(j)*LambdaU*LambdaUs &
-                               + ywake_s(j)*dd_BU(j)*(1.+sigx(j)*LambdaU)*(1.+sigx(j)*LambdaUs)
-                                           
-       BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*sigx(j)*LambdaV*LambdaVs &
-                               + ywake_s(j)*dd_BV(j)*(1.+sigx(j)*LambdaV)*(1.+sigx(j)*LambdaVs)
-
-!
-! Calcul des cdrag \'equivalents dans la couche 
-!
-       ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_Cdragm
-       ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_Cdragh
-!
-! Calcul de T, q, u et v \'equivalents dans la couche 1
-!!       yt1(j) = yt_x(j,1) + ywake_s(j)*dd_t*(1.+sigx(j)*dd_Kh/KCT)
-!!       yq1(j) = yq_x(j,1) + ywake_s(j)*dd_q*(1.+sigx(j)*dd_Kh/KCQ)
-!!       yu1(j) = yu_x(j,1) + ywake_s(j)*dd_u*(1.+sigx(j)*dd_Km/KCU)
-!!       yv1(j) = yv_x(j,1) + ywake_s(j)*dd_v*(1.+sigx(j)*dd_Km/KCV)
-       yt1(j) = yt_x(j,1) + ywake_s(j)*dd_t
-       yq1(j) = yq_x(j,1) + ywake_s(j)*dd_q
-       yu1(j) = yu_x(j,1) + ywake_s(j)*dd_u
-       yv1(j) = yv_x(j,1) + ywake_s(j)*dd_v
-#ifdef ISO
-       yxt1(ixt,j) = yxt_x(ixt,j,1) + ywake_s(j)*dd_xt(ixt)
-#endif
-
-
-        ENDDO
-
-        RETURN
-
-END SUBROUTINE wx_pbl0_fuse
-
-SUBROUTINE wx_pbl0_split(knon, dtime, ywake_s, &
-                       y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
-                       y_flux_t1_x, y_flux_t1_w, &
-                       y_flux_q1_x, y_flux_q1_w, &
-                       y_flux_u1_x, y_flux_u1_w, &
-                       y_flux_v1_x, y_flux_v1_w, &
-                       yfluxlat_x, yfluxlat_w, &
-                       y_delta_tsurf &
-                       )
-!
-    USE print_control_mod, ONLY: prt_level,lunout
-!
-    INCLUDE "YOMCST.h"
-!
-    INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
-    REAL,                         INTENT(IN)        :: dtime   ! time step size (s)
-    REAL, DIMENSION(knon),        INTENT(IN)        :: ywake_s ! cold pools fractional area
-    REAL, DIMENSION(knon),        INTENT(IN)        :: y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1
-!
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_t1_x, y_flux_t1_w
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_q1_x, y_flux_q1_w
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_u1_x, y_flux_u1_w
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_v1_x, y_flux_v1_w
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: yfluxlat_x, yfluxlat_w
-    REAL, DIMENSION(knon),        INTENT(OUT)       :: y_delta_tsurf
-!
-!! Local variables
-    INTEGER                    :: j
-    REAL, DIMENSION(knon)      :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1
-!
-    REAL                       :: DDT, DDQ, DDU, DDV
-    REAL                       :: LambdaTs, LambdaQs, LambdaUs, LambdaVs 
-!
-    REAL, DIMENSION(knon)      :: sigx       ! fractional area of (x) region
-!!
-        sigx(:) = 1.-ywake_s(:)
-
-        DO j=1,knon
-!
-       DDT = Kech_Tp(j)
-       DDQ = Kech_Qp(j)
-       DDU = Kech_Up(j)
-       DDV = Kech_Vp(j)
-!
-       LambdaTs =  dd_KTp(j)/DDT
-       LambdaQs =  dd_KQp(j)/DDQ
-       LambdaUs =  dd_KUp(j)/DDU
-       LambdaVs =  dd_KVp(j)/DDV
-!
-         y_delta_flux_t1(j) = y_flux_t1(j)*LambdaTs + dd_AT(j)*KxKwTp(j)/DDT
-         y_delta_flux_q1(j) = y_flux_q1(j)*LambdaQs + dd_AQ(j)*KxKwQp(j)/DDQ
-         y_delta_flux_u1(j) = y_flux_u1(j)*LambdaUs + dd_AU(j)*KxKwUp(j)/DDU
-         y_delta_flux_v1(j) = y_flux_v1(j)*LambdaVs + dd_AV(j)*KxKwVp(j)/DDV
-!
-         y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j)
-         y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j)
-         y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j)
-         y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j)
-         y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j)
-         y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j)
-         y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j)
-         y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j)
-!
-         yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT
-         yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT
-!
-!       Delta_tsurf computation
-!!         y_delta_tsurf(j) = (1./RCPD)*(ah(j)*dd_AT(j) + &
-!!                                       ah(j)*y_flux_t1(j)*dd_BT(j)*dtime + &
-!!                                       y_delta_flux_t1(j)*(ah(j)*BBT+bh(j)) )
-!
-           y_delta_tsurf(j) = 0.
-!
-        ENDDO
-!
-        RETURN
-
-END SUBROUTINE wx_pbl0_split
-
-SUBROUTINE wx_pbl_final
-!
-!****************************************************************************************
-! Deallocate module variables
-!
-!****************************************************************************************    
-!
-    IF (ALLOCATED(Kech_Tp))        DEALLOCATE(Kech_Tp)
-    IF (ALLOCATED(Kech_T_xp))      DEALLOCATE(Kech_T_xp)
-    IF (ALLOCATED(Kech_T_wp))      DEALLOCATE(Kech_T_wp)
-    IF (ALLOCATED(dd_KTp))         DEALLOCATE(dd_KTp)
-    IF (ALLOCATED(KxKwTp))         DEALLOCATE(KxKwTp)
-    IF (ALLOCATED(dd_AT))          DEALLOCATE(dd_AT)
-    IF (ALLOCATED(dd_BT))          DEALLOCATE(dd_BT)
-    IF (ALLOCATED(Kech_Qp))        DEALLOCATE(Kech_Qp)
-    IF (ALLOCATED(Kech_Q_xp))      DEALLOCATE(Kech_Q_xp)
-    IF (ALLOCATED(Kech_Q_wp))      DEALLOCATE(Kech_Q_wp)
-    IF (ALLOCATED(dd_KQp))         DEALLOCATE(dd_KQp)
-    IF (ALLOCATED(KxKwQp))         DEALLOCATE(KxKwQp)
-    IF (ALLOCATED(dd_AQ))          DEALLOCATE(dd_AQ)
-    IF (ALLOCATED(dd_BQ))          DEALLOCATE(dd_BQ)
-    IF (ALLOCATED(Kech_Up))        DEALLOCATE(Kech_Up)
-    IF (ALLOCATED(Kech_U_xp))      DEALLOCATE(Kech_U_xp)
-    IF (ALLOCATED(Kech_U_wp))      DEALLOCATE(Kech_U_wp)
-    IF (ALLOCATED(dd_KUp))         DEALLOCATE(dd_KUp)
-    IF (ALLOCATED(KxKwUp))         DEALLOCATE(KxKwUp)
-    IF (ALLOCATED(dd_AU))          DEALLOCATE(dd_AU)
-    IF (ALLOCATED(dd_BU))          DEALLOCATE(dd_BU)
-    IF (ALLOCATED(Kech_Vp))        DEALLOCATE(Kech_Vp)
-    IF (ALLOCATED(Kech_V_xp))      DEALLOCATE(Kech_V_xp)
-    IF (ALLOCATED(Kech_V_wp))      DEALLOCATE(Kech_V_wp)
-    IF (ALLOCATED(KxKwVp))         DEALLOCATE(KxKwVp)
-    IF (ALLOCATED(dd_KVp))         DEALLOCATE(dd_KVp)
-    IF (ALLOCATED(dd_AV))          DEALLOCATE(dd_AV)
-    IF (ALLOCATED(dd_BV))          DEALLOCATE(dd_BV)
-
-END SUBROUTINE wx_pbl_final
-
-END MODULE wx_pbl_mod
-
+link ../phylmd/wx_pbl_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/wx_pbl_var_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/wx_pbl_var_mod.F90	(revision 3940)
+++ LMDZ6/trunk/libf/phylmdiso/wx_pbl_var_mod.F90	(revision 3940)
@@ -0,0 +1,1 @@
+link ../phylmd/wx_pbl_var_mod.F90
Index: LMDZ6/trunk/libf/phylmdiso/yamada.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/yamada.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/yamada.F90	(revision 3940)
@@ -1,169 +1,1 @@
-
-! $Header$
-
-SUBROUTINE yamada(ngrid, dt, g, rconst, plev, temp, zlev, zlay, u, v, teta, &
-    cd, q2, km, kn, ustar, l_mix)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! dt : pas de temps
-  ! g  : g
-  ! zlev : altitude a chaque niveau (interface inferieure de la couche
-  ! de meme indice)
-  ! zlay : altitude au centre de chaque couche
-  ! u,v : vitesse au centre de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! teta : temperature potentielle au centre de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! cd : cdrag
-  ! (en entree : la valeur au debut du pas de temps)
-  ! q2 : $q^2$ au bas de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! (en sortie : la valeur a la fin du pas de temps)
-  ! km : diffusivite turbulente de quantite de mouvement (au bas de chaque
-  ! couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-  ! kn : diffusivite turbulente des scalaires (au bas de chaque couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-
-  ! .......................................................................
-  REAL dt, g, rconst
-  REAL plev(klon, klev+1), temp(klon, klev)
-  REAL ustar(klon), snstable
-  REAL zlev(klon, klev+1)
-  REAL zlay(klon, klev)
-  REAL u(klon, klev)
-  REAL v(klon, klev)
-  REAL teta(klon, klev)
-  REAL cd(klon)
-  REAL q2(klon, klev+1)
-  REAL km(klon, klev+1)
-  REAL kn(klon, klev+1)
-  INTEGER l_mix, ngrid
-
-
-  INTEGER nlay, nlev
-  ! ym      PARAMETER (nlay=klev)
-  ! ym      PARAMETER (nlev=klev+1)
-
-  LOGICAL first
-  SAVE first
-  DATA first/.TRUE./
-  !$OMP THREADPRIVATE(first)
-
-  INTEGER ig, k
-
-  REAL ri, zrif, zalpha, zsm
-  REAL rif(klon, klev+1), sm(klon, klev+1), alpha(klon, klev)
-
-  REAL m2(klon, klev+1), dz(klon, klev+1), zq, n2(klon, klev+1)
-  REAL l(klon, klev+1), l0(klon)
-
-  REAL sq(klon), sqz(klon), zz(klon, klev+1)
-  INTEGER iter
-
-  REAL ric, rifc, b1, kap
-  SAVE ric, rifc, b1, kap
-  DATA ric, rifc, b1, kap/0.195, 0.191, 16.6, 0.3/
-  !$OMP THREADPRIVATE(ric,rifc,b1,kap)
-
-  REAL frif, falpha, fsm
-
-  frif(ri) = 0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
-  falpha(ri) = 1.318*(0.2231-ri)/(0.2341-ri)
-  fsm(ri) = 1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
-
-  nlay = klev
-  nlev = klev + 1
-
-  IF (0==1 .AND. first) THEN
-    DO ig = 1, 1000
-      ri = (ig-800.)/500.
-      IF (ri<ric) THEN
-        zrif = frif(ri)
-      ELSE
-        zrif = rifc
-      END IF
-      IF (zrif<0.16) THEN
-        zalpha = falpha(zrif)
-        zsm = fsm(zrif)
-      ELSE
-        zalpha = 1.12
-        zsm = 0.085
-      END IF
-      PRINT *, ri, rif, zalpha, zsm
-    END DO
-    first = .FALSE.
-  END IF
-
-  ! Correction d'un bug sauvage a verifier.
-  ! do k=2,nlev
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      dz(ig, k) = zlay(ig, k) - zlay(ig, k-1)
-      m2(ig, k) = ((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig, &
-        k-1))**2)/(dz(ig,k)*dz(ig,k))
-      n2(ig, k) = g*2.*(teta(ig,k)-teta(ig,k-1))/(teta(ig,k-1)+teta(ig,k))/ &
-        dz(ig, k)
-      ri = n2(ig, k)/max(m2(ig,k), 1.E-10)
-      IF (ri<ric) THEN
-        rif(ig, k) = frif(ri)
-      ELSE
-        rif(ig, k) = rifc
-      END IF
-      IF (rif(ig,k)<0.16) THEN
-        alpha(ig, k) = falpha(rif(ig,k))
-        sm(ig, k) = fsm(rif(ig,k))
-      ELSE
-        alpha(ig, k) = 1.12
-        sm(ig, k) = 0.085
-      END IF
-      zz(ig, k) = b1*m2(ig, k)*(1.-rif(ig,k))*sm(ig, k)
-    END DO
-  END DO
-
-  ! iterration pour determiner la longueur de melange
-
-  DO ig = 1, ngrid
-    l0(ig) = 100.
-  END DO
-  DO k = 2, klev - 1
-    DO ig = 1, ngrid
-      l(ig, k) = l0(ig)*kap*zlev(ig, k)/(kap*zlev(ig,k)+l0(ig))
-    END DO
-  END DO
-
-  DO iter = 1, 10
-    DO ig = 1, ngrid
-      sq(ig) = 1.E-10
-      sqz(ig) = 1.E-10
-    END DO
-    DO k = 2, klev - 1
-      DO ig = 1, ngrid
-        q2(ig, k) = l(ig, k)**2*zz(ig, k)
-        l(ig, k) = min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig, &
-          k)+l0(ig)), 0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.E-10)))
-        zq = sqrt(q2(ig,k))
-        sqz(ig) = sqz(ig) + zq*zlev(ig, k)*(zlay(ig,k)-zlay(ig,k-1))
-        sq(ig) = sq(ig) + zq*(zlay(ig,k)-zlay(ig,k-1))
-      END DO
-    END DO
-    DO ig = 1, ngrid
-      l0(ig) = 0.2*sqz(ig)/sq(ig)
-    END DO
-    ! (abd 3 5 2)         print*,'ITER=',iter,'  L0=',l0
-
-  END DO
-
-  DO k = 2, klev
-    DO ig = 1, ngrid
-      l(ig, k) = min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig, &
-        k)+l0(ig)), 0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.E-10)))
-      q2(ig, k) = l(ig, k)**2*zz(ig, k)
-      km(ig, k) = l(ig, k)*sqrt(q2(ig,k))*sm(ig, k)
-      kn(ig, k) = km(ig, k)*alpha(ig, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE yamada
+link ../phylmd/yamada.F90
Index: LMDZ6/trunk/libf/phylmdiso/yamada4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/yamada4.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/yamada4.F90	(revision 3940)
@@ -1,1159 +1,1 @@
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-SUBROUTINE yamada4(ni, nsrf, ngrid, dt, g, rconst, plev, temp, zlev, zlay, u, v, teta, &
-    cd, tke, km, kn, kq, ustar, iflag_pbl, drgpro)
-
-  USE dimphy
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-
-  IMPLICIT NONE
-  include "iniprint.h"
-  ! .......................................................................
-  ! ym#include "dimensions.h"
-  ! ym#include "dimphy.h"
-  ! ************************************************************************************************
-  !
-  ! yamada4: subroutine qui calcule le transfert turbulent avec une fermeture d'ordre 2 ou 2.5
-  ! 
-  ! Reference: Simulation of nocturnal drainage flows by a q2l Turbulence Closure Model
-  !            Yamada T.
-  !            J. Atmos. Sci, 40, 91-106, 1983
-  !
-  !************************************************************************************************
-  ! Input :
-  !'======
-  ! ni: indice horizontal sur la grille de base, non restreinte
-  ! nsrf: type de surface
-  ! ngrid: nombre de mailles concern??es sur l'horizontal
-  ! dt : pas de temps
-  ! g  : g
-  ! rconst: constante de l'air sec
-  ! zlev : altitude a chaque niveau (interface inferieure de la couche
-  ! de meme indice)
-  ! zlay : altitude au centre de chaque couche
-  ! u,v : vitesse au centre de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! teta : temperature potentielle virtuelle au centre de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! cd : cdrag pour la quantit?? de mouvement
-  ! (en entree : la valeur au debut du pas de temps)
-  ! ustar: vitesse de friction calcul??e par une formule diagnostique 
-  ! iflag_pbl: flag pour choisir des options du sch??ma de turbulence
-  !
-  !             iflag_pbl doit valoir entre 6 et 9
-  !             l=6, on prend  systematiquement une longueur d'equilibre
-  !             iflag_pbl=6 : MY 2.0
-  !             iflag_pbl=7 : MY 2.0.Fournier
-  !             iflag_pbl=8/9 : MY 2.5
-  !             iflag_pbl=8 with special obsolete treatments for convergence
-  !             with Cmpi5 NPv3.1 simulations
-  !             iflag_pbl=10/11 :  New scheme M2 and N2 explicit and dissiptation exact
-  !             iflag_pbl=12 = 11 with vertical diffusion off q2
-  !
-  !             2013/04/01 (FH hourdin@lmd.jussieu.fr)
-  !             Correction for very stable PBLs (iflag_pbl=10 and 11)
-  !             iflag_pbl=8 converges numerically with NPv3.1
-  !             iflag_pbl=11 -> the model starts with NP from start files created by ce0l
-  !                          -> the model can run with longer time-steps.
-  !             2016/11/30 (EV etienne.vignon@univ-grenoble-alpes.fr)
-  !               On met tke (=q2/2) en entr??e plut??t que q2
-  !               On corrige l'update de la tke
-  !
-  ! Inpout/Output :
-  !==============
-  ! tke : tke au bas de chaque couche
-  ! (en entree : la valeur au debut du pas de temps)
-  ! (en sortie : la valeur a la fin du pas de temps)
- 
-  ! Outputs:
-  !==========
-  ! km : diffusivite turbulente de quantite de mouvement (au bas de chaque
-  ! couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-  ! kn : diffusivite turbulente des scalaires (au bas de chaque couche)
-  ! (en sortie : la valeur a la fin du pas de temps)
-  !
-  !.......................................................................
-
-  !=======================================================================
-  ! Declarations:
-  !=======================================================================
-
-
-  ! Inputs/Outputs
-  !----------------
-  REAL dt, g, rconst
-  REAL plev(klon, klev+1), temp(klon, klev)
-  REAL ustar(klon)
-  REAL kmin, qmin, pblhmin(klon), coriol(klon)
-  REAL zlev(klon, klev+1)
-  REAL zlay(klon, klev)
-  REAL u(klon, klev)
-  REAL v(klon, klev)
-  REAL teta(klon, klev)
-  REAL cd(klon)
-  REAL tke(klon, klev+1)
-  REAL unsdz(klon, klev)
-  REAL unsdzdec(klon, klev+1)
-  REAL kn(klon, klev+1)
-  REAL km(klon, klev+1)
-  INTEGER iflag_pbl, ngrid, nsrf
-  INTEGER ni(klon)
-
-!FC
-  REAL drgpro(klon,klev)
-  REAL winds(klon,klev)
-
-  ! Local
-  !-------
-
-  INCLUDE "clesphys.h"
-
-  REAL q2(klon, klev+1)
-  REAL kmpre(klon, klev+1), tmp2, qpre
-  REAL mpre(klon, klev+1)
-  REAL kq(klon, klev+1)
-  REAL ff(klon, klev+1), delta(klon, klev+1)
-  REAL aa(klon, klev+1), aa0, aa1
-  INTEGER nlay, nlev
-
-  LOGICAL,SAVE :: hboville=.TRUE.
-  REAL,SAVE :: viscom,viscoh
-  !$OMP THREADPRIVATE( hboville,viscom,viscoh)
-  INTEGER ig, k
-  REAL ri, zrif, zalpha, zsm, zsn
-  REAL rif(klon, klev+1), sm(klon, klev+1), alpha(klon, klev)
-  REAL m2(klon, klev+1), dz(klon, klev+1), zq, n2(klon, klev+1)
-  REAL dtetadz(klon, klev+1)
-  REAL m2cstat, mcstat, kmcstat
-  REAL l(klon, klev+1)
-  REAL zz(klon, klev+1)
-  INTEGER iter
-  REAL dissip(klon,klev), tkeprov,tkeexp, shear(klon,klev), buoy(klon,klev)
-  REAL :: disseff
-
-  REAL,SAVE :: ric0,ric,rifc, b1, kap
-  !$OMP THREADPRIVATE(ric0,ric,rifc,b1,kap)
-  DATA b1, kap/16.6, 0.4/
-  REAL,SAVE :: seuilsm, seuilalpha
-  !$OMP THREADPRIVATE(seuilsm, seuilalpha)
-  REAL,SAVE :: lmixmin
-  !$OMP THREADPRIVATE(lmixmin)
-  LOGICAL, SAVE :: new_yamada4
-  INTEGER, SAVE :: yamada4_num
-  !$OMP THREADPRIVATE(new_yamada4,yamada4_num)
-  REAL, SAVE :: yun,ydeux
-  !$OMP THREADPRIVATE(yun,ydeux)
-
-  REAL frif, falpha, fsm
-  REAL rino(klon, klev+1), smyam(klon, klev), styam(klon, klev), &
-    lyam(klon, klev), knyam(klon, klev), w2yam(klon, klev), t2yam(klon, klev)
-  LOGICAL, SAVE :: firstcall = .TRUE.
-  !$OMP THREADPRIVATE(firstcall)
-
-  CHARACTER (len = 20) :: modname = 'yamada4'
-  CHARACTER (len = 80) :: abort_message
-
-
-
-  ! Fonctions utilis??es
-  !--------------------
-
-  frif(ri) = 0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
-  falpha(ri) = 1.318*(0.2231-ri)/(0.2341-ri)
-  fsm(ri) = 1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
-  
-
-  IF (firstcall) THEN
-! Seuil dans le code de turbulence 
-    new_yamada4=.false.
-    CALL getin_p('new_yamada4',new_yamada4)
-
-    IF (new_yamada4) THEN
-! Corrections et reglages issus du travail de these d'Etienne Vignon.
-       ric=0.143 ! qui donne des valeurs proches des seuils proposes
-                 ! dans YAMADA 1983 : sm=0.0845 (0.085 dans Y83)
-                 !                    sm=1.1213 (1.12  dans Y83)
-       CALL getin_p('yamada4_ric',ric)
-       ric0=0.19489      ! ric=0.195 originalement, mais produisait sm<0
-       ric=min(ric,ric0) ! Au dela de ric0, sm devient n??gatif
-       rifc=frif(ric)
-       seuilsm=fsm(frif(ric))
-       seuilalpha=falpha(frif(ric))
-       yun=1.
-       ydeux=2.
-       hboville=.FALSE.
-       viscom=1.46E-5
-       viscoh=2.06E-5
-       lmixmin=0.
-       yamada4_num=5
-    ELSE
-       ric=0.195
-       rifc=0.191
-       seuilalpha=1.12
-       seuilsm=0.085
-       yun=2.
-       ydeux=1.
-       hboville=.TRUE.
-       viscom=0.
-       viscoh=0.
-       lmixmin=1.
-       yamada4_num=0
-    ENDIF
-
-    WRITE(lunout,*)'YAMADA4 RIc, RIfc, Sm_min, Alpha_min',ric,rifc,seuilsm,seuilalpha
-    firstcall = .FALSE.
-    CALL getin_p('lmixmin',lmixmin)
-    CALL getin_p('yamada4_hboville',hboville)
-    CALL getin_p('yamada4_num',yamada4_num)
-  END IF
-
-
-
-!===============================================================================
-! Flags, tests et ??valuations de constantes
-!===============================================================================
-
-! On utilise ou non la routine de Holstalg Boville pour les cas tres stables
-
-
-  IF (.NOT. (iflag_pbl>=6 .AND. iflag_pbl<=12)) THEN
-    abort_message='probleme de coherence dans appel a MY'
-    CALL abort_physic(modname,abort_message,1)
-  END IF
-
-
-  nlay = klev
-  nlev = klev + 1
-
-
-!========================================================================
-! Calcul des increments verticaux
-!=========================================================================
-
-  
-! Attention: zlev n'est pas declare a nlev
-  DO ig = 1, ngrid
-    zlev(ig, nlev) = zlay(ig, nlay) + (zlay(ig,nlay)-zlev(ig,nlev-1))
-  END DO
-
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      unsdz(ig, k) = 1.E+0/(zlev(ig,k+1)-zlev(ig,k))
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    unsdzdec(ig, 1) = 1.E+0/(zlay(ig,1)-zlev(ig,1))
-  END DO
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      unsdzdec(ig, k) = 1.E+0/(zlay(ig,k)-zlay(ig,k-1))
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    unsdzdec(ig, nlay+1) = 1.E+0/(zlev(ig,nlay+1)-zlay(ig,nlay))
-  END DO
-
-!=========================================================================
-! Richardson number and stability functions
-!=========================================================================
- 
-! initialize arrays:
-
-  m2(1:ngrid, :) = 0.0
-  sm(1:ngrid, :) = 0.0
-  rif(1:ngrid, :) = 0.0
-
-!------------------------------------------------------------
-  DO k = 2, klev
-
-    DO ig = 1, ngrid
-      dz(ig, k) = zlay(ig, k) - zlay(ig, k-1)
-      m2(ig, k) = ((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig, &
-        k-1))**2)/(dz(ig,k)*dz(ig,k))
-      dtetadz(ig, k) = (teta(ig,k)-teta(ig,k-1))/dz(ig, k)
-      n2(ig, k) = g*2.*dtetadz(ig, k)/(teta(ig,k-1)+teta(ig,k))
-      ri = n2(ig, k)/max(m2(ig,k), 1.E-10)
-      IF (ri<ric) THEN
-        rif(ig, k) = frif(ri)
-      ELSE
-        rif(ig, k) = rifc
-      END IF
-if (new_yamada4) then
-        alpha(ig, k) = max(falpha(rif(ig,k)),seuilalpha)
-        sm(ig, k) = max(fsm(rif(ig,k)),seuilsm)
-else 
-      IF (rif(ig,k)<0.16) THEN
-        alpha(ig, k) = falpha(rif(ig,k))
-        sm(ig, k) = fsm(rif(ig,k))
-      ELSE
-        alpha(ig, k) = seuilalpha
-        sm(ig, k) = seuilsm
-      END IF
-
-end if
-      zz(ig, k) = b1*m2(ig, k)*(1.-rif(ig,k))*sm(ig, k)
-    END DO
-  END DO
-
-
-
-
-
-  !=======================================================================
-  !     DIFFERENT TYPES  DE SCHEMA de  YAMADA
-  !=======================================================================
-
-  ! On commence par calculer q2 a partir de la tke
-
-  IF (new_yamada4) THEN
-      DO k=1,klev+1
-         q2(1:ngrid,k)=tke(1:ngrid,k)*ydeux
-      ENDDO
-  ELSE
-      DO k=1,klev+1
-         q2(1:ngrid,k)=tke(1:ngrid,k)
-      ENDDO
-  ENDIF
-
-! ====================================================================
-! Computing the mixing length
-! ====================================================================
-
- 
-  CALL mixinglength(ni,nsrf,ngrid,iflag_pbl,pbl_lmixmin_alpha,lmixmin,zlay,zlev,u,v,q2,n2, l)
-
-
-  !--------------
-  ! Yamada 2.0
-  !--------------
-  IF (iflag_pbl==6) THEN
- 
-    DO k = 2, klev
-      q2(1:ngrid, k) = l(1:ngrid, k)**2*zz(1:ngrid, k)
-    END DO
-
-
-  !------------------
-  ! Yamada 2.Fournier
-  !------------------
-
-  ELSE IF (iflag_pbl==7) THEN
-
-
-    ! Calcul de l,  km, au pas precedent
-    !....................................
-    DO k = 2, klev
-      DO ig = 1, ngrid
-        delta(ig, k) = q2(ig, k)/(l(ig,k)**2*sm(ig,k))
-        kmpre(ig, k) = l(ig, k)*sqrt(q2(ig,k))*sm(ig, k)
-        mpre(ig, k) = sqrt(m2(ig,k))
-      END DO
-    END DO
-
-    DO k = 2, klev - 1
-      DO ig = 1, ngrid
-        m2cstat = max(alpha(ig,k)*n2(ig,k)+delta(ig,k)/b1, 1.E-12)
-        mcstat = sqrt(m2cstat)
-
-     ! Puis on ecrit la valeur de q qui annule l'equation de m supposee en q3
-     !.........................................................................
-
-        IF (k==2) THEN
-          kmcstat = 1.E+0/mcstat*(unsdz(ig,k)*kmpre(ig,k+1)*mpre(ig,k+1)+ &
-            unsdz(ig,k-1)*cd(ig)*(sqrt(u(ig,3)**2+v(ig,3)**2)-mcstat/unsdzdec &
-            (ig,k)-mpre(ig,k+1)/unsdzdec(ig,k+1))**2)/(unsdz(ig,k)+unsdz(ig,k &
-            -1))
-        ELSE
-          kmcstat = 1.E+0/mcstat*(unsdz(ig,k)*kmpre(ig,k+1)*mpre(ig,k+1)+ &
-            unsdz(ig,k-1)*kmpre(ig,k-1)*mpre(ig,k-1))/ &
-            (unsdz(ig,k)+unsdz(ig,k-1))
-        END IF
-
-        tmp2 = kmcstat/(sm(ig,k)/q2(ig,k))/l(ig, k)
-        q2(ig, k) = max(tmp2, 1.E-12)**(2./3.)
-
-      END DO
-    END DO
-
-
-    ! ------------------------
-    ! Yamada 2.5 a la Didi
-    !-------------------------
-
-  ELSE IF (iflag_pbl==8 .OR. iflag_pbl==9) THEN
-
-    ! Calcul de l, km, au pas precedent
-    !....................................
-    DO k = 2, klev
-      DO ig = 1, ngrid
-        delta(ig, k) = q2(ig, k)/(l(ig,k)**2*sm(ig,k))
-        IF (delta(ig,k)<1.E-20) THEN
-          delta(ig, k) = 1.E-20
-        END IF
-        km(ig, k) = l(ig, k)*sqrt(q2(ig,k))*sm(ig, k)
-        aa0 = (m2(ig,k)-alpha(ig,k)*n2(ig,k)-delta(ig,k)/b1)
-        aa1 = (m2(ig,k)*(1.-rif(ig,k))-delta(ig,k)/b1)
-        aa(ig, k) = aa1*dt/(delta(ig,k)*l(ig,k))
-        qpre = sqrt(q2(ig,k))
-        IF (aa(ig,k)>0.) THEN
-          q2(ig, k) = (qpre+aa(ig,k)*qpre*qpre)**2
-        ELSE
-          q2(ig, k) = (qpre/(1.-aa(ig,k)*qpre))**2
-        END IF
-        ! else ! iflag_pbl=9
-        ! if (aa(ig,k)*qpre.gt.0.9) then
-        ! q2(ig,k)=(qpre*10.)**2
-        ! else
-        ! q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
-        ! endif
-        ! endif
-        q2(ig, k) = min(max(q2(ig,k),1.E-10), 1.E4)
-      END DO
-    END DO
-
-  ELSE IF (iflag_pbl>=10) THEN
-
-    IF (yamada4_num>=1) THEN
- 
-    DO k = 2, klev - 1
-      DO ig=1,ngrid
-      q2(ig, k) = min(max(q2(ig,k),1.E-10), 1.E4)
-      km(ig, k) = l(ig, k)*sqrt(q2(ig,k))*sm(ig, k)
-      shear(ig,k)=km(ig, k)*m2(ig, k)
-      buoy(ig,k)=km(ig, k)*m2(ig, k)*(-1.*rif(ig,k))
-      dissip(ig,k)=((sqrt(q2(ig,k)))**3)/(b1*l(ig,k))
-     ENDDO
-    ENDDO
-
-    IF (yamada4_num==1) THEN ! Schema du MAR tel quel
-       DO k = 2, klev - 1
-         DO ig=1,ngrid
-         tkeprov=q2(ig,k)/ydeux
-         tkeprov= tkeprov*                           &
-           &  (tkeprov+dt*(shear(ig,k)+max(0.,buoy(ig,k))))/ &
-           &  (tkeprov+dt*((-1.)*min(0.,buoy(ig,k))+dissip(ig,k)))
-         q2(ig,k)=tkeprov*ydeux
-        ENDDO
-       ENDDO
-    ELSE IF (yamada4_num==2) THEN ! version modifiee avec integration exacte pour la dissipation
-       DO k = 2, klev - 1
-         DO ig=1,ngrid
-         tkeprov=q2(ig,k)/ydeux
-         disseff=dissip(ig,k)-min(0.,buoy(ig,k))
-         tkeprov = tkeprov/(1.+dt*disseff/(2.*tkeprov))**2
-         tkeprov= tkeprov+dt*(shear(ig,k)+max(0.,buoy(ig,k)))
-         q2(ig,k)=tkeprov*ydeux
-         ! En cas stable, on traite la flotabilite comme la
-         ! dissipation, en supposant que buoy/q2^3 est constant.
-         ! Puis on prend la solution exacte
-        ENDDO
-       ENDDO
-    ELSE IF (yamada4_num==3) THEN ! version modifiee avec integration exacte pour la dissipation
-       DO k = 2, klev - 1
-         DO ig=1,ngrid
-         tkeprov=q2(ig,k)/ydeux
-         disseff=dissip(ig,k)-min(0.,buoy(ig,k))
-         tkeprov=tkeprov*exp(-dt*disseff/tkeprov)
-         tkeprov= tkeprov+dt*(shear(ig,k)+max(0.,buoy(ig,k)))
-         q2(ig,k)=tkeprov*ydeux
-         ! En cas stable, on traite la flotabilite comme la
-         ! dissipation, en supposant que buoy/q2^3 est constant.
-         ! Puis on prend la solution exacte
-        ENDDO
-       ENDDO
-    ELSE IF (yamada4_num==4) THEN ! version modifiee avec integration exacte pour la dissipation
-       DO k = 2, klev - 1
-         DO ig=1,ngrid
-         tkeprov=q2(ig,k)/ydeux
-         tkeprov= tkeprov+dt*(shear(ig,k)+max(0.,buoy(ig,k)))
-         tkeprov= tkeprov*                           &
-           &  tkeprov/ &
-           &  (tkeprov+dt*((-1.)*min(0.,buoy(ig,k))+dissip(ig,k)))
-         q2(ig,k)=tkeprov*ydeux
-         ! En cas stable, on traite la flotabilite comme la
-         ! dissipation, en supposant que buoy/q2^3 est constant.
-         ! Puis on prend la solution exacte
-        ENDDO
-       ENDDO
-    ELSE IF (yamada4_num==5) THEN ! version modifiee avec integration exacte pour la dissipation
-       DO k = 2, klev - 1
-         DO ig=1,ngrid
-         tkeprov=q2(ig,k)/ydeux
-
-!             if(ifl_pbltree .eq. 0) then
-!         disseff=dissip(ig,k)-min(0.,buoy(ig,k))
-!         tkeexp=exp(-dt*disseff/tkeprov)
-!         tkeprov= shear(ig,k)*tkeprov/disseff*(1.-tkeexp)+tkeprov*tkeexp
-!           else
-!FC on ajoute la dissipation due aux arbres
-         disseff=dissip(ig,k)-min(0.,buoy(ig,k)) + drgpro(ig,k)*tkeprov
-         tkeexp=exp(-dt*disseff/tkeprov)
-! on prend en compte la tke cree par les arbres
-         winds(ig,k)=sqrt(u(ig,k)**2+v(ig,k)**2)
-         tkeprov= (shear(ig,k)+ &
-          & drgpro(ig,k)*(winds(ig,k))**3)*tkeprov/disseff*(1.-tkeexp)+tkeprov*tkeexp
-!               endif
-
-         q2(ig,k)=tkeprov*ydeux
-
-         ! En cas stable, on traite la flotabilite comme la
-         ! dissipation, en supposant que buoy/q2^3 est constant.
-         ! Puis on prend la solution exacte
-        ENDDO
-       ENDDO
-    ELSE IF (yamada4_num==6) THEN ! version modifiee avec integration exacte pour la dissipation
-       DO k = 2, klev - 1
-         DO ig=1,ngrid
-         tkeprov=q2(ig,k)/ydeux
-         tkeprov=tkeprov+max(buoy(ig,k)+shear(ig,k),0.)*dt
-         disseff=dissip(ig,k)-min(0.,buoy(ig,k)+shear(ig,k))
-         tkeexp=exp(-dt*disseff/tkeprov)
-         tkeprov= tkeprov*tkeexp
-         q2(ig,k)=tkeprov*ydeux
-         ! En cas stable, on traite la flotabilite comme la
-         ! dissipation, en supposant que buoy/q2^3 est constant.
-         ! Puis on prend la solution exacte
-        ENDDO
-       ENDDO
-    ENDIF
-
-    DO k = 2, klev - 1
-      DO ig=1,ngrid
-      q2(ig, k) = min(max(q2(ig,k),1.E-10), 1.E4)
-      ENDDO
-    ENDDO
-
-   ELSE 
-
-    DO k = 2, klev - 1
-      km(1:ngrid, k) = l(1:ngrid, k)*sqrt(q2(1:ngrid,k))*sm(1:ngrid, k)
-      q2(1:ngrid, k) = q2(1:ngrid, k) + ydeux*dt*km(1:ngrid, k)*m2(1:ngrid, k)*(1.-rif(1:ngrid,k))
-!     q2(1:ngrid, k) = q2(1:ngrid, k) + dt*km(1:ngrid, k)*m2(1:ngrid, k)*(1.-rif(1:ngrid,k))
-      q2(1:ngrid, k) = min(max(q2(1:ngrid,k),1.E-10), 1.E4)
-       q2(1:ngrid, k) = 1./(1./sqrt(q2(1:ngrid,k))+dt/(yun*l(1:ngrid,k)*b1))
-!     q2(1:ngrid, k) = 1./(1./sqrt(q2(1:ngrid,k))+dt/(2*l(1:ngrid,k)*b1))
-      q2(1:ngrid, k) = q2(1:ngrid, k)*q2(1:ngrid, k)
-    END DO
-
-  ENDIF
-
-  ELSE
-     abort_message='Cas nom prevu dans yamada4'
-     CALL abort_physic(modname,abort_message,1)
-
-  END IF ! Fin du cas 8
-
-
-  ! ====================================================================
-  ! Calcul des coefficients de melange
-  ! ====================================================================
-
-  DO k = 2, klev
-    DO ig = 1, ngrid
-      zq = sqrt(q2(ig,k))
-      km(ig, k) = l(ig, k)*zq*sm(ig, k)     ! For momentum
-      kn(ig, k) = km(ig, k)*alpha(ig, k)    ! For scalars
-      kq(ig, k) = l(ig, k)*zq*0.2           ! For TKE
-    END DO
-  END DO
-
-
-  !====================================================================
-  ! Transport diffusif vertical de la TKE par la TKE
-  !====================================================================
-
-
-    ! initialize near-surface and top-layer mixing coefficients
-    !...........................................................
-
-  kq(1:ngrid, 1) = kq(1:ngrid, 2)    ! constant (ie no gradient) near the surface
-  kq(1:ngrid, klev+1) = 0            ! zero at the top
-
-    ! Transport diffusif vertical de la TKE.
-    !.......................................
-
-  IF (iflag_pbl>=12) THEN
-    q2(1:ngrid, 1) = q2(1:ngrid, 2)
-    CALL vdif_q2(dt, g, rconst, ngrid, plev, temp, kq, q2)
-  END IF
-
-
-  !====================================================================
-  ! Traitement particulier pour les cas tres stables, introduction d'une
-  ! longueur de m??lange minimale
-  !====================================================================
-  !
-  ! Reference: Local versus Nonlocal boundary-layer diffusion in a global climate model
-  !            Holtslag A.A.M. and Boville B.A.
-  !            J. Clim., 6, 1825-1842, 1993
-
-
- IF (hboville) THEN
-
-
-  IF (prt_level>1) THEN
-    WRITE(lunout,*) 'YAMADA4 0'
-  END IF 
-
-  DO ig = 1, ngrid
-    coriol(ig) = 1.E-4
-    pblhmin(ig) = 0.07*ustar(ig)/max(abs(coriol(ig)), 2.546E-5)
-  END DO
-
-  IF (1==1) THEN
-    IF (iflag_pbl==8 .OR. iflag_pbl==10) THEN
-
-      DO k = 2, klev
-        DO ig = 1, ngrid
-          IF (teta(ig,2)>teta(ig,1)) THEN
-            qmin = ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
-            kmin = kap*zlev(ig, k)*qmin
-          ELSE
-            kmin = -1. ! kmin n'est utilise que pour les SL stables.
-          END IF
-          IF (kn(ig,k)<kmin .OR. km(ig,k)<kmin) THEN
-
-            kn(ig, k) = kmin
-            km(ig, k) = kmin
-            kq(ig, k) = kmin
-
- ! la longueur de melange est suposee etre l= kap z
- ! K=l q Sm d'ou q2=(K/l Sm)**2
-
-            q2(ig, k) = (qmin/sm(ig,k))**2
-          END IF
-        END DO
-      END DO
-
-    ELSE
-      DO k = 2, klev
-        DO ig = 1, ngrid
-          IF (teta(ig,2)>teta(ig,1)) THEN
-            qmin = ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
-            kmin = kap*zlev(ig, k)*qmin
-          ELSE
-            kmin = -1. ! kmin n'est utilise que pour les SL stables.
-          END IF
-          IF (kn(ig,k)<kmin .OR. km(ig,k)<kmin) THEN
-            kn(ig, k) = kmin
-            km(ig, k) = kmin
-            kq(ig, k) = kmin
- ! la longueur de melange est suposee etre l= kap z
- ! K=l q Sm d'ou q2=(K/l Sm)**2
-            sm(ig, k) = 1.
-            alpha(ig, k) = 1.
-            q2(ig, k) = min((qmin/sm(ig,k))**2, 10.)
-            zq = sqrt(q2(ig,k))
-            km(ig, k) = l(ig, k)*zq*sm(ig, k)
-            kn(ig, k) = km(ig, k)*alpha(ig, k)
-            kq(ig, k) = l(ig, k)*zq*0.2
-          END IF
-        END DO
-      END DO
-    END IF
-
-  END IF
-
- END IF ! hboville
-
-! Ajout d'une viscosite moleculaire
-   km(1:ngrid,2:klev)=km(1:ngrid,2:klev)+viscom
-   kn(1:ngrid,2:klev)=kn(1:ngrid,2:klev)+viscoh
-   kq(1:ngrid,2:klev)=kq(1:ngrid,2:klev)+viscoh
-
-  IF (prt_level>1) THEN
-    WRITE(lunout,*)'YAMADA4 1'
-  END IF !(prt_level>1) THEN
-
-
- !======================================================
- ! Estimations de w'2 et T'2 d'apres Abdela et McFarlane
- !======================================================
- !
- ! Reference: A New Second-Order Turbulence Closure Scheme for the Planetary Boundary Layer
- !            Abdella K and McFarlane N
- !            J. Atmos. Sci., 54, 1850-1867, 1997
-
-  ! Diagnostique pour stokage
-  !..........................
-
-  IF (1==0) THEN
-    rino = rif
-    smyam(1:ngrid, 1) = 0.
-    styam(1:ngrid, 1) = 0.
-    lyam(1:ngrid, 1) = 0.
-    knyam(1:ngrid, 1) = 0.
-    w2yam(1:ngrid, 1) = 0.
-    t2yam(1:ngrid, 1) = 0.
-
-    smyam(1:ngrid, 2:klev) = sm(1:ngrid, 2:klev)
-    styam(1:ngrid, 2:klev) = sm(1:ngrid, 2:klev)*alpha(1:ngrid, 2:klev)
-    lyam(1:ngrid, 2:klev) = l(1:ngrid, 2:klev)
-    knyam(1:ngrid, 2:klev) = kn(1:ngrid, 2:klev)
-
-
-  ! Calcul de w'2 et T'2
-  !.......................
-
-    w2yam(1:ngrid, 2:klev) = q2(1:ngrid, 2:klev)*0.24 + &
-      lyam(1:ngrid, 2:klev)*5.17*kn(1:ngrid, 2:klev)*n2(1:ngrid, 2:klev)/ &
-      sqrt(q2(1:ngrid,2:klev))
-
-    t2yam(1:ngrid, 2:klev) = 9.1*kn(1:ngrid, 2:klev)* &
-      dtetadz(1:ngrid, 2:klev)**2/sqrt(q2(1:ngrid,2:klev))* &
-      lyam(1:ngrid, 2:klev)
-  END IF
-
-
-
-!============================================================================
-! Mise a jour de la tke
-!============================================================================
-
-  IF (new_yamada4) THEN
-     DO k=1,klev+1
-        tke(1:ngrid,k)=q2(1:ngrid,k)/ydeux
-     ENDDO
-  ELSE
-     DO k=1,klev+1
-        tke(1:ngrid,k)=q2(1:ngrid,k)
-     ENDDO
-  ENDIF
-
-
-!============================================================================
-
-  RETURN
-
-
-END SUBROUTINE yamada4
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE vdif_q2(timestep, gravity, rconst, ngrid, plev, temp, kmy, q2)
-
-  USE dimphy
-  IMPLICIT NONE
- 
-!    vdif_q2: subroutine qui calcule la diffusion de la TKE par la TKE
-!             avec un schema implicite en temps avec 
-!             inversion d'un syst??me tridiagonal
-! 
-!     Reference: Description of the interface with the surface and 
-!                the computation of the turbulet diffusion in LMDZ
-!                Technical note on LMDZ
-!                Dufresne, J-L, Ghattas, J. and Grandpeix, J-Y
-!
-!============================================================================
-! Declarations
-!============================================================================
-
-  REAL plev(klon, klev+1)
-  REAL temp(klon, klev)
-  REAL timestep
-  REAL gravity, rconst
-  REAL kstar(klon, klev+1), zz
-  REAL kmy(klon, klev+1)
-  REAL q2(klon, klev+1)
-  REAL deltap(klon, klev+1)
-  REAL denom(klon, klev+1), alpha(klon, klev+1), beta(klon, klev+1)
-  INTEGER ngrid
-
-  INTEGER i, k
-
-
-!=========================================================================
-! Calcul
-!=========================================================================
-
-  DO k = 1, klev
-    DO i = 1, ngrid
-      zz = (plev(i,k)+plev(i,k+1))*gravity/(rconst*temp(i,k))
-      kstar(i, k) = 0.125*(kmy(i,k+1)+kmy(i,k))*zz*zz/ &
-        (plev(i,k)-plev(i,k+1))*timestep
-    END DO
-  END DO
-
-  DO k = 2, klev
-    DO i = 1, ngrid
-      deltap(i, k) = 0.5*(plev(i,k-1)-plev(i,k+1))
-    END DO
-  END DO
-  DO i = 1, ngrid
-    deltap(i, 1) = 0.5*(plev(i,1)-plev(i,2))
-    deltap(i, klev+1) = 0.5*(plev(i,klev)-plev(i,klev+1))
-    denom(i, klev+1) = deltap(i, klev+1) + kstar(i, klev)
-    alpha(i, klev+1) = deltap(i, klev+1)*q2(i, klev+1)/denom(i, klev+1)
-    beta(i, klev+1) = kstar(i, klev)/denom(i, klev+1)
-  END DO
-
-  DO k = klev, 2, -1
-    DO i = 1, ngrid
-      denom(i, k) = deltap(i, k) + (1.-beta(i,k+1))*kstar(i, k) + &
-        kstar(i, k-1)
-      alpha(i, k) = (q2(i,k)*deltap(i,k)+kstar(i,k)*alpha(i,k+1))/denom(i, k)
-      beta(i, k) = kstar(i, k-1)/denom(i, k)
-    END DO
-  END DO
-
-  ! Si on recalcule q2(1)
-  !.......................
-  IF (1==0) THEN
-    DO i = 1, ngrid
-      denom(i, 1) = deltap(i, 1) + (1-beta(i,2))*kstar(i, 1)
-      q2(i, 1) = (q2(i,1)*deltap(i,1)+kstar(i,1)*alpha(i,2))/denom(i, 1)
-    END DO
-  END IF
-
-
-  DO k = 2, klev + 1
-    DO i = 1, ngrid
-      q2(i, k) = alpha(i, k) + beta(i, k)*q2(i, k-1)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE vdif_q2
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- SUBROUTINE vdif_q2e(timestep, gravity, rconst, ngrid, plev, temp, kmy, q2)
-  
-   USE dimphy
-  IMPLICIT NONE
-
-! vdif_q2e: subroutine qui calcule la diffusion de TKE par la TKE
-!           avec un schema explicite en temps
-
-
-!====================================================
-! Declarations
-!====================================================
-
-  REAL plev(klon, klev+1)
-  REAL temp(klon, klev)
-  REAL timestep
-  REAL gravity, rconst
-  REAL kstar(klon, klev+1), zz
-  REAL kmy(klon, klev+1)
-  REAL q2(klon, klev+1)
-  REAL deltap(klon, klev+1)
-  REAL denom(klon, klev+1), alpha(klon, klev+1), beta(klon, klev+1)
-  INTEGER ngrid
-  INTEGER i, k
-
-
-!==================================================
-! Calcul
-!==================================================
-
-  DO k = 1, klev
-    DO i = 1, ngrid
-      zz = (plev(i,k)+plev(i,k+1))*gravity/(rconst*temp(i,k))
-      kstar(i, k) = 0.125*(kmy(i,k+1)+kmy(i,k))*zz*zz/ &
-        (plev(i,k)-plev(i,k+1))*timestep
-    END DO
-  END DO
-
-  DO k = 2, klev
-    DO i = 1, ngrid
-      deltap(i, k) = 0.5*(plev(i,k-1)-plev(i,k+1))
-    END DO
-  END DO
-  DO i = 1, ngrid
-    deltap(i, 1) = 0.5*(plev(i,1)-plev(i,2))
-    deltap(i, klev+1) = 0.5*(plev(i,klev)-plev(i,klev+1))
-  END DO
-
-  DO k = klev, 2, -1
-    DO i = 1, ngrid
-      q2(i, k) = q2(i, k) + (kstar(i,k)*(q2(i,k+1)-q2(i, &
-        k))-kstar(i,k-1)*(q2(i,k)-q2(i,k-1)))/deltap(i, k)
-    END DO
-  END DO
-
-  DO i = 1, ngrid
-    q2(i, 1) = q2(i, 1) + (kstar(i,1)*(q2(i,2)-q2(i,1)))/deltap(i, 1)
-    q2(i, klev+1) = q2(i, klev+1) + (-kstar(i,klev)*(q2(i,klev+1)-q2(i, &
-      klev)))/deltap(i, klev+1)
-  END DO
-
-  RETURN
-END SUBROUTINE vdif_q2e
-
-!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-SUBROUTINE mixinglength(ni, nsrf, ngrid,iflag_pbl,pbl_lmixmin_alpha,lmixmin,zlay,zlev,u,v,q2,n2, lmix)
-
-
-
-  USE dimphy
-  USE phys_state_var_mod, only: zstd, zsig, zmea
-  USE phys_local_var_mod, only: l_mixmin, l_mix
-
- ! zstd: ecart type de la'altitud e sous-maille
- ! zmea: altitude moyenne sous maille
- ! zsig: pente moyenne de le maille
-
-  USE geometry_mod, only: cell_area
-  ! aire_cell: aire de la maille
-
-  IMPLICIT NONE
-!*************************************************************************
-! Subrourine qui calcule la longueur de m??lange dans le sch??ma de turbulence
-! avec la formule de Blackadar 
-! Calcul d'un  minimum en fonction de l'orographie sous-maille:
-! L'id??e est la suivante: plus il y a de relief, plus il y a du m??lange
-! induit par les circulations meso et submeso ??chelles.
-!
-! References: * The vertical distribution of wind and turbulent exchange in a neutral atmosphere
-!               Blackadar A.K.
-!               J. Geophys. Res., 64, No 8, 1962
-!
-!             * An evaluation of neutral and convective planetary boundary-layer parametrisations relative 
-!               to large eddy simulations
-!               Ayotte K et al 
-!               Boundary Layer Meteorology, 79, 131-175, 1996
-!
-!
-!             * Local Similarity in the Stable Boundary Layer and Mixing length Approaches: consistency of concepts
-!               Van de Wiel B.J.H et al
-!               Boundary-Lay Meteorol, 128, 103-166, 2008
-!
-!
-! Histoire:
-!----------
-! * premi??re r??daction, Etienne et Frederic, 09/06/2016
-!
-! ***********************************************************************
-
-!==================================================================
-! Declarations
-!==================================================================
-
-! Inputs
-!-------
- INTEGER            ni(klon)           ! indice sur la grille original (non restreinte)
- INTEGER            nsrf               ! Type de surface
- INTEGER            ngrid              ! Nombre de points concern??s sur l'horizontal
- INTEGER            iflag_pbl          ! Choix du sch??ma de turbulence
- REAL            pbl_lmixmin_alpha  ! on active ou non le calcul de la longueur de melange minimum
- REAL               lmixmin            ! Minimum absolu de la longueur de m??lange
- REAL               zlay(klon, klev)   ! altitude du centre de la couche
- REAL               zlev(klon, klev+1) ! atitude de l'interface inf??rieure de la couche
- REAL               u(klon, klev)      ! vitesse du vent zonal
- REAL               v(klon, klev)      ! vitesse du vent meridional
- REAL               q2(klon, klev+1)   ! energie cin??tique turbulente 
- REAL               n2(klon, klev+1)   ! frequence de Brunt-Vaisala
-
-!In/out
-!-------
-
-  LOGICAL, SAVE :: firstcall = .TRUE.
-  !$OMP THREADPRIVATE(firstcall)
-
-! Outputs
-!---------
-
- REAL               lmix(klon, klev+1)    ! Longueur de melange  
-
-
-! Local
-!-------
-  
- INTEGER  ig,jg, k
- REAL     h_oro(klon)
- REAL     hlim(klon)
- REAL, SAVE :: kap=0.4,kapb=0.4
-  !$OMP THREADPRIVATE(kap,kapb)
- REAL zq
- REAL sq(klon), sqz(klon)
- REAL, ALLOCATABLE, SAVE :: l0(:)
-  !$OMP THREADPRIVATE(l0)
- REAL fl, zzz, zl0, zq2, zn2
- REAL famorti, zzzz, zh_oro, zhlim
- REAL l1(klon, klev+1), l2(klon,klev+1)
- REAL winds(klon, klev)
- REAL xcell
- REAL zstdslope(klon)  
- REAL lmax
- REAL l2strat, l2neutre, extent  
- REAL l2limit(klon)
-!===============================================================
-! Fonctions utiles
-!===============================================================
-
-! Calcul de l suivant la formule de Blackadar 1962 adapt??e par Ayotte 1996
-!..........................................................................
-
- fl(zzz, zl0, zq2, zn2) = max(min(l0(ig)*kap*zlev(ig, &
-    k)/(kap*zlev(ig,k)+l0(ig)),0.5*sqrt(q2(ig,k))/sqrt( &
-    max(n2(ig,k),1.E-10))), 1.E-5)
- 
-! Fonction d'amortissement de la turbulence au dessus de la montagne
-! On augmente l'amortissement en diminuant la valeur de hlim (extent) dans le code
-!.....................................................................
-
- famorti(zzzz, zh_oro, zhlim)=(-1.)*ATAN((zzzz-zh_oro)/(zhlim-zh_oro))*2./3.1416+1.    
-
-  IF (ngrid==0) RETURN
-
-  IF (firstcall) THEN
-    ALLOCATE (l0(klon))
-    firstcall = .FALSE.
-  END IF
-
-
-!=====================================================================
-!         CALCUL de la LONGUEUR de m??lange suivant BLACKADAR: l1
-!=====================================================================
-
-
-  IF (iflag_pbl==8 .OR. iflag_pbl==10) THEN
-
-    
-    ! Iterative computation of l0
-    ! This version is kept for iflag_pbl only for convergence
-    ! with NPv3.1 Cmip5 simulations
-    !...................................................................
-
-    DO ig = 1, ngrid
-      sq(ig) = 1.E-10
-      sqz(ig) = 1.E-10
-    END DO
-    DO k = 2, klev - 1
-      DO ig = 1, ngrid
-        zq = sqrt(q2(ig,k))
-        sqz(ig) = sqz(ig) + zq*zlev(ig, k)*(zlay(ig,k)-zlay(ig,k-1))
-        sq(ig) = sq(ig) + zq*(zlay(ig,k)-zlay(ig,k-1))
-      END DO
-    END DO
-    DO ig = 1, ngrid
-      l0(ig) = 0.2*sqz(ig)/sq(ig)
-    END DO
-    DO k = 2, klev
-      DO ig = 1, ngrid
-        l1(ig, k) = fl(zlev(ig,k), l0(ig), q2(ig,k), n2(ig,k))
-      END DO
-    END DO
-
-  ELSE
-
-    
-    ! In all other case, the assymptotic mixing length l0 is imposed (150m)
-    !......................................................................
-
-    l0(1:ngrid) = 150.
-    DO k = 2, klev
-      DO ig = 1, ngrid
-        l1(ig, k) = fl(zlev(ig,k), l0(ig), q2(ig,k), n2(ig,k))
-      END DO
-    END DO
-
-  END IF
-
-!=================================================================================
-!  CALCUL d'une longueur de melange en fonctions de la topographie sous maille: l2
-! si plb_lmixmin_alpha=TRUE et si on se trouve sur de la terre ( pas actif sur les 
-! glacier, la glace de mer et les oc??ans)
-!=================================================================================
-
-   l2(1:ngrid,:)=0.0
-   l_mixmin(1:ngrid,:,nsrf)=0.
-   l_mix(1:ngrid,:,nsrf)=0.
-
-   IF (nsrf .EQ. 1) THEN
-
-! coefficients 
-!--------------
-
-     extent=2.                                                         ! On ??tend l'impact du relief jusqu'?? extent*h, extent >1.  
-     lmax=150.                                                         ! Longueur de m??lange max dans l'absolu
-
-! calculs
-!---------
-
-     DO ig=1,ngrid
-
-      ! On calcule la hauteur du relief
-      !.................................
-      ! On ne peut pas prendre zstd seulement pour caracteriser le relief sous maille
-      ! car sur un terrain pentu mais sans relief, zstd est non nul (comme en Antarctique, C. Genthon)
-      ! On corrige donc zstd avec l'ecart type de l'altitude dans la maille sans relief 
-      ! (en gros, une maille de taille xcell avec une pente constante zstdslope)
-      jg=ni(ig) 
-!     IF (zsig(jg) .EQ. 0.) THEN
-!          zstdslope(ig)=0.         
-!     ELSE
-!     xcell=sqrt(cell_area(jg))
-!     zstdslope(ig)=max((xcell*zsig(jg)-zmea(jg))**3 /(3.*zsig(jg)),0.)
-!     zstdslope(ig)=sqrt(zstdslope(ig))
-!     END IF
-      
-!     h_oro(ig)=max(zstd(jg)-zstdslope(ig),0.)   ! Hauteur du relief
-      h_oro(ig)=zstd(jg)
-      hlim(ig)=extent*h_oro(ig)     
-     ENDDO
-
-     l2limit(1:ngrid)=0.
-
-     DO k=2,klev
-        DO ig=1,ngrid
-           winds(ig,k)=sqrt(u(ig,k)**2+v(ig,k)**2)
-           IF (zlev(ig,k) .LE. h_oro(ig)) THEN  ! sous l'orographie
-              l2strat= kapb*pbl_lmixmin_alpha*winds(ig,k)/sqrt(max(n2(ig,k),1.E-10))  ! si stratifi??, amplitude d'oscillation * kappab (voir Van de Wiel et al 2008)
-              l2neutre=kap*zlev(ig,k)*h_oro(ig)/(kap*zlev(ig,k)+h_oro(ig))            ! Dans le cas neutre, formule de blackadar. tend asymptotiquement vers h
-              l2neutre=MIN(l2neutre,lmax)                                             ! On majore par lmax 
-              l2limit(ig)=MIN(l2neutre,l2strat)                                       ! Calcule de l2 (minimum de la longueur en cas neutre et celle en situation stratifi??e)
-              l2(ig,k)=l2limit(ig)
-                                      
-           ELSE IF (zlev(ig,k) .LE. hlim(ig)) THEN ! Si on est au dessus des montagnes, mais affect?? encore par elles
-
-      ! Au dessus des montagnes, on prend la l2limit au sommet des montagnes 
-      ! (la derni??re calcul??e dans la boucle k, vu que k est un indice croissant avec z)
-      ! et on multiplie l2limit par une fonction qui d??croit entre h et hlim
-              l2(ig,k)=l2limit(ig)*famorti(zlev(ig,k),h_oro(ig), hlim(ig))
-           ELSE                                                                    ! Au dessus de extent*h, on prend l2=l0 
-              l2(ig,k)=0.
-           END IF
-        ENDDO
-     ENDDO
-   ENDIF                                                                        ! pbl_lmixmin_alpha
-
-!==================================================================================
-! On prend le max entre la longueur de melange de blackadar et celle calcul??e
-! en fonction de la topographie 
-!===================================================================================
-
-
- DO k=2,klev
-    DO ig=1,ngrid
-       lmix(ig,k)=MAX(MAX(l1(ig,k), l2(ig,k)),lmixmin)
-   ENDDO
- ENDDO
-
-! Diagnostics
-
- DO k=2,klev
-    DO ig=1,ngrid
-       jg=ni(ig)
-       l_mix(jg,k,nsrf)=lmix(ig,k)
-       l_mixmin(jg,k,nsrf)=l2(ig,k)
-    ENDDO
- ENDDO
- DO ig=1,ngrid
-    jg=ni(ig)
-    l_mix(jg,1,nsrf)=hlim(ig)
- ENDDO
-
-
-
-END SUBROUTINE mixinglength
+link ../phylmd/yamada4.F90
Index: LMDZ6/trunk/libf/phylmdiso/yamada_c.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/yamada_c.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/yamada_c.F90	(revision 3940)
@@ -1,491 +1,1 @@
-!
-! $Header$
-!
-      SUBROUTINE yamada_c(ngrid,timestep,plev,play &
-     &   ,pu,pv,pt,d_u,d_v,d_t,cd,q2,km,kn,kq,d_t_diss,ustar &
-     &   ,iflag_pbl)
-      USE dimphy, ONLY: klon, klev
-      USE print_control_mod, ONLY: prt_level
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-
-      IMPLICIT NONE
-#include "YOMCST.h"
-!
-! timestep : pas de temps
-! g  : g
-! zlev : altitude a chaque niveau (interface inferieure de la couche
-!        de meme indice)
-! zlay : altitude au centre de chaque couche
-! u,v : vitesse au centre de chaque couche
-!       (en entree : la valeur au debut du pas de temps)
-! teta : temperature potentielle au centre de chaque couche
-!        (en entree : la valeur au debut du pas de temps)
-! cd : cdrag
-!      (en entree : la valeur au debut du pas de temps)
-! q2 : $q^2$ au bas de chaque couche
-!      (en entree : la valeur au debut du pas de temps)
-!      (en sortie : la valeur a la fin du pas de temps)
-! km : diffusivite turbulente de quantite de mouvement (au bas de chaque
-!      couche)
-!      (en sortie : la valeur a la fin du pas de temps)
-! kn : diffusivite turbulente des scalaires (au bas de chaque couche)
-!      (en sortie : la valeur a la fin du pas de temps)
-!
-!  iflag_pbl doit valoir entre 6 et 9
-!      l=6, on prend  systematiquement une longueur d'equilibre
-!    iflag_pbl=6 : MY 2.0
-!    iflag_pbl=7 : MY 2.0.Fournier
-!    iflag_pbl=8/9 : MY 2.5
-!       iflag_pbl=8 with special obsolete treatments for convergence
-!       with Cmpi5 NPv3.1 simulations
-!    iflag_pbl=10/11 :  New scheme M2 and N2 explicit and dissiptation exact
-!    iflag_pbl=12 = 11 with vertical diffusion off q2
-!
-!  2013/04/01 (FH hourdin@lmd.jussieu.fr)
-!     Correction for very stable PBLs (iflag_pbl=10 and 11)
-!     iflag_pbl=8 converges numerically with NPv3.1
-!     iflag_pbl=11 -> the model starts with NP from start files created by ce0l
-!                  -> the model can run with longer time-steps.
-!.......................................................................
-
-      REAL, DIMENSION(klon,klev) :: d_u,d_v,d_t
-      REAL, DIMENSION(klon,klev) :: pu,pv,pt
-      REAL, DIMENSION(klon,klev) :: d_t_diss
-
-      REAL timestep
-      real plev(klon,klev+1)
-      real play(klon,klev)
-      real ustar(klon)
-      real kmin,qmin,pblhmin(klon),coriol(klon)
-      REAL zlev(klon,klev+1)
-      REAL zlay(klon,klev)
-      REAL zu(klon,klev)
-      REAL zv(klon,klev)
-      REAL zt(klon,klev)
-      REAL teta(klon,klev)
-      REAL cd(klon)
-      REAL q2(klon,klev+1),qpre
-      REAL unsdz(klon,klev)
-      REAL unsdzdec(klon,klev+1)
-
-      REAL km(klon,klev)
-      REAL kmpre(klon,klev+1),tmp2
-      REAL mpre(klon,klev+1)
-      REAL kn(klon,klev)
-      REAL kq(klon,klev)
-      real ff(klon,klev+1),delta(klon,klev+1)
-      real aa(klon,klev+1),aa0,aa1
-      integer iflag_pbl,ngrid
-      integer nlay,nlev
-
-      logical first
-      integer ipas
-      save first,ipas
-!FH/IM     data first,ipas/.true.,0/
-      data first,ipas/.false.,0/
-!$OMP THREADPRIVATE( first,ipas)
-       INTEGER, SAVE :: iflag_tke_diff=0
-!$OMP THREADPRIVATE(iflag_tke_diff)
-
-
-      integer ig,k
-
-
-      real ri,zrif,zalpha,zsm,zsn
-      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
-
-      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
-      REAL, DIMENSION(klon,klev+1) :: km2,kn2,sqrtq
-      real dtetadz(klon,klev+1)
-      real m2cstat,mcstat,kmcstat
-      real l(klon,klev+1)
-      real leff(klon,klev+1)
-      real,allocatable,save :: l0(:)
-!$OMP THREADPRIVATE(l0)      
-      real sq(klon),sqz(klon),zz(klon,klev+1)
-      integer iter
-
-      real ric,rifc,b1,kap
-      save ric,rifc,b1,kap
-      data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
-!$OMP THREADPRIVATE(ric,rifc,b1,kap)
-      real frif,falpha,fsm
-      real fl,zzz,zl0,zq2,zn2
-
-      real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
-      real lyam(klon,klev),knyam(klon,klev)
-      real w2yam(klon,klev),t2yam(klon,klev)
-      logical,save :: firstcall=.true.
-!$OMP THREADPRIVATE(firstcall)       
-      CHARACTER(len=20),PARAMETER :: modname="yamada_c"
-REAL, DIMENSION(klon,klev+1) :: fluxu,fluxv,fluxt
-REAL, DIMENSION(klon,klev+1) :: dddu,dddv,dddt
-REAL, DIMENSION(klon,klev) :: exner,masse
-REAL, DIMENSION(klon,klev+1) :: masseb,q2old,q2neg
-      LOGICAL okiophys
-
-      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
-      falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
-      fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
-      fl(zzz,zl0,zq2,zn2)= &
-     &     max(min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) &
-     &     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) ,1.)
-
-
-      okiophys=klon==1
-      if (firstcall) then
-        CALL getin_p('iflag_tke_diff',iflag_tke_diff)
-        allocate(l0(klon))
-#define IOPHYS
-#ifdef IOPHYS
-!        call iophys_ini
-#endif
-        firstcall=.false.
-      endif
-
-   IF (ngrid<=0) RETURN ! Bizarre : on n a pas ce probeleme pour coef_diff_turb
-
-#ifdef IOPHYS
-if (okiophys) then
-call iophys_ecrit('q2i',klev,'q2 debut my','m2/s2',q2(:,1:klev))
-call iophys_ecrit('kmi',klev,'Kz debut my','m/s2',km(:,1:klev))
-endif
-#endif
-
-      nlay=klev
-      nlev=klev+1
-
-
-!-------------------------------------------------------------------------
-! Computation of conservative source terms from the turbulent tendencies
-!-------------------------------------------------------------------------
-
-
-   zalpha=0.5 ! Anciennement 0.5. Essayer de voir pourquoi ? 
-   zu(:,:)=pu(:,:)+zalpha*d_u(:,:)
-   zv(:,:)=pv(:,:)+zalpha*d_v(:,:)
-   zt(:,:)=pt(:,:)+zalpha*d_t(:,:)
-
-   do k=1,klev
-      exner(:,k)=(play(:,k)/plev(:,1))**RKAPPA
-      masse(:,k)=(plev(:,k)-plev(:,k+1))/RG
-      teta(:,k)=zt(:,k)/exner(:,k)
-   enddo
-
-! Atmospheric mass at layer interfaces, where the TKE is computed
-   masseb(:,:)=0.
-   do k=1,klev
-      masseb(:,k)=masseb(:,k)+masse(:,k)
-      masseb(:,k+1)=masseb(:,k+1)+masse(:,k)
-    enddo
-    masseb(:,:)=0.5*masseb(:,:)
-
-   zlev(:,1)=0.
-   zlay(:,1)=RCPD*teta(:,1)*(1.-exner(:,1))
-   do k=1,klev-1
-      zlay(:,k+1)=zlay(:,k)+0.5*RCPD*(teta(:,k)+teta(:,k+1))*(exner(:,k)-exner(:,k+1))/RG
-      zlev(:,k)=0.5*(zlay(:,k)+zlay(:,k+1)) ! PASBO
-   enddo
-
-   fluxu(:,klev+1)=0.
-   fluxv(:,klev+1)=0.
-   fluxt(:,klev+1)=0.
-
-   do k=klev,1,-1
-      fluxu(:,k)=fluxu(:,k+1)+masse(:,k)*d_u(:,k)
-      fluxv(:,k)=fluxv(:,k+1)+masse(:,k)*d_v(:,k)
-      fluxt(:,k)=fluxt(:,k+1)+masse(:,k)*d_t(:,k)/exner(:,k) ! Flux de theta
-   enddo
-
-   dddu(:,1)=2*zu(:,1)*fluxu(:,1)
-   dddv(:,1)=2*zv(:,1)*fluxv(:,1)
-   dddt(:,1)=(exner(:,1)-1.)*fluxt(:,1)
-
-   do k=2,klev
-      dddu(:,k)=(zu(:,k)-zu(:,k-1))*fluxu(:,k)
-      dddv(:,k)=(zv(:,k)-zv(:,k-1))*fluxv(:,k)
-      dddt(:,k)=(exner(:,k)-exner(:,k-1))*fluxt(:,k)
-   enddo
-   dddu(:,klev+1)=0.
-   dddv(:,klev+1)=0.
-   dddt(:,klev+1)=0.
-
-#ifdef IOPHYS
-if (okiophys) then
-      call iophys_ecrit('zlay',klev,'Geop','m',zlay)
-      call iophys_ecrit('teta',klev,'teta','K',teta)
-      call iophys_ecrit('temp',klev,'temp','K',zt)
-      call iophys_ecrit('pt',klev,'temp','K',pt)
-      call iophys_ecrit('pu',klev,'u','m/s',pu)
-      call iophys_ecrit('pv',klev,'v','m/s',pv)
-      call iophys_ecrit('d_u',klev,'d_u','m/s2',d_u)
-      call iophys_ecrit('d_v',klev,'d_v','m/s2',d_v)
-      call iophys_ecrit('d_t',klev,'d_t','K/s',d_t)
-      call iophys_ecrit('exner',klev,'exner','',exner)
-      call iophys_ecrit('masse',klev,'masse','',masse)
-      call iophys_ecrit('masseb',klev,'masseb','',masseb)
-endif
-#endif
-
-
-
-      ipas=ipas+1
-
-
-!.......................................................................
-!  les increments verticaux
-!.......................................................................
-!
-!!!!!! allerte !!!!!c
-!!!!!! zlev n'est pas declare a nlev !!!!!c
-!!!!!! ---->
-                                                      DO ig=1,ngrid
-            zlev(ig,nlev)=zlay(ig,nlay) &
-     &             +( zlay(ig,nlay) - zlev(ig,nlev-1) )
-                                                      ENDDO
-!!!!!! <----
-!!!!!! allerte !!!!!c
-!
-      DO k=1,nlay
-                                                      DO ig=1,ngrid
-        unsdz(ig,k)=1.E+0/(zlev(ig,k+1)-zlev(ig,k))
-                                                      ENDDO
-      ENDDO
-                                                      DO ig=1,ngrid
-      unsdzdec(ig,1)=1.E+0/(zlay(ig,1)-zlev(ig,1))
-                                                      ENDDO
-      DO k=2,nlay
-                                                      DO ig=1,ngrid
-        unsdzdec(ig,k)=1.E+0/(zlay(ig,k)-zlay(ig,k-1))
-                                                     ENDDO
-      ENDDO
-                                                      DO ig=1,ngrid
-      unsdzdec(ig,nlay+1)=1.E+0/(zlev(ig,nlay+1)-zlay(ig,nlay))
-                                                     ENDDO
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Computing M^2, N^2, Richardson numbers, stability functions
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-      do k=2,klev
-                                                          do ig=1,ngrid
-         dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
-         m2(ig,k)=((zu(ig,k)-zu(ig,k-1))**2+(zv(ig,k)-zv(ig,k-1))**2)/(dz(ig,k)*dz(ig,k))
-         dtetadz(ig,k)=(teta(ig,k)-teta(ig,k-1))/dz(ig,k)
-         n2(ig,k)=RG*2.*dtetadz(ig,k)/(teta(ig,k-1)+teta(ig,k))
-!        n2(ig,k)=0.
-         ri=n2(ig,k)/max(m2(ig,k),1.e-10)
-         if (ri.lt.ric) then
-            rif(ig,k)=frif(ri)
-         else
-            rif(ig,k)=rifc
-         endif
-         if(rif(ig,k)<0.16) then
-            alpha(ig,k)=falpha(rif(ig,k))
-            sm(ig,k)=fsm(rif(ig,k))
-         else
-            alpha(ig,k)=1.12
-            sm(ig,k)=0.085
-         endif
-         zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
-                                                          enddo
-      enddo
-
-
-
-!====================================================================
-!  Computing the mixing length
-!====================================================================
-
-!   Mise a jour de l0
-      if (iflag_pbl==8.or.iflag_pbl==10) then
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Iterative computation of l0
-! This version is kept for iflag_pbl only for convergence
-! with NPv3.1 Cmip5 simulations
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-                                                          do ig=1,ngrid
-      sq(ig)=1.e-10
-      sqz(ig)=1.e-10
-                                                          enddo
-      do k=2,klev-1
-                                                          do ig=1,ngrid
-        zq=sqrt(q2(ig,k))
-        sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
-        sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
-                                                          enddo
-      enddo
-                                                          do ig=1,ngrid
-      l0(ig)=0.2*sqz(ig)/sq(ig)
-                                                          enddo
-      do k=2,klev
-                                                          do ig=1,ngrid
-         l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
-                                                          enddo
-      enddo
-!     print*,'L0 cas 8 ou 10 ',l0
-
-      else
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! In all other case, the assymptotic mixing length l0 is imposed (100m)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-          l0(:)=150.
-          do k=2,klev
-                                                          do ig=1,ngrid
-             l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
-                                                          enddo
-          enddo
-!     print*,'L0 cas autres ',l0
-
-      endif
-
-
-#ifdef IOPHYS
-if (okiophys) then
-call iophys_ecrit('rif',klev,'Flux Richardson','m',rif(:,1:klev))
-call iophys_ecrit('m2',klev,'m2 ','m/s',m2(:,1:klev))
-call iophys_ecrit('Km2app',klev,'m2 conserv','m/s',km(:,1:klev)*m2(:,1:klev))
-call iophys_ecrit('Km',klev,'Km','m2/s',km(:,1:klev))
-endif
-#endif
-
-
-IF (iflag_pbl<20) then
-      ! For diagnostics only
-      RETURN
-
-ELSE
-
-!  print*,'OK1'
-
-! Evolution of TKE under source terms K M2 and K N2
-   leff(:,:)=max(l(:,:),1.)
-
-!##################################################################
-!#  IF (iflag_pbl==29) THEN
-!#     STOP'Ne pas utiliser iflag_pbl=29'
-!#     km2(:,:)=km(:,:)*m2(:,:)
-!#     kn2(:,:)=kn2(:,:)*rif(:,:)
-!#  ELSEIF (iflag_pbl==25) THEN
-! VERSION AVEC LA TKE EN MILIEU DE COUCHE
-!#     STOP'Ne pas utiliser iflag_pbl=25'
-!#     DO k=1,klev
-!#        km2(:,k)=-0.5*(dddu(:,k)+dddv(:,k)+dddu(:,k+1)+dddv(:,k+1)) &
-!#        &        /(masse(:,k)*timestep)
-!#        kn2(:,k)=rcpd*0.5*(dddt(:,k)+dddt(:,k+1))/(masse(:,k)*timestep)
-!#        leff(:,k)=0.5*(leff(:,k)+leff(:,k+1))
-!#     ENDDO
-!#     km2(:,klev+1)=0. ; kn2(:,klev+1)=0.
-!#  ELSE
-!#################################################################
-
-      km2(:,:)=-(dddu(:,:)+dddv(:,:))/(masseb(:,:)*timestep)
-      kn2(:,:)=rcpd*dddt(:,:)/(masseb(:,:)*timestep)
-!   ENDIF
-   q2neg(:,:)=q2(:,:)+timestep*(km2(:,:)-kn2(:,:))
-   q2(:,:)=min(max(q2neg(:,:),1.e-10),1.e4)
-
- 
-#ifdef IOPHYS
-if (okiophys) then
-      call iophys_ecrit('km2',klev,'m2 conserv','m/s',km2(:,1:klev))
-      call iophys_ecrit('kn2',klev,'n2 conserv','m/s',kn2(:,1:klev))
-endif
-#endif
-
-! Dissipation of TKE
-   q2old(:,:)=q2(:,:)
-   q2(:,:)=1./(1./sqrt(q2(:,:))+timestep/(2*leff(:,:)*b1))
-   q2(:,:)=q2(:,:)*q2(:,:)
-!  IF (iflag_pbl<=24) THEN
-      DO k=1,klev
-         d_t_diss(:,k)=(masseb(:,k)*(q2neg(:,k)-q2(:,k))+masseb(:,k+1)*(q2neg(:,k+1)-q2(:,k+1)))/(2.*rcpd*masse(:,k))
-      ENDDO
-
-!###################################################################
-!  ELSE IF (iflag_pbl<=27) THEN
-!     DO k=1,klev
-!        d_t_diss(:,k)=(q2neg(:,k)-q2(:,k))/rcpd
-!     ENDDO
-!  ENDIF
-!  print*,'iflag_pbl ',d_t_diss
-!###################################################################
-
-
-! Compuation of stability functions
-!   IF (iflag_pbl/=29) THEN
-      DO k=1,klev
-      DO ig=1,ngrid
-         IF (ABS(km2(ig,k))<=1.e-20) THEN
-            rif(ig,k)=0.
-         ELSE
-            rif(ig,k)=min(kn2(ig,k)/km2(ig,k),rifc)
-         ENDIF
-         IF (rif(ig,k).lt.0.16) THEN
-            alpha(ig,k)=falpha(rif(ig,k))
-            sm(ig,k)=fsm(rif(ig,k))
-         else
-            alpha(ig,k)=1.12
-            sm(ig,k)=0.085
-         endif
-      ENDDO
-      ENDDO
-!    ENDIF
-
-! Computation of turbulent diffusivities
-!  IF (25<=iflag_pbl.and.iflag_pbl<=28) THEN
-!    DO k=2,klev
-!       sqrtq(:,k)=sqrt(0.5*(q2(:,k)+q2(:,k-1)))
-!    ENDDO
-!  ELSE
-   kq(:,:)=0.
-   DO k=1,klev
-      ! Coefficient au milieu des couches pour diffuser la TKE
-      kq(:,k)=0.5*leff(:,k)*sqrt(q2(:,k))*0.2
-   ENDDO
-
-#ifdef IOPHYS
-if (okiophys) then
-call iophys_ecrit('q2b',klev,'KTE inter','m2/s',q2(:,1:klev))
-endif
-#endif
-
-  IF (iflag_tke_diff==1) THEN
-    CALL vdif_q2(timestep, RG, RD, ngrid, plev, pt, kq, q2)
-  ENDIF
-
-   km(:,:)=0.
-   kn(:,:)=0.
-   DO k=1,klev
-      km(:,k)=leff(:,k)*sqrt(q2(:,k))*sm(:,k)
-      kn(:,k)=km(:,k)*alpha(:,k)
-   ENDDO
-
-
-#ifdef IOPHYS
-if (okiophys) then
-call iophys_ecrit('mixingl',klev,'Mixing length','m',leff(:,1:klev))
-call iophys_ecrit('rife',klev,'Flux Richardson','m',rif(:,1:klev))
-call iophys_ecrit('q2f',klev,'KTE finale','m2/s',q2(:,1:klev))
-call iophys_ecrit('q2neg',klev,'KTE non bornee','m2/s',q2neg(:,1:klev))
-call iophys_ecrit('alpha',klev,'alpha','',alpha(:,1:klev))
-call iophys_ecrit('sm',klev,'sm','',sm(:,1:klev))
-call iophys_ecrit('q2f',klev,'KTE finale','m2/s',q2(:,1:klev))
-call iophys_ecrit('kmf',klev,'Kz final','m2/s',km(:,1:klev))
-call iophys_ecrit('knf',klev,'Kz final','m2/s',kn(:,1:klev))
-call iophys_ecrit('kqf',klev,'Kz final','m2/s',kq(:,1:klev))
-endif
-#endif
-
-
-ENDIF
-
-
-!  print*,'OK2'
-      RETURN
-      END
+link ../phylmd/yamada_c.F90
Index: LMDZ6/trunk/libf/phylmdiso/zilch.F90
===================================================================
--- LMDZ6/trunk/libf/phylmdiso/zilch.F90	(revision 3939)
+++ LMDZ6/trunk/libf/phylmdiso/zilch.F90	(revision 3940)
@@ -1,17 +1,1 @@
-
-! $Header$
-
-SUBROUTINE zilch(x, m)
-
-  ! Zero the real array x dimensioned m.
-
-  IMPLICIT NONE
-
-  INTEGER m, i
-  REAL x(m)
-
-  DO i = 1, m
-    x(i) = 0.0
-  END DO
-  RETURN
-END SUBROUTINE zilch
+link ../phylmd/zilch.F90
